VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "VCortexGadget"
Attribute VB_GlobalNameSpace = True
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
' this module is the gadget aware master program

'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  start of events
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Event RecallStatus(ByVal Done As Long, ByVal ToDo As Long, ByRef Cancel As Boolean)
Public Event Backtalk(ByVal BT As String)
Public Event Backtalk2(ByRef BT As Gadget)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' end of events
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' start of private
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private StayAwake As Boolean, IsAwake As Boolean ' makes brain not unload after last app goes away
Private DevelopmentMode As Boolean
Private DoneDone As Boolean
Private VGBDatabaseNameAndPath As String
Private VGBDatabaseName As String
Private StopWhateverYourDoing As Boolean
Private AbortRead As Boolean
Private OSGadget As Gadget
Private StatusGadget As Gadget
Private VCG_Self As Gadget
Private Logged_User As Gadget, AccessLevel As Long, AccessMode As Long
Private AppWakeupGadget As Gadget

Private Memories() As Gadget, MemoriesCNTR As Long, MemoriesPTR As Long, MAXMemories As Long
Private VGBStatus As Gadget
Private VGBErrors As Gadget, VGBErrorsCNTR As Long, ErrorsOn As Boolean
Private Trace As Gadget, TraceCNTR As Long, TraceOn As Boolean
'Private VGBBusy As Boolean


Private GadgetWorkspace As Workspace
Private JetDatabasePath As String    ' will hode the path to the database
Private JetDatabaseName As String    ' actual name of the jet db
Private JetDatabase As Database      ' db object for general use
' open databases kept in an array of databases, this is good stuff
Private OpenDB() As Database, OpenDBCNTR As Integer, OpenDBPTR As Integer
' keep up with the recordsets as arrays, too.  linked to opendb by dbgadgets
' and appdbgadgets
Private OpenRS() As Recordset, OpenRSCNTR As Integer, OpenRSPTR As Integer
' the object, props and methods recordsets are the CURRENT ones
' dbswitch changes these to the specified ones.  all disk i/o is the same
' for ever.
Private ObjectsRS As Recordset   ' GDS Objects recordset
Private PropsRS As Recordset, PropertyPTR As Integer    ' GDS Properties rs
Private MethodsRS As Recordset   ' GDS methods recordset
Private CanDo() As Gadget, CanDoCntr As Long, CanDoPTR As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' end of private
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' start of public variables
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' this is the all potent gadget
Public Type Gadget              ' This is the representation of the GADGET Object
    RS As Recordset
    ObjectID As Long            ' unique id for each object
    Level As Integer            ' Used for placement in the Tree control
    GAppName As String          ' application that created the object
    Container As String         ' don't rightly know how this is used
    Type As String              ' used to sort out
    Name As String              ' name of object, unique
    Tag As String               ' used for many things, especially DDE Requesting and resulting
    TotalProperties As Long     ' total number of properties
    TotalMethods As Long        ' total number of methods
    PropertyID() As Long        ' unique property id
    Propity() As String         ' name of the property
    Caption() As String         ' not really used
    ValueAlpha() As String      ' alpha value of property
    ValueNum() As Double        ' numeric value of property
    PropSource() As String      ' another possible oops, not really used
    PropType() As Integer       ' 0=System, 1=User,  2=Copy as System, 3=Copy as User
    MethodID() As Long          ' unique method id
    MethType() As String        ' don't know
    Method() As String          ' method parser will use to call correct function
    MethAction() As String    '
    Status As String
End Type
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' end of public
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' start api definitions
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' let's get some api action happening
#If Win16 Then
    Private Declare Function GetWindowsDirectory Lib "Kernel" _
                                                (ByVal lpBuffer As String, _
                                                 ByVal nSize As Integer) As Integer
    Private Declare Function GetPrivateProfileString Lib "Kernel" _
                                                         (ByVal lpApplicationName As String, _
                                                          ByVal lpKeyName As Any, _
                                                          ByVal lpDefault As String, _
                                                          ByVal lpReturnedString As String, _
                                                          ByVal nSize As Integer, _
                                                          ByVal lpFileName As String) As Integer
    Private Declare Function GetProfileString Lib "Kernel" _
                                                  (ByVal sName$, _
                                                   ByVal KName$, _
                                                   ByVal Def$, _
                                                   ByVal Ret$, _
                                                   ByVal Size%) As Integer
    Private Declare Function GetWindow% Lib "user" _
                                            (ByVal hwnd%, _
                                             ByVal wCmd%)
    Private Declare Function GetModuleHandle Lib "Kernel" _
                                                 (ByVal lpModuleName As String) As Integer
    Private Declare Function GetModuleUsage Lib "Kernel" _
                                                (ByVal hModule As Integer) As Integer
#Else
    Private Declare Function GetPrivateProfileString Lib "Kernel32" Alias "GetPrivateProfileStringA" _
                                                         (ByVal lpApplicationName As String, _
                                                          ByVal lpKeyName As Any, _
                                                          ByVal lpDefault As String, _
                                                          ByVal lpReturnedString As String, _
                                                          ByVal nSize As Long, _
                                                          ByVal lpFileName As String) As Long
    Private Declare Function GetWindowsDirectory Lib "Kernel32" Alias "GetWindowsDirectoryA" _
                                                     (ByVal lpBuffer As String, _
                                                      ByVal nSize As Long) As Long
    Private Declare Function GetProfileString Lib "Kernel32" Alias "GetProfileStringA" _
                                                  (ByVal lpAppName As String, _
                                                   ByVal lpKeyName As String, _
                                                   ByVal lpDefault As String, _
                                                   ByVal lpReturnedString As String, _
                                                   ByVal nSize As Long) As Long
    Private Declare Function GetWindow Lib "user32" _
                                           (ByVal hwnd As Long, _
                                            ByVal wCmd As Long) As Long
  
    Private Declare Function GetDesktopWindow Lib "user32" () As Long

    Private Declare Function GetWindowThreadProcessId Lib "user32" _
                                                      (ByVal hwnd As Long, _
                                                       lpdwProcessId As Long) As Long
    
    Private Declare Function BringWindowToTop Lib "user32" _
                                              (ByVal hwnd As Long) As Long
    
    Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" _
                                           (ByVal hwnd As Long, ByVal _
                                            lpString As String) As Long
           
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
                                          (ByVal hwnd As Long, _
                                           ByVal lpClassName As String, _
                                           ByVal nMaxCount As Long) As Long
   
    Private Declare Function SendMessageStr Lib "user32" Alias "SendMessageA" _
                                            (ByVal hwnd As Long, _
                                             ByVal wMsg As Long, _
                                             ByVal wParam As Long, _
                                             ByVal LParam As String) As Long
   
    
    Private Const TH32CS_SNAPPROCESS As Long = 2&
    Private Const MAX_PATH As Integer = 260

    Private Type PROCESSENTRY32
            dwSize As Long
            cntUsage As Long
            th32ProcessID As Long
            th32DefaultHeapID As Long
            th32ModuleID As Long
            cntThreads As Long
            th32ParentProcessID As Long
            pcPriClassBase As Long
            dwFlags As Long
            szExeFile As String * MAX_PATH
    End Type

    Private Declare Function CreateToolhelpSnapshot Lib "Kernel32" Alias "CreateToolhelp32Snapshot" _
                                                    (ByVal lFlags As Long, _
                                                     ByVal lProcessID As Long) As Long

    Private Declare Function ProcessFirst Lib "Kernel32" Alias "Process32First" _
                                          (ByVal hSnapShot As Long, _
                                           uProcess As PROCESSENTRY32) As Long

    Private Declare Function ProcessNext Lib "Kernel32" Alias "Process32Next" _
                                         (ByVal hSnapShot As Long, _
                                          uProcess As PROCESSENTRY32) As Long

    Private Declare Sub CloseHandle Lib "Kernel32" _
                                    (ByVal hPass As Long)
    
    ' get window
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal LParam As Long) As Long
    'Private Const WM_QUIT = &H12
    'code for find window and close, 32 bit
    'Dim sTitle As String
    ' Dim iHwnd As Long
    ' Dim ihTask As Long
    ' Dim iReturn As Long
    ' sTitle = "Untitled - Notepad"
    ' iHwnd = FindWindow(0&, sTitle)
    ' iReturn = PostMessage(iHwnd, WM_QUIT, 0&, 0&)
    ' MsgBox "Notepad has been Closed Down"
    
    '32 Bit reboot
    Private Const EWX_SHUTDOWN = 1
    Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Boolean
    'success = ExitWindowsEx(EWX_SHUTDOWN, 0)
#End If
Private InstancesCNTR As Long

' 16 bit reboot
'How do I shut down or reboot Windows from my program?
'In 32-bit VB use the following:
'Declare the API-function

'     Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, _
'     ByVal dwReserved As Long) As Boolean
'     private Const EWX_SHUTDOWN = 1
'
'and use
'
'     Success = ExitWindowsEx(EWX_SHUTDOWN, 0)
'
'If successful, the function returns true. You can force the shutdown by using EWX_FORCE = 4.
'To make Windows 95 reboot use EWX_REBOOT = 2. To only log off use EWX_LOGOFF = 0.
'
'With 16-bit VB, you do:
'
'     Declare Function ExitWindows Lib "user" (ByVal wReturnCode As Long, _
'     ByVal dwReserved As Integer) As Integer
'
'To exit Windows:
'
'     RetVal% = ExitWindows(0, 0)
'
'To exit and restart Windows:
'
'     RetVal% = ExitWindows(&H42, 0)
'
'To exit Windows and restart the system:
'
'     RetVal% = ExitWindows(&H43, 0)
'
'If any application refuses to terminate, zero will be returned.
'If succesful, there will be no return (of course).
'
'Note that SendKeys to close the Program Manager (Win 3.x) will never work because it shows a sys-modal dialog that will stop all applications
'until being answered (therefore SendKeys cannot send the "OK"-press because the "sending" application is stopped).
'[Mathias Schiffer <Mathias.Schiffer@post.rwth-aachen.de>]
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Ebnd api definitions
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'

'////////////////////////////////////////////////////////////////////////////////////////////
'////////////////////////////////////////////////////////////////////////////////////////////
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' begin the braingadget
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function VCIO(VCF As String, VCP1 As String, VCP2 As String, G1 As Gadget, G2 As Gadget, G3 As Gadget) As Gadget
    ' this is the portal to the VC
    ' all io passes thru here.  the GAPI specification will explain for licensed users
    ' VCF=Virtual Cortex Function
    ' VCP1=VC Parameter 1
    ' VCP2=VC Parameter 2
    ' G1-G3=Gadgets
    Dim UCaseVCF As String
    Dim MemPoolName As String
    Dim TaskResult As Gadget
    UCaseVCF = UCase(VCF)
    CheckSuicide
    Select Case True
        Case Suicide = True
            TaskResult.Name = "Suicide"
            GoTo Suicide
        Case UCaseVCF = ""
            ' this is a template
        Case UCaseVCF = "MEMORIZE"
            TaskResult = Memorize(G1, VCP2)
        Case UCaseVCF = "RECALL"
            TaskResult = Recall(VCP1, VCP2)
            RaiseEvent Backtalk(VCP1)
            DoEvents
            RaiseEvent Backtalk2(TaskResult)
            DoEvents
        Case UCaseVCF = "RECALLBYID"
            TaskResult = RecallByID(Val(VCP1), VCP2)
        Case UCaseVCF = "FORGET"
            TaskResult = Forget(VCP1, VCP2)
        Case UCaseVCF = "FORGETBYID"
            TaskResult = ForgetByID(Val(VCP1), VCP2)
        Case UCaseVCF = "DEBUGVGB"
            TaskResult = DebugVGB(VCP1)
        Case UCaseVCF = "WAKEUP"
            TaskResult = WakeUp(G1)
        Case UCaseVCF = "CONVERTLEGACY"
            TaskResult = ConvertLegacy(VCP1)
    End Select
Suicide:
        
EndSub:
    VCIO = TaskResult
End Function
Friend Function CheckSuicide()
    If Suicide = True Then
        WasteTime 1
        End
    End If
End Function
Friend Function WakeUp(CallerApp As Gadget) As Gadget
    ' the caller must do this first to initialize
    Dim starttime As Single
    starttime = Timer
    Dim Result As Gadget
    TraceOn = True
    SetProperty Trace, NextID("trace") & "Wakeup Start *********************************", "************************"
    InitVGB CallerApp
    WakeUp = AppWakeupGadget
    SetProperty Trace, NextID("trace") & "Wakeup Time", CStr(Timer - starttime)
    SetProperty Trace, NextID("trace") & "Wakeup End *********************************", "************************"
    CheckTrace
End Function

Friend Function DebugVGB(What As String) As Gadget
    ' for debugging purposes. returns gadgets with indications of the processes
    Dim MasterGadget As Gadget
    Select Case True
        Case UCase(What) = "ERRORS"
            DebugVGB = VGBErrors
        Case UCase(What) = "CLEAR ERRORS"
            VGBErrors = BlankObject
            VGBErrors.Name = "Errors Cleared " & Now
        Case UCase(What) = "TRACE"
            DebugVGB = Trace
        Case UCase(What) = "TRACE ON"
            TraceOn = True
        Case UCase(What) = "TRACE OFF"
            TraceOn = False
        Case UCase(What) = "CLEAR TRACE"
            Trace = BlankObject
            Trace.Name = "Trace Cleared " & Now
        Case UCase(What) = "STATUS"
            DebugVGB = VGBStatus
        Case UCase(What) = "DEVELOPMENT ON"
            ' can't go into development mode unless I say so
            MasterGadget = Recall("Master Gadget", "from " & VGBDatabaseName)
            If ReadProperty(MasterGadget, "Master Password") = "Grand Poopa Dude" Then
                DevelopmentMode = True
            End If
        Case UCase(What) = "DEVELOPMENT OFF"
            DevelopmentMode = False
    End Select
End Function

Friend Function InitVGB(Params As Gadget) As Gadget
    ' initialize the core intelligence unit
    Dim starttime As Single, stoptime As Single
    Static AlreadyRunning As Boolean
    starttime = Timer
    Dim TotStartTime As Single
    TotStartTime = Timer
    Dim t, Msg As String, Cntr1 As Long
    Dim RREsults As Gadget, MResults As Gadget
    Dim ResultGadget As Gadget
    Dim LParam As Gadget
    Dim TGadget As Gadget
    Dim FirstTime As Boolean
    Dim LocalError As String
    Dim Result As String
    Dim WinDir As String
    Dim AddedID As Long
    Dim FIXRWS As Boolean
    On Error GoTo LocalError
    DevelopmentMode = False
    AccessLevel = 0
    SetProperty Trace, NextID("trace") & "Virtual Cortex Woke up", "By " & Params.Name
    If VGBErrorsCNTR = 0 Then
        VGBErrors.Name = "Error Object " & Now
        Trace.Name = "Trace " & Now
    End If
    Select Case True
        Case ReadProperty(Params, "Login Name") = "THE MECHANIC"
            If ReadProperty(Params, "The Tool") = "quantum wrenches in the works" Then
'                RenameProperty Params, "Login Name"
'                DeleteProperty Params, "The Tool"
                DevelopmentMode = True
            End If
            If AlreadyRunning Then
                GoTo EndSub
            End If
        Case UCase(Params.Name) = "ERRORS ON"
            ErrorsOn = True
        Case UCase(Params.Name) = "ERRORS OFF"
            ErrorsOn = False
            
        Case UCase(Params.Name) = "TRACE ON"
            TraceOn = True
        Case UCase(Params.Name) = "TRACE OFF"
            TraceOn = True
        
        Case Params.Name = "Reset"
            ' this is a request for reinitializing from inside here
            
        Case Params.Name <> ""
            ' this is an external app
            ' only one instance per app, please
        Case Else
            AppWakeupGadget = Params
            SetProperty AppWakeupGadget, "ERROR", "No Name Passed"
            GoTo EndSub
    End Select
    
    SetVariables
RestartInit:
    VGBStatus.Name = "VGB Status"
    VGBStatus.Type = "System"
    SetProperty VGBStatus, "Start", Now()
    SetProperty VGBStatus, "Start Timer", CStr(starttime)
    Msg = DetectOS ' returns the operating system stuff
    SetProperty VGBStatus, "Operating System", Msg
    FirstTime = False
    LocalError = ""
    Result = "Failed"
    WinDir = AddBackSlash(GetWindowsDir)
    VGBDatabaseName = VGBDatabaseName
    SetProperty VGBStatus, "Windows Directory", WinDir
    VGBDatabaseName = "GDSREG.GDS"
    VGBDatabaseNameAndPath = WinDir & VGBDatabaseName
    If Not FileExists(VGBDatabaseNameAndPath) Then
        FileCopy AddBackSlash(App.Path) & "Empty.mem", VGBDatabaseNameAndPath
        SetProperty VGBStatus, "System File Copied", Now()
    End If
    If Not FileExists(WinDir & "GDSSYS.GDS") Then
        If Not FileExists(AddBackSlash(App.Path) & "GDSSYS.GDS") Then
            Msg = ""
            Msg = Msg & "System File " & CrLf
'            Msg = Msg & AddBackSlash(App.Path) & "GDSSYS.GDS" & CrLf
            Msg = Msg & "Was Not Found!" & CrLf
            Msg = Msg & "Click OK, make sure the file exists and try again!" & CrLf
'            MsgBox Msg, , "Fatal Error"
            End
        End If
        SetProperty VGBStatus, "Fatal Error", "System File Not Found " & Now()
        SetProperty Trace, NextID("trace") & "Fatal Error", "Virtual Cortex Didn't find System Memories Pool"
        FileCopy AddBackSlash(App.Path) & "GDSSYS.GDS", WinDir & "gdssys.gds"
'        MsgBox "Required System File: GDSSYS.GDS" & CrLf & "NOT Found.", , "Fatal Error"
'        End
    End If
    ' gds is there, need to open it
    If Not FileExists(WinDir & "GDSREG.INI") Then
        ' need to create the .INI file here
        SetProperty VGBStatus, ".INI File Created", Now()
        Open WinDir & "GDSREG.INI" For Output As #1
        Print #1, "[Options]"
        Print #1, "SystemDB=" & WinDir & "GDSSYS.GDS"
        Close #1
        SetProperty Trace, NextID("trace") & "Wakeup Created", UCase(WinDir & "GDSREG.INI")
    End If
    t = Dir(VGBDatabaseNameAndPath, vbNormal)
    If LocalError <> "" Then
        FileCopy AddBackSlash(App.Path) & "Empty.mem", VGBDatabaseNameAndPath
        LocalError = ""
        t = Dir(VGBDatabaseNameAndPath, vbNormal)
        If LocalError <> "" Then
            Msg = "VG Brain Registry Not Found, " & CrLf
            Msg = Msg & "Can't Continue" & CrLf
            FloatMsgBox Msg, " Virtual Cortex Internal Error"
            SetProperty VGBStatus, "Fatal Error", "Virtual Cortex Didn't find System Memories Pool"
            SetProperty AppWakeupGadget, "Fatal Error", "VG Brain Registry Not Found, Can't Continue"
            GoTo EndSub
        End If
    End If
    If Len(t) <> 0 Then
        ' need to hide this file
        SetAttr VGBDatabaseNameAndPath, vbHidden
    End If
    t = Dir(VGBDatabaseNameAndPath, vbHidden)
    If Len(t) = 0 Then
        MsgBox "Can't Continue", vbExclamation, "GDS Internal Error: 666-G1"
        SetProperty Trace, NextID("trace") & "Fatal Error", "By " & Params.Name
        SetProperty VGBStatus, "System File Not Found Error", Now()
        SetProperty VGBStatus, "Last Fatal Error", "System File Not Found Error"
        SetProperty AppWakeupGadget, "Fatal Error", "VG Brain Registry Not Found, Can't Continue"
        GoTo EndSub
    End If
    #If Win32 Then
        DBEngine.SystemDB = WinDir & "GDSSYS.GDS"
        SetProperty VGBStatus, "32 Bit", "True"
    #End If
    
    DBEngine.IniPath = WinDir & "GDSREG.INI"
    DBEngine.DefaultUser = "VBasic"
    DBEngine.DefaultPassword = "TLHicky"
    Set GadgetWorkspace = DBEngine.CreateWorkspace("GDSREG", "VBasic", "TLHicky")
    OpenDBPTR = 0
    OpenDBCNTR = 0
    
    OpenRSPTR = 0
    OpenRSCNTR = 0
    ReDim OpenDB(0) As Database
    ReDim OpenRS(OpenRSPTR) As Recordset
    Set OpenDB(0) = GadgetWorkspace.OpenDatabase(VGBDatabaseNameAndPath)
    Set ObjectsRS = OpenDB(0).OpenRecordset("Objects", dbOpenTable)
    
    ' open GDSREG objectsrs
    Set OpenRS(0) = ObjectsRS
    ObjectsRS.MoveLast
    AppRSGadgetsCNTR = 0
    ReDim Preserve AppRSGadgets(AppRSGadgetsCNTR)
    AppRSGadgets(AppRSGadgetsCNTR) = BlankObject
    AppRSGadgets(AppRSGadgetsCNTR).ObjectID = 0
    AppRSGadgets(AppRSGadgetsCNTR).Name = UCase(App.EXEName) & "-" & VGBDatabaseName & "-0-Objects"
    AppRSGadgets(AppRSGadgetsCNTR).Type = "AppRSGadget"
    AppRSGadgets(AppRSGadgetsCNTR).Container = UCase(App.EXEName)
    SetProperty AppRSGadgets(AppRSGadgetsCNTR), "DB Name", VGBDatabaseName
    SetProperty AppRSGadgets(AppRSGadgetsCNTR), "RS Source", "Objects"
    SetProperty AppRSGadgets(AppRSGadgetsCNTR), "RS Name", "ObjectsRS"
    SetProperty AppRSGadgets(AppRSGadgetsCNTR), "RS Index", CStr(OpenRSPTR)
    
    ' open GDSREG props
    OpenRSPTR = OpenRSPTR + 1
    ReDim Preserve OpenRS(OpenRSPTR) As Recordset
    Set PropsRS = OpenDB(0).OpenRecordset("Props", dbOpenTable)
    Set OpenRS(OpenRSPTR) = PropsRS
    PropsRS.MoveLast
    AppRSGadgetsCNTR = AppRSGadgetsCNTR + 1
    ReDim Preserve AppRSGadgets(AppRSGadgetsCNTR)
    AppRSGadgets(AppRSGadgetsCNTR) = BlankObject
    AppRSGadgets(AppRSGadgetsCNTR).ObjectID = 0
    AppRSGadgets(AppRSGadgetsCNTR).Name = UCase(App.EXEName) & "-" & VGBDatabaseName & "-0-Props"
    AppRSGadgets(AppRSGadgetsCNTR).Type = "AppRSGadget"
    AppRSGadgets(AppRSGadgetsCNTR).Container = UCase(App.EXEName)
    SetProperty AppRSGadgets(AppRSGadgetsCNTR), "DB Name", VGBDatabaseName
    SetProperty AppRSGadgets(AppRSGadgetsCNTR), "RS Source", "Props"
    SetProperty AppRSGadgets(AppRSGadgetsCNTR), "RS Name", "PropsRS"
    SetProperty AppRSGadgets(AppRSGadgetsCNTR), "RS Index", CStr(OpenRSPTR)
    
    ' open GDSREG methods
    OpenRSPTR = OpenRSPTR + 1
    ReDim Preserve OpenRS(OpenRSPTR) As Recordset
    Set MethodsRS = OpenDB(0).OpenRecordset("Methods", dbOpenTable)
    Set OpenRS(OpenRSPTR) = MethodsRS
'    MethodsRS.Movelast
    OpenRSCNTR = OpenRSPTR
'    OpenRS(OpenRSPTR).MoveLast
'    OpenRS(OpenRSPTR).Movelast
    AppRSGadgetsCNTR = AppRSGadgetsCNTR + 1
    ReDim Preserve AppRSGadgets(AppRSGadgetsCNTR)
    AppRSGadgets(AppRSGadgetsCNTR) = BlankObject
    AppRSGadgets(AppRSGadgetsCNTR).ObjectID = 0
    AppRSGadgets(AppRSGadgetsCNTR).Name = UCase(App.EXEName) & "-" & VGBDatabaseName & "-0-Methods"
    AppRSGadgets(AppRSGadgetsCNTR).Type = "AppRSGadget"
    AppRSGadgets(AppRSGadgetsCNTR).Container = UCase(App.EXEName)
    SetProperty AppRSGadgets(AppRSGadgetsCNTR), "DB Name", VGBDatabaseName
    SetProperty AppRSGadgets(AppRSGadgetsCNTR), "RS Source", "Methods"
    SetProperty AppRSGadgets(AppRSGadgetsCNTR), "RS Name", "MethodsRS"
    SetProperty AppRSGadgets(AppRSGadgetsCNTR), "RS Index", CStr(OpenRSPTR)
    SetProperty Trace, NextID("trace") & "InitVGB", "Primary Memories Pool Connected"
    ' the VGBDatabaseName db is open and available
    ' load up the gdsreg dbgadget (index=0)
    ' note: the way the names work is that the dbgadget name is filename + filename index (dbgadgetdef)
    DBGadgetsCNTR = 0
    DBGadgetsPTR = DBGadgetsCNTR
    ReDim Preserve DBGadgets(DBGadgetsPTR)
    DBGadgets(DBGadgetsPTR) = BlankObject
    DBGadgets(DBGadgetsPTR).ObjectID = 0
    DBGadgets(DBGadgetsPTR).Name = VGBDatabaseName & "-0"
    DBGadgets(DBGadgetsPTR).Type = "DBGadget"
    DBGadgets(DBGadgetsPTR).Container = "GDS Registry"
    DBGadgets(DBGadgetsPTR).Tag = "InitVGB: " & CStr(Now())
    SetProperty DBGadgets(DBGadgetsPTR), "Path", WinDir
    SetProperty DBGadgets(DBGadgetsPTR), "DB Name", VGBDatabaseName
    SetProperty DBGadgets(DBGadgetsPTR), "System", "RWSSYS.RWS"
    SetProperty DBGadgets(DBGadgetsPTR), "AutoOpen", "True"
    SetProperty DBGadgets(DBGadgetsPTR), "Type", "Jet"
    SetProperty DBGadgets(DBGadgetsPTR), "Version", "2.0"
    SetProperty DBGadgets(DBGadgetsPTR), "DU", "VBasic"
    SetProperty DBGadgets(DBGadgetsPTR), "DP", "TLHicky"
    ' see if gdsreg is on disk
    RREsults = Recall(DBGadgets(DBGadgetsPTR).Name, "from " & VGBDatabaseNameAndPath)
    If RREsults.Name = DBGadgets(DBGadgetsPTR).Name Then
        ' set the object id
'        SetProperty Trace, NextID("trace") & RResults.Name, "Exists"
        DBGadgets(DBGadgetsPTR).ObjectID = RREsults.ObjectID
    Else
        ' write it
        DBSwitch 0
        Msg = WriteMemGadget(DBGadgets(DBGadgetsPTR).ObjectID, DBGadgets(DBGadgetsPTR))
'        SetProperty Trace, NextID("trace") & DBGadgets(DBGadgetsPTR).Name, "Added, Write results: " & Msg
    End If
                
    ' first object is "GDSRegistry"
    ' need to do a little db fixing here
    RREsults = Recall("GDSRegistry", "from " & VGBDatabaseNameAndPath)
'    t = ReadGadgetByName("GDSRegistry", GDSRegistry)
    If RREsults.Name <> "GDSRegistry" Then
        GDSRegistry.Name = "GDSRegistry"
        GDSRegistry.Type = "GDSRegistry"
        GDSRegistry.Container = "GDSRegistry"
        MResults = Memorize(GDSRegistry, "in " & VGBDatabaseNameAndPath)
        t = ReadGadgetByName("GDSRegistry", GDSRegistry)
        If t <> "OK" Then
            MsgBox t, , UCase(App.EXEName) & " Debug Message"
            GoTo EndSub
        End If
        SetProperty GDSRegistry, "Initialization Date", Format(Now, "Long Date")
        SetProperty GDSRegistry, "Initialization Time", Format(Now, "Long Time")
        SetProperty GDSRegistry, "GDS Tasks Initialized", "No"
        MResults = Memorize(GDSRegistry, "in " & VGBDatabaseNameAndPath)
'        t = WriteMemGadget(GDSRegistry.ObjectID, GDSRegistry)
'        t = ReadGadgetByName("GDSRegistry", GDSRegistry)
'        FIXRWS = True
    End If
    ' gdsreg is open as db 0
    ' next object is blank object
    t = ReadGadgetByName("BlankObject", BlankObject)
    If t <> "OK" Or BlankObject.Container <> "BlankObject" Then
        BlankObject.Name = "BlankObject"
        BlankObject.Type = "BlankObject"
        BlankObject.Container = "BlankObject"
        MResults = Memorize(BlankObject, "in " & VGBDatabaseNameAndPath)
    End If
    BlankObject.ObjectID = 0
    BlankObject.Type = ""
    BlankObject.Container = ""
    ' fix the dbgadget definition index. this is the index for attached databases
    DBGadgetDef = Recall("DBGadget Definition", "from " & VGBDatabaseName)
    If DBGadgetDef.Name <> "DBGadget Definition" Then
        DBGadgetDef = BlankObject
        DBGadgetDef.Name = "DBGadget Definition"
        DBGadgetDef.Type = "DBGadget Definition"
        DBGadgetDef.Container = "GDS Registry"
        DBGadgetDef.ObjectID = 0
        t = SetProperty(DBGadgetDef, "Last DBGadget Name Index", "0")
        MResults = Memorize(DBGadgetDef, "in " & VGBDatabaseNameAndPath)
'        SetProperty Trace, NextID("trace") & "DB Gadget Definition Created", "Because: " & DBGadgetDef.Name & " not found"
    End If
    ' now the appdbgadget for this app, Virtual Cortex
    AppDBGadgetsCNTR = 0
    AppDBGadgetsPTR = AppDBGadgetsCNTR
    ReDim Preserve AppDBGadgets(AppDBGadgetsPTR)
    AppDBGadgets(AppDBGadgetsPTR) = BlankObject
    AppDBGadgets(AppDBGadgetsPTR).ObjectID = 0
    AppDBGadgets(AppDBGadgetsPTR).Name = UCase(App.EXEName) & "-" & VGBDatabaseName & "-0"
    AppDBGadgets(AppDBGadgetsPTR).Type = "AppDBGadget"
    AppDBGadgets(AppDBGadgetsPTR).Container = UCase(App.EXEName)
    AppDBGadgets(AppDBGadgetsPTR).Tag = "GDS Init" & Now()
    SetProperty AppDBGadgets(AppDBGadgetsPTR), "DB Name", VGBDatabaseName
    SetProperty AppDBGadgets(AppDBGadgetsPTR), "Enabled", "True"
    SetProperty AppDBGadgets(AppDBGadgetsPTR), "Open in this App?", "True"
    ' see if AppDBGadget is on disk
    RREsults = Recall(AppDBGadgets(AppDBGadgetsPTR).Name, "from " & VGBDatabaseNameAndPath)
    If RREsults.Name = AppDBGadgets(AppDBGadgetsPTR).Name Then
        ' found, just set objectid
        AppDBGadgets(AppDBGadgetsPTR).ObjectID = RREsults.ObjectID
        SetProperty Trace, NextID("trace") & "App Gadget", RREsults.Name & " exists"
    Else
        AppDBGadgets(AppDBGadgetsPTR).Tag = AppDBGadgets(AppDBGadgetsPTR).Tag & ":" & RREsults.Name
        MResults = Memorize(AppDBGadgets(AppDBGadgetsPTR), "in " & VGBDatabaseNameAndPath)
        SetProperty Trace, NextID("trace") & "App Gadget", MResults.Name & " found"
    End If
'    ShowObject Dematerialize(AppDBGadgets(AppDBGadgetsPTR)), "Mem"
    
    ' the primary database (VGBDatabaseName) is open and the me app is going
    ' let's attach the application on the other end
    ' defined by the passed parameter
    AppWakeupGadget = AppAttach(Params)
    ' open all "memories pools"
    ' these are the db definitions
    LParam = BlankObject
    LParam.Name = "DBGadgetsLoad Parameters"
    t = SetProperty(LParam, "Reset Gadgets", "False")
    t = DBGadgetsLoad(LParam)
    ' open all the databases
    starttime = Timer
    For Cntr1 = 1 To DBGadgetsCNTR
        If ReadProperty(DBGadgets(Cntr1), "AutoOpen") = "True" Then
            ' use autopen prop to control the opening of dbs
            LParam = DBGadgets(Cntr1)
            SetProperty Trace, NextID("trace") & "Attaching Memories Pools", "Pool " & CStr(Cntr1) & " = " & LParam.Name
            t = SetProperty(LParam, "Reset Gadgets", "False")
            t = SetProperty(LParam, "Caller", "InitVGB")
            TGadget = OpenJetDataBase(LParam)
            SetProperty Trace, NextID("trace") & "Attached Memories Pools", "Pool " & CStr(Cntr1) & " = " & LParam.Name
        End If
    Next Cntr1
    VCG_Self = Recall("VCG_Self", "from " & VGBDatabaseName)
    If VCG_Self.Name <> "VCG_Self" Then
        VCG_Self.Name = "VCG_Self"
        VCG_Self.Type = "Virtual Cortex Self"
        VCG_Self.Container = "VCG"
        'SetProperty VCG_Self, "", ""
        SetProperty VCG_Self, "Initialized", CStr(Now())
        SetProperty VCG_Self, "Mode", "Alpha Test"
        Memorize VCG_Self, "in " & VGBDatabaseName
    Else
'        Msg = ReadProperty(VCG_Self, "Expires")
'        If CDate(Now()) > CDate(Msg) Then
'            If ReadProperty(VCG_Self, "Mode") = "Alpha Test" Then
'                Msg = ""
'                Msg = Msg & "I am hopelessly out of date." & CrLf
'                Msg = Msg & "" & CrLf
'                Msg = Msg & "If you are an active tester, you need" & CrLf
'                Msg = Msg & "to go to The Gadgetorium's site and get" & CrLf
'                Msg = Msg & "a new copy.  There is certainly one now." & CrLf
'                Msg = Msg & "If not, you need to uninstall this and forget it." & CrLf
'                Msg = Msg & "" & CrLf
'                Msg = Msg & "Note: you haven't lost one datum." & CrLf
'                Msg = Msg & "I'll quit now..." & CrLf
'                MsgBox Msg, vbExclamation, "Useful Lifetime Exeeded"
'                Suicide = True
'            End If
'        End If
    End If
'    If ReadProperty(VCG_Self, "Has Expired") = "True" Then
'        Suicide = True
'    End If
    Logged_User = Recall("Logged_User", "from VCG Memories")
    If Logged_User.Name <> "Logged_User" Then
        Logged_User.Name = "Logged_User"
        Logged_User.Type = "System"
        Logged_User.Container = "VCG"
        AccessLevel = 99 ' 100 levels, this is demo
        
    End If
    DBSwitch 0
    Result = "OK"
    
    GoTo EndSub
LocalError:
    LocalError = Error
    SetProperty Trace, NextID("trace") & "InitVGB Trapped Error", "Error: " & LocalError
    SetProperty VGBErrors, NextID("error") & "InitVGB Trapped Error", "Error: " & LocalError
    Resume Next
EndSub:
'    Unload GDSMsg
    SetProperty Trace, NextID("trace") & "InitVGB", " Complete"
    AlreadyRunning = True
    InitVGB = VGBStatus
    On Error GoTo 0
End Function
Friend Function Memorize(What As Gadget, Optional Location As String = "") As Gadget
'    Dim BusyGadget As Gadget
'    Static AmBusy As Boolean
'    If AmBusy = True Then
'       BusyGadget.Name = "Busy"
'       MemorizeInternal = BusyGadget
'       Exit Function
'    End If
'    AmBusy = True
    Dim starttime As Single
    starttime = Timer
    Dim t, Msg As String
    Dim RREsults As Gadget
    Dim Result As Gadget
    Dim LParam As Gadget
    Dim TempGadget As Gadget
    Dim ReturnedGadget As Gadget
    Dim UcaseParam As String
    Dim InPathAndFile As String
    Dim Where As Gadget
    Dim WherePath As String, WhereName As String
    Dim MemPoolType As String
    Dim LocalError As String
    On Error GoTo LocalError
    If InStr(Location, "/Type=") = 0 Then
        Location = Location & "/Type=Jet"
    End If
    MemPoolType = Right(Location, Len(Location) - InStr(Location, "/Type=") - 5)
    Location = Left(Location, InStr(Location, "/") - 1)
    UcaseParam = UCase(Location)
    InPathAndFile = AllTrim(Right(Location, Len(UcaseParam) - InStr(UcaseParam, "IN") - 2))
    SetProperty Trace, NextID("trace") & "Memorize Start *********************************", "************************"
    SetProperty Trace, NextID("trace") & "Memorizing", "Name: " & What.Name & " / " & InPathAndFile
    ' fix the file type attribute 9/2/00
    ' this allows the cortex to attach to jet, G-Internet, Text files
    Select Case True
        Case Location = ""
            ' no instructions, put it in # 1 as default
            DBSwitch 1
        Case (Left(UcaseParam, 3) = "IN ") And (InStr(UcaseParam, "\") = 0) And (UCase(MemPoolType) = "JET")
            ' they said where but without a path
            t = DBFindIndex(InPathAndFile)
            If t < 0 Then
                ' couldn't find this database, need to bomb
                ' can't add a pool without path info.
                SetProperty Trace, NextID("trace") & "FXN Memorize Find DB Error", What.Name & " / " & InPathAndFile & " / " & "Find Index Failed"
                SetProperty VGBErrors, NextID("error") & "FXN Memorize Find DB Error", What.Name & " / " & InPathAndFile & " / " & "Find Index Failed"
                Result.Name = "Could not Create: " & Location
'                FloatMsgBox Result.Name, "Memorize Failure"
                GoTo EndSub
            End If
            DBSwitch Val(t)
            
        Case (Left(UcaseParam, 3) = "IN ") And (InStr(UcaseParam, "\") > 0) And (UCase(MemPoolType) = "JET")
            ' they specified a place with a path
            ' now we can add a new one as needed
            TempGadget = BlankObject
            SetProperty TempGadget, "PathFile", InPathAndFile ' "Where" includes path, current if not there
            Where = ExtractPathAndFile(TempGadget)
            ' variables are easier at times like this
            WherePath = AddBackSlash(UCase(ReadProperty(Where, "Path Only")))
            WhereName = UCase(ReadProperty(Where, "File Only"))
            t = DBFindIndex(WherePath & WhereName)
'            SetProperty Trace, NextID("trace") & "Memorize Loc", What.Name & ": " & Location
            If t < 0 Then
                ' not found, we need to add the file
'                SetProperty Trace, NextID("trace") & "Memorize Adding DB", WherePath & WhereName
'                SetProperty StatusGadget, "DB Created", WherePath & WhereName
                LParam = BlankObject
                LParam.Name = "Parameters To Database Add Method"
                LParam.Type = "Parameter"
                LParam.Container = "AddDatabase"
                Msg = Location
                SetProperty LParam, "Long Name", Msg
                SetProperty LParam, "Mem Pool Type", MemPoolType
                SetProperty LParam, "SourcePath", AddBackSlash(UCase(App.Path))
                SetProperty LParam, "SourceFile", "Empty.mem"
                SetProperty LParam, "DestPath", WherePath
                SetProperty LParam, "DestFile", WhereName
                SetProperty LParam, "Stop on error", "No"
                SetProperty LParam, "Write Location", "Yes"
                SetProperty LParam, "Write Location File DBGadgetPTR", CStr(0)
                SetProperty LParam, "Created by", "Virtual Cortex Memorize"
                ReturnedGadget = AddDatabase(LParam)
                If ReadProperty(ReturnedGadget, "Status") <> OK Then
                    SetProperty Trace, NextID("trace") & "FXN Memorize Add DB and Path Error", What.Name & "/" & WherePath & WhereName & " / " & ReadProperty(ReturnedGadget, "Status")
                    SetProperty VGBErrors, NextID("error") & "FXN Memorize Add DB and Path Error", What.Name & "/" & WherePath & WhereName & " / " & ReadProperty(ReturnedGadget, "Status")
                    Result = ReturnedGadget
                    GoTo EndSub
                End If
                
            End If
            t = DBFindIndex(WherePath & WhereName)
            If t < 0 Then
                ' couldn't find this database, need to bomb
                SetProperty Trace, NextID("trace") & "FXN Memorize Find DB Error: ", What.Name & "/" & Location & " / " & "Find Index Failed"
                SetProperty VGBErrors, NextID("error") & "FXN Memorize Find DB Error: ", What.Name & "/" & Location & " / " & "Find Index Failed"
                Result.Name = "Could not Create: " & Location
 '               FloatMsgBox Result.Name, "Memorize Failure"
                GoTo EndSub
            End If
            RREsults = Recall(What.Name, "from " & WhereName)
            If RREsults.Name = What.Name Then
                What.ObjectID = RREsults.ObjectID
            End If
            If RREsults.Name = "Found Multiple" Then
                
            End If
            DBSwitch Val(t)
            
    End Select
    t = WriteMemGadget(What.ObjectID, What)
    Result = What
    GoTo EndSub
LocalError:
    LocalError = Error
'    FloatMsgBox What.Name, "Memorize Error: " & LocalError
    SetProperty Trace, NextID("trace") & "Trapped Memorize Error: ", What.Name & " / " & Location & " / " & LocalError
    SetProperty VGBErrors, NextID("error") & "Trapped Memorize Error: ", What.Name & " / " & Location & " / " & LocalError
    Resume Next
EndSub:
    SetProperty Trace, NextID("trace") & "Memorize Time", CStr(Timer - starttime)
    SetProperty Trace, NextID("trace") & "Memorize End *********************************", "************************"
    GDSFreelocks
    On Error GoTo 0
'    AmBusy = False
    Memorize = Result
    DBEngine.Idle dbRefreshCache
End Function
Friend Function RecallRS(What As String, Optional From As String = "") As Gadget
    Dim starttime As Single
    starttime = Timer
    Dim RSGadget As Gadget
    Dim RecalledRS As Recordset
    Dim SQLCmd As String
    
    SQLCmd = "SELECT DISTINCT Objects.Name, Props.Property, Props.ValueAlpha" & _
             " FROM Objects LEFT JOIN Props ON Objects.ObjectID = Props.ObjectID" & _
             " Where (((Props.Property) = 'group'))" & _
             " ORDER BY Objects.Name;"
   Set RecalledRS = OpenDB(1).OpenRecordset(SQLCmd, dbOpenDynaset)
   RSGadget.Name = "Returned Value"
   SetProperty RSGadget, "Command", SQLCmd
   SetProperty RSGadget, "RecalledRS.Recordcount", CStr(RecalledRS.RecordCount)
   
   SetProperty RSGadget, "Time", CStr(Timer - starttime)
   Set RSGadget.RS = RecalledRS
   
   RecallRS = RSGadget
End Function
Friend Function Recall(What As String, Optional From As String = "") As Gadget
    Dim starttime As Single, stoptime As Single
    starttime = Timer
'    Static CallCNTR As Long
    Dim tstarttime As Single, tstoptime As Single, ttime As Single
    Dim t, Msg As String, Cntr1 As Long, CNTR2 As Long
    Dim Status As Gadget
    Dim TotDone As Long, TotToDo As Long, RCancel As Boolean
    Dim LParam As Gadget
    Dim Result As Gadget
    Dim StartDBPTR As Integer, LOCDBPTR As Integer
    Dim UCASESentence As String, TSentence As String
    Dim FromWhere As String
    Dim UCASEFrom As String
    Dim AllNames() As String, AllNamesPTR As Long, AllNamesCNTR As Long
    Dim AllNamesDBs() As Integer, AllNamesDBsPTR As Long, AllNamesDBsCNTR As Long
    Dim AllNamesIDs() As Long
    Dim NameCompare As String
    Dim CurrentDBName As String
    Dim PropsBookmark As String
    Dim PropFound As Boolean
    Dim PropValueFound As Boolean
    Dim TotalNamesChecked As Long
    Dim ThisID As Long
    Dim IncludeNameInList As Boolean
    Dim AccumulatedGadgets() As Gadget, AccumulatedGadgetsPTR As Long, AccumulatedGadgetsCNTR As Long
    Dim ObjectName As String
    Dim AllProps() As String, AllPropsPTR As Long, AllpropsCNTR As Long
    Dim Props() As String, PropsPTR As Long, PropsCNTR As Long
    Dim PropValues() As String
    Dim CheckPropName As String, CheckPropValue As String
    Dim TotPropsMatched As Long
    Dim CurrentProp As String, CurrentPropValue As String
    Dim RecalledRS As Recordset
    Dim QuoteChar As String * 1
    Dim SQLCmd As String
    Dim SQLWhere As String
    Dim SQLOrder As String
    Dim StartAccesLevel As Long
    Dim LocalError As String
    StartAccesLevel = AccessLevel
    
    SetProperty Trace, NextID("trace") & "Recall Start *********************************", "************************"
    SetProperty Trace, NextID("trace") & "Recalling", What & " " & From
    SQLCmd = "SELECT DISTINCT Objects.Name FROM Objects LEFT JOIN Props ON Objects.ObjectID = Props.ObjectID " '  where (((Props.Property)='group') AND ((Props.ValueAlpha)='user defined')) ORDER BY Objects.Name;"
    SQLWhere = " WHERE "
    SQLOrder = " ORDER BY Objects.Name;"
    On Error GoTo LocalError
'    CallCNTR = CallCNTR + 1
    StartDBPTR = DBGadgetsPTR
    What = AllTrim(What)
    UCASESentence = UCase(What)
    UCASEFrom = UCase(From)
    Status.Name = What
    If InStr(UCASEFrom, VGBDatabaseName) > 0 Then
        AccessMode = 0
    Else
        AccessMode = AccessLevel
    End If
    If UCASEFrom = "FROM VCG MEMORIES" Then
        AccessLevel = 0
        From = VGBDatabaseName
        UCASEFrom = UCase(From)
    End If
    If Left(UCASESentence, 17) = "NAMES CONTAINING " Then
        ' names containing "joe" with: "
        Cntr1 = InStr(UCASESentence, DBLQuote) + 1
        CNTR2 = InStr(Cntr1, UCASESentence, DBLQuote)
        NameCompare = Mid(UCASESentence, Cntr1, CNTR2 - Cntr1)
    End If
    If InStr(UCASESentence, " WITH: ") > 0 Then
        ' this one has properties
        'TSentence = AllTrim(Right(What, Len(UcaseSentence) - InStr(UcaseSentence, "WITH") - 4))
        TSentence = AllTrim(Right(What, Len(UCASESentence) - InStr(UCASESentence, " WITH:") - 5))
        If InStr(TSentence, SingleQuote) = 0 Then
            QuoteChar = SingleQuote
        End If
        If InStr(TSentence, DBLQuote) = 0 Then
            QuoteChar = DBLQuote
        End If
        
'        Msg = "[" & TSentence & "] "
        AllProps = Split(TSentence, ",")
        AllpropsCNTR = UBound(AllProps)
        For AllPropsPTR = 0 To AllpropsCNTR
            If InStr(AllProps(AllPropsPTR), "=") > 0 Then
                PropsCNTR = PropsCNTR + 1
                ReDim Preserve Props(PropsCNTR)
                ReDim Preserve PropValues(PropsCNTR)
                Props(PropsCNTR) = AllTrim(Left(AllProps(AllPropsPTR), InStr(AllProps(AllPropsPTR), "=") - 1))
                PropValues(PropsCNTR) = AllTrim(Right(AllProps(AllPropsPTR), Len(AllProps(AllPropsPTR)) - InStr(AllProps(AllPropsPTR), "=")))
                If SQLWhere = " WHERE " Then
                    SQLWhere = SQLWhere & " (Props.Property=" & QuoteChar & Props(PropsCNTR) & QuoteChar & ") AND (Props.ValueAlpha=" & QuoteChar & PropValues(PropsCNTR) & QuoteChar & ")"
                Else
                    SQLWhere = SQLWhere & " AND (Props.Property=" & QuoteChar & Props(PropsCNTR) & QuoteChar & ") AND (Props.ValueAlpha=" & QuoteChar & PropValues(PropsCNTR) & QuoteChar & ")"
                End If
'                Msg = Msg & "[" & PropsCNTR & ": " & Props(PropsCNTR) & "=" & PropValues(PropsCNTR) & "] " & CrLf
            Else
                ' no property value, just property name
                PropsCNTR = PropsCNTR + 1
                ReDim Preserve Props(PropsCNTR)
                ReDim Preserve PropValues(PropsCNTR)
                Props(PropsCNTR) = AllTrim(AllProps(AllPropsPTR))
                PropValues(PropsCNTR) = ""
                If SQLWhere = " WHERE " Then
                    SQLWhere = SQLWhere & " (Props.Property=" & QuoteChar & Props(PropsCNTR) & QuoteChar & ") AND (Props.ValueAlpha like " & QuoteChar & "*" & QuoteChar & ")"
                Else
                    SQLWhere = SQLWhere & " AND (Props.Property=" & QuoteChar & Props(PropsCNTR) & QuoteChar & ") AND (Props.ValueAlpha like " & QuoteChar & "*" & QuoteChar & ")"
                End If
'                Msg = Msg & "[" & PropsCNTR & ": " & Props(PropsCNTR) & "=" & PropValues(PropsCNTR) & "] " & CrLf
            End If
        Next
'        FloatMsgBox Msg, "Properties"
    End If
    If InStr(TSentence, ",") > 0 Then
        ' add an or statememnt to catch anything with a coma in it
        If InStr(TSentence, "=") > 0 Then
            CheckPropName = AllTrim(Left(TSentence, InStr(TSentence, "=") - 1))
            CheckPropValue = AllTrim(Right(TSentence, Len(TSentence) - InStr(TSentence, "=")))
            SQLWhere = SQLWhere & " OR ((Props.Property=" & QuoteChar & CheckPropName & QuoteChar & ") AND (Props.ValueAlpha= " & QuoteChar & CheckPropValue & QuoteChar & "))"
        Else
            CheckPropName = AllTrim(TSentence)
            SQLWhere = SQLWhere & " OR ((Props.Property=" & QuoteChar & CheckPropName & QuoteChar & ") AND (Props.ValueAlpha= " & QuoteChar & "*" & QuoteChar & "))"
        End If
                
    End If
    If Len(From) > 0 Then
        ' they specified the source db
        Select Case True
            Case Left(UCASEFrom, 5) = "FROM "
                FromWhere = AllTrim(Right(From, Len(UCASEFrom) - 5))
            Case Else
                FromWhere = AllTrim(From)
        End Select
'        SetProperty Trace, NextID("trace") & "Parsed From", FromWhere
    End If
    
'/////////////////////////////////////////////////////////////////////////////////////////////
'/////////////////////////////////////////////////////////////////////////////////////////////
'/////////////////////////////////////////////////////////////////////////////////////////////
    ' not gonna check all databases every time
    ' if from not specified, then do all
    Cntr1 = 0
    CNTR2 = 0
    
    For LOCDBPTR = 0 To DBGadgetsCNTR
        Select Case True
            Case LOCDBPTR = 0 And AccessMode <> 0
                GoTo SkipPool:
            Case FromWhere <> ""
                t = DBFindIndex(FromWhere)
                If t < 0 Then
                    SetProperty Trace, NextID("trace") & "Recall Not trapped Error", "DB Findindex failed: " & FromWhere
                    Result.Name = From & " " & NotFound
                    SetProperty Result, "Error", FromWhere & " " & NotFound
                    GoTo EndSub
                End If
                LOCDBPTR = Val(t)
                t = DBSwitch(LOCDBPTR)
                If t <> OK Then
                    Result.Name = "Recall From Failed DBSwitch"
                    SetProperty Trace, NextID("trace") & "Recall Not trapped Error", "DB Switch failed: " & CStr(t) & "/" & FromWhere
                    SetProperty Result, "DBSwitch Failed", CStr(t)
                    Msg = Msg & "[DB Switch Failed: " & CStr(t) & "] "
                    GoTo EndSub
                End If
                CurrentDBName = ReadProperty(DBGadgets(LOCDBPTR), "DB Name")
            Case Else
                t = DBSwitch(LOCDBPTR)
                If t <> OK Then
                    Result.Name = "Recall Failed DBSwitch"
                    SetProperty Trace, NextID("trace") & "Recall Not trapped Error", "DB Switch failed: " & CStr(t)
                    SetProperty Result, "DBSwitch Failed", CStr(t)
                    Msg = Msg & "[DB Switch Failed: " & CStr(t) & "] "
                    GoTo EndSub
                End If
                CurrentDBName = ReadProperty(DBGadgets(LOCDBPTR), "DB Name")
        End Select
        Select Case True
            Case Left(UCASESentence, 7) = "SELECT "
                ' let's sent them a recordset
                Set Result.RS = OpenDB(OpenDBPTR).OpenRecordset(What, dbOpenDynaset)
                stoptime = Timer
                SetProperty Result, "Total Time", CStr(stoptime - starttime)
                Result.Name = "Select Results"
                GoTo EndSub
                
            Case UCASESentence = "ALL MEMORIES POOLS"
                If LOCDBPTR > 0 Then
                    Cntr1 = Cntr1 + 1
                    Msg = ReadProperty(DBGadgets(LOCDBPTR), "Path")
                    Msg = AddBackSlash(Msg)
                    Msg = Msg & ReadProperty(DBGadgets(LOCDBPTR), "DB Name")
                    SetProperty Result, "Name " & CStr(LOCDBPTR), Msg
                    SetProperty Result, "RecordCount " & CStr(LOCDBPTR), CStr(ObjectsRS.RecordCount)
                End If
                If LOCDBPTR = DBGadgetsCNTR Then
                    Result.Name = CStr(Cntr1) & " Memories Pools found"
                    stoptime = Timer
                    SetProperty Result, "Total Time", CStr(stoptime - starttime)
                    GoTo EndSub
                End If
            Case UCASESentence = "LAST OBJECTID"
                ObjectsRS.Index = "PrimaryKey"
                ObjectsRS.MoveLast
                SetProperty Result, ReadProperty(DBGadgets(LOCDBPTR), "DB Name"), CStr(ObjectsRS!ObjectID)
                If LOCDBPTR = DBGadgetsCNTR Then
                    Result.Name = "Last Object IDs"
                    
                    GoTo EndSub
                End If
            Case UCASESentence = "COUNT OBJECTS"
                LocalError = ""
                ObjectsRS.MoveFirst
                If UCase(LocalError) = UCase("No current record.") Then
                    TotalNamesChecked = TotalNamesChecked + 0
                Else
                    ObjectsRS.MoveLast
                    TotalNamesChecked = TotalNamesChecked + ObjectsRS.RecordCount
                End If
            
            Case UCASESentence = "NAMES"
                ' returns all names in all databases
                ' ObjectsRS.MoveLast
                If True = True Then 'ObjectsRS.RecordCount > 5500 Then
                    SQLCmd = "SELECT DISTINCT Objects.Name FROM Objects order by objects.name;"
                    Set RecalledRS = OpenDB(OpenDBPTR).OpenRecordset(SQLCmd, dbOpenDynaset)
                    RecalledRS.MoveLast
                    Result.TotalProperties = Result.TotalProperties + RecalledRS.RecordCount
                    ReDim Preserve Result.Propity(Result.TotalProperties)
                    ReDim Preserve Result.ValueAlpha(Result.TotalProperties)
                    RecalledRS.MoveFirst
                    Do While RecalledRS.EOF = False And LocalError = ""
                        AllNamesCNTR = AllNamesCNTR + 1
                        Result.Propity(AllNamesCNTR) = "Name " & CStr(AllNamesCNTR)
                        Result.ValueAlpha(AllNamesCNTR) = RecalledRS!Name
                        RecalledRS.MoveNext
                    Loop
                Else
                    ObjectsRS.Index = "Name"
                    ObjectsRS.MoveFirst
                    Do While ObjectsRS.EOF = False
                        Cntr1 = Cntr1 + 1
                        If Cntr1 > 200 Then
'                            ShowRecallStatus (Cntr1)
                            DoEvents
                        End If
                        If UserCancel Then
                            UserCancel = False
                            SetProperty Result, "User Cancel", "True"
                            GoTo SkipRest:
                        End If
                        Result.TotalProperties = Result.TotalProperties + 1
                        ReDim Preserve Result.Propity(Result.TotalProperties)
                        ReDim Preserve Result.ValueAlpha(Result.TotalProperties)
                        Result.Propity(Result.TotalProperties) = "Name " & CStr(Result.TotalProperties)
                        Result.ValueAlpha(Result.TotalProperties) = ObjectsRS!Name
                        
'                        SetProperty Result, "Name " & CStr(Cntr1), ObjectsRS!Name
'                       SetProperty Result, "DB " & CStr(Cntr1), DBGadgets(LOCDBPTR).Name
                        ObjectsRS.MoveNext
                        If Cntr1 Mod 50 = 0 Then
'                           SetProperty Status, "Done", CStr(Cntr1)
                            TotDone = Cntr1
                            TotToDo = 0
                            RaiseEvent RecallStatus(TotDone, TotToDo, RCancel)
                            If RCancel = True Then
                                Result.Name = What & " Cancelled"
                                GoTo EndSub
                            End If
                        End If
                    Loop
                    If (LOCDBPTR = DBGadgetsCNTR) Or (Len(From) > 0) Then
                        Result.Name = CStr(Cntr1) & " Names Found"
                        stoptime = Timer
                        SetProperty Result, "Read Start", CStr(starttime)
                        SetProperty Result, "Read End", CStr(Timer)
                        SetProperty Result, "Read Total Time", CStr(stoptime - starttime)
                        SetProperty Result, "Read Total Checked", CStr(Cntr1)
                        GoTo EndSub
                    End If
                End If
                
'            Case Left(UcaseSentence, 11) = "NAMES LIKE "
'                TSentence = AllTrim(Right(What, Len(What) - 11))
            Case Left(UCASESentence, 9) = "ANY NAME " And InStr(UCASESentence, " WITH: ") > 0
                TSentence = AllTrim(Right(What, Len(UCASESentence) - InStr(UCASESentence, "=")))
                IncludeNameInList = False
                If Result.Name <> "Found" Then
                    Result.Name = NotFound
                End If
                PropsRS.Index = "ValueAlpha"
                PropsRS.Seek "=", PropValues(1)
                
                Do While PropsRS.NoMatch = False
                    If UCase(PropsRS!Property) = UCase(Props(1)) Then
                        IncludeNameInList = True
                        Exit Do
                    End If
                    PropsRS.MoveNext
                    If PropsRS.EOF Then
                        Exit Do
                    End If
                    If UCase(PropsRS!ValueAlpha) <> UCase(PropValues(1)) Then
                        Exit Do
                    End If
                    
                Loop
                If IncludeNameInList = True Then
                    SetProperty Result, What & " " & CStr(LOCDBPTR), PropsRS!Property
                    SetProperty Result, "Value" & " " & CStr(LOCDBPTR), PropsRS!ValueAlpha
                    SetProperty Result, "Result", "Found"
                    Result.Name = "Found"
                    If Len(From) > 0 Then
                        GoTo EndSub
                    End If
                Else
                    SetProperty Result, TSentence & " " & CStr(LOCDBPTR), NotFound
                    SetProperty Result, TSentence & " " & CStr(LOCDBPTR), NotFound
                    SetProperty Result, "Value" & " " & CStr(LOCDBPTR), "None"
                    SetProperty Result, "Result", NotFound
                End If
                If LOCDBPTR = DBGadgetsCNTR Then
                    GoTo EndSub
                End If
            Case Left(UCASESentence, 29) = "PROPERTY NAMES WITHOUT LINES" And (DBGadgetsPTR <> 0 Or DevelopmentMode)
                SQLCmd = "SELECT distinct Props.Property From Props where instr(props.property," & DBLQuote & "-Line #" & DBLQuote & ")=0 ORDER BY Props.Property;"
                Set RecalledRS = OpenDB(OpenDBPTR).OpenRecordset(SQLCmd, dbOpenDynaset)
                RecalledRS.MoveLast
                Result.TotalProperties = Result.TotalProperties + RecalledRS.RecordCount
                ReDim Preserve Result.Propity(Result.TotalProperties)
                ReDim Preserve Result.ValueAlpha(Result.TotalProperties)
                RecalledRS.MoveFirst
                Do While RecalledRS.EOF = False And LocalError = ""
                    If RecalledRS!Property <> "DU" And RecalledRS!Property <> "DP" Then
                        AllNamesCNTR = AllNamesCNTR + 1
                        Result.Propity(AllNamesCNTR) = "Property " & CStr(AllNamesCNTR)
                        Result.ValueAlpha(AllNamesCNTR) = RecalledRS!Property
'                        Result.PropType(AllNamesCNTR) = RecalledRS!PropType
                    End If
                    RecalledRS.Move 1
                Loop
                If LOCDBPTR = DBGadgetsCNTR Then
                    GoTo EndSub
                End If
                If Len(From) > 0 Then
                    GoTo EndSub
                End If
            Case Left(UCASESentence, 14) = "PROPERTY NAMES" And (DBGadgetsPTR <> 0 Or DevelopmentMode)
                SQLCmd = "SELECT distinct Props.Property From Props ORDER BY Props.Property;"
                Set RecalledRS = OpenDB(OpenDBPTR).OpenRecordset(SQLCmd, dbOpenDynaset)
                RecalledRS.MoveLast
                Result.TotalProperties = Result.TotalProperties + RecalledRS.RecordCount
                ReDim Preserve Result.Propity(Result.TotalProperties)
                ReDim Preserve Result.ValueAlpha(Result.TotalProperties)
'                ReDim Preserve Result.PropType(Result.TotalProperties)
                RecalledRS.MoveFirst
                Do While RecalledRS.EOF = False And LocalError = ""
                    If RecalledRS!Property <> "DU" And RecalledRS!Property <> "DP" Then
                        AllNamesCNTR = AllNamesCNTR + 1
                        Result.Propity(AllNamesCNTR) = "Property " & CStr(AllNamesCNTR)
                        Result.ValueAlpha(AllNamesCNTR) = RecalledRS!Property
'                        Result.PropType(AllNamesCNTR) = RecalledRS!PropType
                    End If
                    RecalledRS.Move 1
                Loop
                If LOCDBPTR = DBGadgetsCNTR Then
                    GoTo EndSub
                End If
                If Len(From) > 0 Then
                    GoTo EndSub
                End If

                
            Case Left(UCASESentence, 6) = "NAMES " And InStr(UCASESentence, " WITH: ") > 0
                ' we're returning names of gobjects
                ' query has property qualifiers
                ' need to get all the properties to evaluate from the What
                ' "Names with Wife,Type=User,Hair Color=Black"
'                If PropsCNTR > 1 Then
'                    GoTo MultiProps
'                End If
                Msg = SQLCmd & SQLWhere & SQLOrder
                Set RecalledRS = OpenDB(OpenDBPTR).OpenRecordset(Msg, dbOpenDynaset)
                Set Result.RS = RecalledRS
                Do While (RecalledRS.EOF = False) And (LocalError = "")
                    DoEvents
                    If LocalError <> "" Then
                        Exit Do
                    End If
                    IncludeNameInList = True
                    
                    If NameCompare <> "" Then
                       If InStr(UCase(RecalledRS!Name), NameCompare) = 0 Then
                          IncludeNameInList = False
                        End If
                    End If
                    If IncludeNameInList = True Then
                        AllNamesCNTR = AllNamesCNTR + 1
                        Result.TotalProperties = Result.TotalProperties + 1
                        ReDim Preserve Result.Propity(Result.TotalProperties)
                        ReDim Preserve Result.ValueAlpha(Result.TotalProperties)
                        Result.Propity(Result.TotalProperties) = "Name " & CStr(AllNamesCNTR)
                        Result.ValueAlpha(Result.TotalProperties) = RecalledRS!Name
                        ' now db name (pool)
                    End If
                    If Len(From) = 0 Then
                        Result.TotalProperties = Result.TotalProperties + 1
                        ReDim Preserve Result.Propity(Result.TotalProperties)
                        ReDim Preserve Result.ValueAlpha(Result.TotalProperties)
                        Result.Propity(Result.TotalProperties) = "Pool " & CStr(AllNamesCNTR)
                        Result.ValueAlpha(Result.TotalProperties) = CurrentDBName
                        
                        TotDone = Result.TotalProperties
                        TotToDo = 0
                        RaiseEvent RecallStatus(TotDone, TotToDo, RCancel)
                        If RCancel = True Then
                            Result.Name = What & " Cancelled"
                            GoTo EndSub
                        End If
                        'DoEvents
                    End If
                    RecalledRS.Move 1
                Loop
                If PropsCNTR > 1 And AllNamesCNTR = 0 Then
                    GoTo MultiProps
                End If
                
                Result.Name = CStr(AllNamesCNTR) & " Names Found"
                If LOCDBPTR = DBGadgetsCNTR Then
                    GoTo EndSub
                End If
                If Len(From) > 0 Then
                    GoTo EndSub
                End If
                If LocalError = "" Then
                    ' this means that the select worked
                    GoTo skipold
                End If
                ' gets to here if there was an error with select
MultiProps:
                ObjectsRS.Index = "PrimaryKey"
                For PropsPTR = 0 To PropsCNTR
                    IncludeNameInList = False
                    If (Len(Props(PropsPTR)) > 0) And (PropValues(PropsPTR) <> "") Then
                        ' this one has a property and a prop value to check
                        ' check for a value that matches first, seems more effecient
                        PropsRS.Index = "Property"
                        PropsRS.Seek "=", Props(PropsPTR)
                        If PropsRS.NoMatch = False Then
                            PropFound = True
                            SetProperty Result, "Property Seek OK", Props(PropsPTR)
                        Else
                            PropFound = False
                            SetProperty Result, "Property Seek Failed", Props(PropsPTR)
                        End If
                        
                        PropsRS.Index = "ValueAlpha"
                        PropsRS.Seek "=", PropValues(PropsPTR)
                        If PropsRS.NoMatch = True Then
                            SetProperty Result, "Property Value Seek Failed", PropValues(PropsPTR)
                        Else
                            SetProperty Result, "Property Value Seek OK", PropValues(PropsPTR)
                        End If
                        Do While (PropsRS.NoMatch = False) And PropFound ' And (PropValues(PropsPTR) <> "")
                            DoEvents
                            ' this prop value is on disk
                            ' need to chck to see if the property name is the same as the one we're checking
                            TotalNamesChecked = TotalNamesChecked + 1
                            PropsBookmark = PropsRS.Bookmark
                            ThisID = PropsRS!ObjectID
                            CurrentProp = PropsRS!Property
                            CurrentPropValue = PropsRS!ValueAlpha
                            ' this disk property is same as the one in passed properties
                            ' and the value on disk is same as passed
                            ' need to add this object name if it is not already in list
                            IncludeNameInList = True
                            For Cntr1 = 1 To AllNamesCNTR
                                If (AllNamesIDs(Cntr1) = ThisID) And (AllNamesDBs(Cntr1) = LOCDBPTR) Then
                                    ' this name is already in the list, skip it
                                    IncludeNameInList = False
                                    Exit For
                                End If
                            Next
                            If IncludeNameInList = True Then
                                ' name is not in list, see if it needs to be
'                                tstarttime = Timer
                                't = ReadGadgetByID(ThisID)
                                ' check all props records for this object id
                                PropsRS.Index = "ObjectID"
                                PropsRS.Seek "=", ThisID
                                CNTR2 = 0
                                IncludeNameInList = False
                                TotPropsMatched = 0
                                Do While PropsRS!ObjectID = ThisID
                                    For Cntr1 = 1 To PropsCNTR
                                        DoEvents
                                        If (UCase(PropsRS!Property) = UCase(Props(Cntr1))) Then
                                            If Len(PropValues(Cntr1)) > 0 Then
                                                If (UCase(PropsRS!ValueAlpha) = UCase(PropValues(Cntr1))) Then
                                                    ' this property and value matches the check list
                                                    TotPropsMatched = TotPropsMatched + 1
                                                Else
                                                    Exit For
                                                End If
                                            Else
                                                TotPropsMatched = TotPropsMatched + 1
                                            End If
                                        End If
                                    Next
                                    If TotPropsMatched = PropsCNTR Then
                                        ' disk property found in list
                                        IncludeNameInList = True
                                        Exit Do
                                    End If
                                    PropsRS.MoveNext
                                    If PropsRS.EOF Then
                                        Exit Do
                                    End If
                                    DoEvents
                                Loop
                            End If
                            If NameCompare <> "" And IncludeNameInList Then
                                If InStr(ObjectsRS!Name, NameCompare) = 0 Then
                                    IncludeNameInList = False
                                End If
                            End If
                            If IncludeNameInList = True Then
                                ' after all that, we have a winner
                                ObjectsRS.Index = "PrimaryKey"
                                ObjectsRS.Seek "=", ThisID
                                AllNamesCNTR = AllNamesCNTR + 1
                                ReDim Preserve AllNames(AllNamesCNTR)
                                ReDim Preserve AllNamesDBs(AllNamesCNTR)
                                ReDim Preserve AllNamesIDs(AllNamesCNTR)
                                AllNames(AllNamesCNTR) = ObjectsRS!Name
                                AllNamesDBs(AllNamesCNTR) = LOCDBPTR
                                AllNamesIDs(AllNamesCNTR) = ObjectsRS!ObjectID
                                Result.TotalProperties = Result.TotalProperties + 1
                                ReDim Preserve Result.Propity(Result.TotalProperties)
                                ReDim Preserve Result.ValueAlpha(Result.TotalProperties)
                                Result.Propity(Result.TotalProperties) = "Name " & CStr(AllNamesCNTR)
                                Result.ValueAlpha(Result.TotalProperties) = ObjectsRS!Name
                                ' now db name (pool)
                                If Len(From) = 0 Then
                                    Result.TotalProperties = Result.TotalProperties + 1
                                    ReDim Preserve Result.Propity(Result.TotalProperties)
                                    ReDim Preserve Result.ValueAlpha(Result.TotalProperties)
                                    Result.Propity(Result.TotalProperties) = "Pool " & CStr(AllNamesCNTR)
                                    Result.ValueAlpha(Result.TotalProperties) = CurrentDBName
                                
                                    TotDone = Result.TotalProperties
                                    TotToDo = 0
                                    RaiseEvent RecallStatus(TotDone, TotToDo, RCancel)
                                    If RCancel = True Then
                                        Result.Name = What & " Cancelled"
                                        GoTo EndSub
                                    End If
                                    'DoEvents
                                End If
                            End If
                            PropsRS.Index = "ValueAlpha"
                            PropsRS.Bookmark = PropsBookmark
                            PropsRS.MoveNext
                            If PropsRS.EOF Then
                                Exit Do
                            End If
                            If UCase(PropsRS!ValueAlpha) <> UCase(PropValues(PropsPTR)) Then
                                Exit Do
                            End If
                            DoEvents
                        Loop
                    End If
                    ' check props without values ////////////////////////////////////
                    If (Len(Props(PropsPTR)) > 0) And (PropValues(PropsPTR) = "") Then
                        ' this property name has a value but the value doesn't
                        ' look property name up in properties table
                        PropsRS.Index = "Property"
                        PropsRS.Seek "=", Props(PropsPTR)
                        Do While (PropsRS.NoMatch = False)  ' And (PropValues(PropsPTR) <> "")
                            DoEvents
                            TotalNamesChecked = TotalNamesChecked + 1
                            ThisID = PropsRS!ObjectID
                            PropsBookmark = PropsRS.Bookmark
                            ' this disk property is same as the one in passed properties
                            ' and the value on disk is same as passed
                            ' read this object if it is not already in list
                            IncludeNameInList = True
                            For Cntr1 = 1 To AllNamesCNTR
                                If (AllNamesIDs(Cntr1) = ThisID) And (AllNamesDBs(Cntr1) = LOCDBPTR) Then
                                    ' this name is already in the list
                                    IncludeNameInList = False
                                    Exit For
                                End If
                            Next
                            If NameCompare <> "" And IncludeNameInList Then
                                If InStr(ObjectsRS!Name, NameCompare) = 0 Then
                                    IncludeNameInList = False
                                End If
                            End If
                            
                            If IncludeNameInList = True Then
                                ' name is not in list, see if it needs to be
'                                tstarttime = Timer
                                't = ReadGadgetByID(ThisID)
                                ' check all props records for this object id

                                PropsRS.Index = "ObjectID"
                                PropsRS.Seek "=", ThisID
                                CNTR2 = 0
                                IncludeNameInList = False
                                TotPropsMatched = 0
                                Do While PropsRS!ObjectID = ThisID
                                    For Cntr1 = 1 To PropsCNTR
                                        DoEvents
                                        If (UCase(PropsRS!Property) = UCase(Props(Cntr1))) Then
                                            If Len(PropValues(Cntr1)) > 0 Then
                                                If (UCase(PropsRS!ValueAlpha) = UCase(PropValues(Cntr1))) Then
                                                    ' this property and value matches the check list
                                                    TotPropsMatched = TotPropsMatched + 1
                                                Else
                                                    Exit For
                                                End If
                                            Else
                                                TotPropsMatched = TotPropsMatched + 1
                                            End If
                                        End If
                                    Next
                                    If TotPropsMatched = PropsCNTR Then
                                        ' disk property found in list
                                        IncludeNameInList = True
                                        Exit Do
                                    End If
                                    PropsRS.MoveNext
                                    If PropsRS.EOF Then
                                        Exit Do
                                    End If
                                    DoEvents
                                Loop
                            End If
                            
                            If IncludeNameInList = True Then
                                ' after all that, we have a winner
                                ObjectsRS.Index = "PrimaryKey"
                                ObjectsRS.Seek "=", ThisID
                                AllNamesCNTR = AllNamesCNTR + 1
                                ReDim Preserve AllNames(AllNamesCNTR)
                                ReDim Preserve AllNamesDBs(AllNamesCNTR)
                                ReDim Preserve AllNamesIDs(AllNamesCNTR)
                                AllNames(AllNamesCNTR) = ObjectsRS!Name
                                AllNamesDBs(AllNamesCNTR) = LOCDBPTR
                                AllNamesIDs(AllNamesCNTR) = ObjectsRS!ObjectID
                                Result.TotalProperties = Result.TotalProperties + 1
                                ReDim Preserve Result.Propity(Result.TotalProperties)
                                ReDim Preserve Result.ValueAlpha(Result.TotalProperties)
                                Result.Propity(Result.TotalProperties) = "Name " & CStr(AllNamesCNTR)
                                Result.ValueAlpha(Result.TotalProperties) = ObjectsRS!Name
                                
                                ' now db name (pool)
                                If Len(From) = 0 Then
                                    Result.TotalProperties = Result.TotalProperties + 1
                                    ReDim Preserve Result.Propity(Result.TotalProperties)
                                    ReDim Preserve Result.ValueAlpha(Result.TotalProperties)
                                    Result.Propity(Result.TotalProperties) = "Pool " & CStr(AllNamesCNTR)
                                    Result.ValueAlpha(Result.TotalProperties) = CurrentDBName
                                End If
                                
                                If Result.TotalProperties Mod 50 = 0 Then
                                    TotDone = Result.TotalProperties
                                    TotToDo = 0
                                    RaiseEvent RecallStatus(TotDone, TotToDo, RCancel)
                                    If RCancel = True Then
                                        Result.Name = What & " Cancelled"
                                        GoTo EndSub
                                    End If
                                    'DoEvents
                                End If
                            End If
                            PropsRS.Index = "Property"
                            PropsRS.Bookmark = PropsBookmark
                            PropsRS.MoveNext
                            If PropsRS.EOF Then
                                Exit Do
                            End If
                            If UCase(PropsRS!Property) <> UCase(Props(PropsPTR)) Then
                                Exit Do
                            End If
'                            If (Result.TotalProperties > 300) Then
''                                OSDetectAndStatus.ProgressGauge.Min = 0
''                                OSDetectAndStatus.ProgressGauge.Value = 0
'                                OSDetectAndStatus.GageLabel.Caption = "0 %"
'                                OSDetectAndStatus.Visible = True
'                            End If
                            If (Result.TotalProperties Mod 200 = 0) Then
'                                ShowRecallStatus (TotalNamesChecked)
                                DoEvents
                            End If
                            If UserCancel = True Then
                                UserCancel = False
                                SetProperty Result, "User Cancel", "True"
                                GoTo SkipRest:
                            End If
                            DoEvents
                            DoEvents
                        Loop
                    End If
                Next
skipold:
'            Case Left(UcaseSentence, 17) = "UNIQUE VALUES OF "
'                TSentence = AllTrim(Right(What, Len(UcaseSentence) - InStr(UcaseSentence, "UNIQUE VALUES OF ") - 16))
'                PropsRS.Index = "Property"
'                PropsRS.Seek "=", TSentence
'                Do While PropsRS.NoMatch = False
'                    CurrentProp = PropsRS!Property
'                    CurrentPropValue = PropsRS!ValueAlpha
            Case NameCompare <> ""
                ' just a set of names like the one the sent
                SQLCmd = "SELECT Objects.Name FROM Objects where Objects.name like '*" & NameCompare & "*';"
                Set RecalledRS = OpenDB(OpenDBPTR).OpenRecordset(SQLCmd, dbOpenDynaset)
                RecalledRS.MoveLast
                Result.TotalProperties = Result.TotalProperties + RecalledRS.RecordCount
                ReDim Preserve Result.Propity(Result.TotalProperties)
                ReDim Preserve Result.ValueAlpha(Result.TotalProperties)
                RecalledRS.MoveFirst
                Do While RecalledRS.EOF = False And LocalError = ""
                    AllNamesCNTR = AllNamesCNTR + 1
                    Result.Propity(AllNamesCNTR) = "Name " & CStr(AllNamesCNTR)
                    Result.ValueAlpha(AllNamesCNTR) = RecalledRS!Name
                    RecalledRS.Move 1
                Loop
                Result.Name = CStr(AllNamesCNTR) & " Names Found"
                GoTo EndSub
            Case Left(UCASESentence, 16) = "COUNT PROPERTIES"
                TSentence = AllTrim(Right(What, Len(UCASESentence) - InStr(UCASESentence, "COUNT OF ") - 8))
                SQLCmd = "SELECT distinct count (property) " & _
                         "as [TotProps] From Props;"
                Set RecalledRS = OpenDB(OpenDBPTR).OpenRecordset(SQLCmd, dbOpenDynaset)
                AllNamesCNTR = AllNamesCNTR + Val(RecalledRS!TotProps)
                Result.Name = CStr(AllNamesCNTR) & " Properties " & " found"
'                GoTo EndSub
                If LOCDBPTR = DBGadgetsCNTR Then
                    GoTo EndSub
                End If
                If Len(From) > 0 Then
                    GoTo EndSub
                End If
            
            Case Left(UCASESentence, 9) = "COUNT OF "
                TSentence = AllTrim(Right(What, Len(UCASESentence) - InStr(UCASESentence, "COUNT OF ") - 8))
                SQLCmd = "SELECT distinct count (valuealpha) " & _
                         "as [TotProps] From Props " & _
                         "where props.property='" & TSentence & "';"
                Set RecalledRS = OpenDB(OpenDBPTR).OpenRecordset(SQLCmd, dbOpenDynaset)
                AllNamesCNTR = AllNamesCNTR + Val(RecalledRS!TotProps)
                Result.Name = CStr(AllNamesCNTR) & " Values of " & TSentence & " found"
'                GoTo EndSub
                If LOCDBPTR = DBGadgetsCNTR Then
                    GoTo EndSub
                End If
                If Len(From) > 0 Then
                    GoTo EndSub
                End If
                
            Case Left(UCASESentence, 10) = "VALUES OF "
                ' extract property values
'                Msg = Msg & "[DB=" & CStr(LOCDBPTR) & "] "
                TSentence = AllTrim(Right(What, Len(UCASESentence) - InStr(UCASESentence, "VALUES OF ") - 9))
                SQLCmd = "SELECT DISTINCT Props.valuealpha " & _
                         "From Props " & _
                         "where props.property='" & TSentence & "' " & _
                         "ORDER BY Props.valuealpha;"
                Set RecalledRS = OpenDB(OpenDBPTR).OpenRecordset(SQLCmd, dbOpenDynaset)
                RecalledRS.MoveLast
                Result.TotalProperties = RecalledRS.RecordCount
                ReDim Preserve Result.Propity(Result.TotalProperties)
                ReDim Preserve Result.ValueAlpha(Result.TotalProperties)
                RecalledRS.MoveFirst
                Do While RecalledRS.EOF = False And LocalError = ""
                    AllNamesCNTR = AllNamesCNTR + 1
                    Result.Propity(AllNamesCNTR) = TSentence & " " & CStr(AllNamesCNTR) ' & CStr(AllNamesCNTR)
                    Result.ValueAlpha(AllNamesCNTR) = RecalledRS!ValueAlpha
                    RecalledRS.Move 1
                Loop
                TotalNamesChecked = AllNamesCNTR
                Result.Name = CStr(Result.TotalProperties) & " Values of " & TSentence & " found"
                stoptime = Timer
                SetProperty Result, "Total Checked", CStr(TotalNamesChecked)
                SetProperty Result, "Total Time", CStr(stoptime - starttime)
                If TotalNamesChecked > 0 Then
                    SetProperty Result, "Time/Check", CStr((stoptime - starttime) / TotalNamesChecked)
                End If
                If LOCDBPTR = DBGadgetsCNTR Then
                    GoTo EndSub
                End If
                If Len(From) > 0 Then
                    GoTo EndSub
                End If
                GoTo skipoldvaluesof
                                
                
                PropsRS.Index = "Property"
                PropsRS.Seek "=", TSentence
                Do While PropsRS.NoMatch = False
                    TotalNamesChecked = TotalNamesChecked + 1
                    CurrentProp = PropsRS!Property
                    CurrentPropValue = PropsRS!ValueAlpha
                    For Cntr1 = 1 To AllNamesCNTR
                        If AllNames(Cntr1) = PropsRS!ValueAlpha Then
                            Exit For
                        End If
                    Next
                    If Cntr1 > AllNamesCNTR Then
                        AllNamesCNTR = AllNamesCNTR + 1
                        ReDim Preserve AllNames(AllNamesCNTR)
                        AllNames(AllNamesCNTR) = PropsRS!ValueAlpha
                        
                        Result.TotalProperties = Result.TotalProperties + 1
                        ReDim Preserve Result.Propity(Result.TotalProperties)
                        ReDim Preserve Result.ValueAlpha(Result.TotalProperties)
                        Result.Propity(Result.TotalProperties) = TSentence & " " & CStr(Result.TotalProperties)
                        Result.ValueAlpha(Result.TotalProperties) = PropsRS!ValueAlpha
                    End If
                    PropsRS.MoveNext
'                    Do While (PropsRS!Property = CurrentProp) And (PropsRS!ValueAlpha = CurrentPropValue)
'                        PropsRS.MoveNext
'                        If PropsRS.EOF Then
'                            Exit Do
'                        End If
'                    Loop
                    If PropsRS.EOF Then
                        Exit Do
                    End If
                    If UCase(PropsRS!Property) <> UCase(TSentence) Then
                        Exit Do
                    End If
                    If Result.TotalProperties Mod 50 = 0 Then
'                        FloatMsgBox "Total Done: " & CStr(Result.TotalProperties), "Recall Status"
'                        SetProperty Status, "Done", CStr(Result.TotalProperties)
                        TotDone = Result.TotalProperties
                        TotToDo = 0
                        RaiseEvent RecallStatus(TotDone, TotToDo, RCancel)
                        If RCancel = True Then
                            Result.Name = What & " Cancelled"
                            GoTo EndSub
                        End If
'                        DoEvents
                    End If
                Loop
                If (LOCDBPTR = DBGadgetsCNTR) Or (Len(From) > 0) Then
                    Result.Name = CStr(Result.TotalProperties) & " Values of " & TSentence & " found"
                    stoptime = Timer
                    SetProperty Result, "Total Checked", CStr(TotalNamesChecked)
                    SetProperty Result, "Total Time", CStr(stoptime - starttime)
                    If TotalNamesChecked > 0 Then
                        SetProperty Result, "Time/Check", CStr((stoptime - starttime) / TotalNamesChecked)
                    End If
                
                    'TotalNamesChecked
                    GoTo EndSub
                End If
skipoldvaluesof:
            Case InStr(UCASESentence, " WITH: ") > 0
                Result.Name = "0 " & What & " found"
                ObjectName = AllTrim(Left(What, InStr(UCASESentence, "WITH:") - 1))
'                Msg = "Seeking Object: " & ObjectName & " in: " & DBGadgets(LOCDBPTR).Name & CrLf
'                FloatMsgBox Msg, "Seek: " & What
                ObjectsRS.Index = "Name"
                ObjectsRS.Seek "=", ObjectName
                
                Do While ObjectsRS.NoMatch = False
                    TotDone = TotDone + 1
'                    Msg = "ObjectRS: " & ObjectsRS!Name & CrLf
'                    FloatMsgBox Msg, "Found: " & ObjectsRS!Name & " / " & CStr(ObjectsRS!ObjectID)
                    ThisID = ObjectsRS!ObjectID
                    PropsRS.Index = "ObjectID"
                    PropsRS.Seek "=", ThisID
                    AllPropsPTR = 0
                    Do While PropsRS.NoMatch = False
'                        Msg = "ObjectRS: " & ObjectsRS!Name & CrLf
'                        FloatMsgBox Msg, "Found: " & ObjectsRS!Name
                        
'                        Msg = Msg & "Properties: " & PropsRS!Property & ": " & PropsRS!ValueAlpha & CrLf
                        For PropsPTR = 1 To PropsCNTR
                            If (UCase(PropsRS!Property) = UCase(Props(PropsPTR))) And _
                               (UCase(PropsRS!ValueAlpha) = UCase(PropValues(PropsPTR))) Then
                                AllPropsPTR = AllPropsPTR + 1
                            End If
                        Next
                        If AllPropsPTR = PropsCNTR Then
                            ' this is the one with all properties same as passed
                            t = ReadGadgetByID(ThisID)
                            If t = OK Then
                                Result = ReadObjectBuffer
                                GoTo EndSub
                            Else
                                Result.Name = "Error Reading: " & ObjectsRS!Name
                                GoTo EndSub
                            End If
                        End If
                        PropsRS.MoveNext
                        If PropsRS.EOF Then
                            Exit Do
                        End If
                        If PropsRS!ObjectID <> ThisID Then
                            Exit Do
                        End If
                    Loop
                    ObjectsRS.MoveNext
                    If ObjectsRS.EOF Then
                        Exit Do
                    End If
                    If ObjectsRS!Name <> ObjectName Then
                        Exit Do
                    End If
                Loop
                If (LOCDBPTR = DBGadgetsCNTR) Or (Len(From) > 0) Then
'                    Msg = "Total Done: " & CStr(TotDone) & CrLf
'                    FloatMsgBox Msg, "Total: " & ObjectName
                    Msg = ""
                    GoTo EndSub
                End If
                
            Case Else
                ' it is just a gobject name
                ' need to load all instances, if multiple
                ObjectsRS.Index = "Name"
                ObjectsRS.Seek "=", What
                Do While ObjectsRS.NoMatch = False
                    AllNamesCNTR = AllNamesCNTR + 1
                    ReDim Preserve AllNames(AllNamesCNTR)
                    ReDim Preserve AllNamesDBs(AllNamesCNTR)
                    ReDim Preserve AllNamesIDs(AllNamesCNTR)
                    AllNames(AllNamesCNTR) = ObjectsRS!Name
                    AllNamesIDs(AllNamesCNTR) = ObjectsRS!ObjectID
                    AllNamesDBs(AllNamesCNTR) = LOCDBPTR
                    ObjectsRS.MoveNext
                    If ObjectsRS.EOF Then
                        Exit Do
                    End If
                    If ObjectsRS!Name <> What Then
                        Exit Do
                    End If
                Loop
        End Select
        If FromWhere <> "" Then Exit For
SkipPool:
    Next LOCDBPTR
'/////////////////////////////////////////////////////////////////////////////////////////////
'/////////////////////////////////////////////////////////////////////////////////////////////
'/////////////////////////////////////////////////////////////////////////////////////////////
'    FloatMsgBox "Sentence=" & CStr(What), "Recall Debug"
SkipRest:
    If UCASESentence = "COUNT OBJECTS" Then
        Result.Name = CStr(TotalNamesChecked) & " " & What & " found"
        stoptime = Timer
        SetProperty Result, "Read Total Checked", CStr(TotalNamesChecked)
        SetProperty Result, "Read Start", CStr(starttime)
        SetProperty Result, "Read End", CStr(stoptime)
        SetProperty Result, "Read Total", CStr(stoptime - starttime)
        GoTo EndSub
    End If
    If UCASESentence = "NAMES" Or _
       (Left(UCASESentence, 6) = "NAMES " And InStr(UCASESentence, " WITH: ") > 0) Then
'        Select Case True
'            Case AllNamesCNTR = 0
'                Result.Name = NotFound
'            Case AllNamesCNTR = 1
'                Result.Name = "Found One"
'            Case AllNamesCNTR > 1
'                Result.Name = "Found Multiple"
'        End Select
        Result.Name = CStr(AllNamesCNTR) & " " & What & " found"
        stoptime = Timer
        SetProperty Result, "Read Total Checked", CStr(TotalNamesChecked)
        SetProperty Result, "Read Start", CStr(starttime)
        SetProperty Result, "Read End", CStr(stoptime)
        SetProperty Result, "Read Total Time", CStr(stoptime - starttime)
        
        GoTo EndSub
    End If
    
'    Msg = Msg & "[AllNamesCNTR=" & CStr(AllNamesCNTR) & " ]"
    ' this fills in names if more than one found
    If AllNamesCNTR = 1 Then
        ' found just one gobject, return it
        If AllNamesDBs(AllNamesCNTR) <> DBGadgetsPTR Then
            DBSwitch AllNamesDBs(AllNamesCNTR)
        End If
        t = ReadGadgetByID(AllNamesIDs(1))
        Result = ReadObjectBuffer
'        LParam.Name = AllNames(AllNamesCNTR)
'        SetProperty LParam, "ReadBy", "Name"
'        SetProperty LParam, "Scope", "Current"
'        Result = ReadGadget(LParam)
    Else
        If AllNamesCNTR = 0 Then
            Result.Name = NotFound
        Else
            Result.Name = "Found Multiple"
            For AllNamesPTR = 0 To AllNamesCNTR
                If AllNames(AllNamesPTR) <> "" Then
                    SetProperty Result, "Name " & CStr(AllNamesPTR), AllNames(AllNamesPTR)
                    SetProperty Result, "ID " & CStr(AllNamesPTR), CStr(AllNamesIDs(AllNamesPTR))
                    SetProperty Result, "DB " & CStr(AllNamesPTR), CStr(AllNamesDBs(AllNamesCNTR))
                End If
                stoptime = Timer
                SetProperty Result, "Time ", CStr(stoptime - starttime)
            Next
        End If
    End If
    GoTo EndSub
LocalError:
    LocalError = Error
    SetProperty Trace, NextID("trace") & "Recall Trapped Error", What & " / " & LocalError
    SetProperty VGBErrors, NextID("error") & "Recall Trapped Error", What & " / " & LocalError
'    Msg = Msg & "[" & "Trapped: " & LocalError & "] " & CrLf
    Resume Next
EndSub:
    If StartDBPTR <> DBGadgetsPTR Then
        DBSwitch StartDBPTR
    End If
'    If Msg <> "" Then
'        FloatMsgBox Msg, "VGB recall Debug Message"
'        MsgBox "pause"
'    End If
    On Error GoTo 0
    SetProperty Trace, NextID("trace") & "Recall Time", CStr(Timer - starttime)
    SetProperty Trace, NextID("trace") & "Recall End *********************************", "************************"
'    CheckTrace
    UserCancel = False
    If OSDetectAndStatus.Visible = True Then
        OSDetectAndStatus.Hide
    End If
'    AmBusy = False
    Recall = Result
    DBEngine.Idle dbRefreshCache


End Function
Friend Function ShowRecallStatus(NumToShow As Long) As Gadget
    OSDetectAndStatus.Visible = True
    OSDetectAndStatus.Caption = "Recalling "
    OSDetectAndStatus.ProgressLabel = "Number Checked"
'    OSDetectAndStatus.ProgressGauge.Min = 0
'    OSDetectAndStatus.ProgressGauge.Max = 10
'    OSDetectAndStatus.ProgressGauge.Value = 0
    OSDetectAndStatus.GageLabel.Caption = CStr(NumToShow)
    DoEvents
End Function

'Public Function RecallByID(ReadID As Long, From As String) As Gadget
'    Dim RG As Gadget
'    RG.Name = "Busy"
'    Do While RG.Name = "Busy"
'        RG = RecallByIDInternal(ReadID, From)
'        'DoEvents
'    Loop
'    RecallByID = RG
'End Function
Friend Function RecallByID(ReadID As Long, From As String) As Gadget
'    Dim BusyGadget As Gadget
'    Static AmBusy As Boolean
'    If AmBusy = True Then
'       BusyGadget.Name = "Busy"
'       RecallByIDInternal = BusyGadget
'       Exit Function
'    End If
'    AmBusy = True
    Dim starttime As Single, stoptime As Single
    starttime = Timer
    Dim t, Msg As String
    Dim TempGadget As Gadget
    Dim LParam As Gadget
    Dim ReturnedGadget  As Gadget
    Dim Where As Gadget
    Dim WherePath As String
    Dim WhereName As String
    Dim InPathAndFile As String
    Dim Result As Gadget
    Dim DB As String
    Dim UCASEFrom As String
    Dim LocalError As String
    
    On Error GoTo LocalError
    SetProperty Trace, NextID("trace") & "RecallByID Start *********************************", "************************"
    SetProperty Trace, NextID("trace") & "RecallByID", CStr(ReadID) & " / " & From
    UCASEFrom = UCase(From)
    InPathAndFile = AllTrim(Right(From, Len(UCASEFrom) - InStr(UCASEFrom, "FROM") - 4))
    Result.Name = "ERROR: Object read failed to locate the object #: " & CStr(ReadID)
    Select Case True
        Case From = ""
            ' no instructions, put in 1
            DBSwitch 1
        Case Left(UCASEFrom, 5) = "FROM " And InStr(UCASEFrom, "\") = 0
            t = DBFindIndex(InPathAndFile)
            If t < 0 Then
                ' couldn't find this database, need to bomb
                SetProperty Trace, NextID("trace") & "FXN RecallByID Find DB Error: ", CStr(ReadID) & "/" & InPathAndFile & " / " & "Find Index Failed"
                SetProperty VGBErrors, NextID("error") & "FXN RecallByID Find DB Error: ", CStr(ReadID) & "/" & InPathAndFile & " / " & "Find Index Failed"
                Result.Name = "Could not Create: " & From
                FloatMsgBox Result.Name, "RecallByID Failure"
                GoTo EndSub
            End If
            DBSwitch Val(t)
            
        Case Left(UCASEFrom, 5) = "FROM " And InStr(UCASEFrom, "\") > 0
            ' they specified a place with a path
            TempGadget = BlankObject
            SetProperty TempGadget, "PathFile", InPathAndFile ' "Where" includes path, current if not there
            Where = ExtractPathAndFile(TempGadget)
            ' variables are easier at times like this
            WherePath = AddBackSlash(UCase(ReadProperty(Where, "Path Only")))
            WhereName = UCase(ReadProperty(Where, "File Only"))
            t = DBFindIndex(WherePath & WhereName)
'            SetProperty Trace, NextID("trace") & "RecallByID Loc", CStr(ReadID) & ": " & From
            If t < 0 Then
                ' not found
                ' need to add it
                SetProperty Trace, NextID("trace") & "RecallByID Adding DB", WherePath & WhereName
'                SetProperty StatusGadget, "DB Created", WherePath & WhereName
                LParam = BlankObject
                LParam.Name = "Parameters To Database Add Method"
                LParam.Type = "Parameter"
                LParam.Container = "AddDatabase"
                Msg = From
                SetProperty LParam, "Long Name", Msg
                SetProperty LParam, "SourcePath", AddBackSlash(UCase(App.Path))
                SetProperty LParam, "SourceFile", "Empty.mem"
                SetProperty LParam, "DestPath", WherePath
                SetProperty LParam, "DestFile", WhereName
                SetProperty LParam, "Stop on error", "No"
                SetProperty LParam, "Write From", "Yes"
                SetProperty LParam, "Write From File DBGadgetPTR", CStr(0)
                SetProperty LParam, "Created by", "Virtual Cortex RecallByID"
                ReturnedGadget = AddDatabase(LParam)
                If ReadProperty(ReturnedGadget, "Status") <> OK Then
                    SetProperty Trace, NextID("trace") & "FXN RecallByID Add DB Error", CStr(ReadID) & "/" & From & " / " & ReadProperty(ReturnedGadget, "Status")
                    SetProperty VGBErrors, NextID("error") & "FXN RecallByID Add DB Error", CStr(ReadID) & "/" & From & " / " & ReadProperty(ReturnedGadget, "Status")
                    Result = ReturnedGadget
                    GoTo EndSub
                End If
            End If
            t = DBFindIndex(WherePath & WhereName)
            If t < 0 Then
                ' couldn't find this database, need to bomb
                SetProperty Trace, NextID("trace") & "FXN RecallByID Find DB Error: ", CStr(ReadID) & "/" & From & " / " & "Find Index Failed"
                SetProperty VGBErrors, NextID("error") & "FXN RecallByID Find DB Error: ", CStr(ReadID) & "/" & From & " / " & "Find Index Failed"
                Result.Name = "Could not Create: " & From
                FloatMsgBox Result.Name, "RecallByID Failure"
                GoTo EndSub
            End If
            DBSwitch Val(t)
    End Select
        
    ObjectsRS.Index = "PrimaryKey"
    ObjectsRS.Seek "=", ReadID
    If ObjectsRS.NoMatch = False Then
        ' found it
        t = ReadGadgetByID(ReadID)
        If t = OK Then
            Result = ReadObjectBuffer
        End If
    End If
    GoTo EndSub
LocalError:
    LocalError = Error
    SetProperty Trace, NextID("trace") & "RecallbyID Trapped: " & LocalError, CStr(ReadID) & " / " & From
    SetProperty VGBErrors, NextID("error") & "RecallbyID Trapped: " & LocalError, CStr(ReadID) & " / " & From
    Resume Next
EndSub:
    On Error GoTo 0
    SetProperty Trace, NextID("trace") & "RecallByID Time", CStr(Timer - starttime)
    SetProperty Trace, NextID("trace") & "RecallByID End *********************************", "************************"
    CheckTrace
'    AmBusy = False
    RecallByID = Result
End Function
'Public Function ForgetByID(IDToForget As Long, From As String) As Gadget
'    Dim RG As Gadget
'    RG.Name = "Busy"
'    Do While RG.Name = "Busy"
'        RG = ForgetByIDInternal(IDToForget, From)
'        'DoEvents
'    Loop
'    ForgetByID = RG
'End Function
Friend Function ForgetByID(IDToForget As Long, From As String) As Gadget
'    Dim BusyGadget As Gadget
'    Static AmBusy As Boolean
'    If AmBusy = True Then
'       BusyGadget.Name = "Busy"
'       ForgetByIDInternal = BusyGadget
'       Exit Function
'    End If
'    AmBusy = True

    Dim t
    Dim RREsults As Gadget
    Dim FResults As Gadget
    Dim LOCDBPTR As Integer
    Dim FromWhere As String
    Dim UCASEFrom As String
    Dim LocalError As String
    On Error GoTo LocalError
    LocalError = ""
    UCASEFrom = AllTrim(UCase(From))
    Select Case True
        Case Left(UCASEFrom, 5) = "FROM "
            FromWhere = AllTrim(Right(From, Len(UCASEFrom) - 5))
        Case Else
            FromWhere = AllTrim(From)
    End Select
    ' set the databse to the correct one, if specified
    If FromWhere <> "" Then
        LOCDBPTR = DBFindIndex(FromWhere)
        If LOCDBPTR < 0 Then
            SetProperty Trace, NextID("trace") & "ForgetByID Not trapped Error", "DB Findindex failed: " & FromWhere
            FResults.Name = From & " " & NotFound
            SetProperty FResults, "Error", From & NotFound
            GoTo EndSub
        End If
        LOCDBPTR = Val(LOCDBPTR)
        t = DBSwitch(LOCDBPTR)
        If t <> OK Then
            FResults.Name = "ForgetByID From Failed DBSwitch"
            SetProperty Trace, NextID("trace") & "ForgetByID Not trapped Error", "DB Switch failed: " & CStr(t) & "/" & FromWhere
            SetProperty VGBErrors, NextID("error") & "ForgetByID Not trapped Error", "DB Switch failed: " & CStr(t) & "/" & FromWhere
            SetProperty FResults, "DBSwitch Failed", CStr(t)
            GoTo EndSub
        End If
    End If
    t = DeleteGadget(IDToForget)
    FResults.Name = CStr(t)
    SetProperty FResults, "Delete Results", CStr(t)
    GoTo EndSub
LocalError:
    LocalError = Error
    SetProperty Trace, NextID("trace") & "ForgetByID Trapped Error", LocalError
    SetProperty VGBErrors, NextID("error") & "ForgetByID Trapped Error", LocalError
    Resume Next
EndSub:
'    AmBusy = False
    ForgetByID = FResults
End Function
'Public Function Forget(Sentence As String, From As String) As Gadget
'    Dim RG As Gadget
'    RG.Name = "Busy"
'    Do While RG.Name = "Busy"
'        RG = ForgetInternal(Sentence, From)
'        'DoEvents
'    Loop
'    Forget = RG
'End Function
Friend Function Forget(Sentence As String, From As String) As Gadget
    ' this will forget things, forgotten things are moved to a database called forgotten
'    Dim BusyGadget As Gadget
'    Static AmBusy As Boolean
'    If AmBusy = True Then
'       BusyGadget.Name = "Busy"
'       ForgetInternal = BusyGadget
'       Exit Function
'    End If
'    AmBusy = True
    Dim starttime As Single, stoptime As Single
    Dim SQLCmd  As String
    starttime = Timer
    Dim tstarttime As Single, tstoptime As Single, ttime As Single
    Dim t, Msg As String, Cntr1 As Long, CNTR2 As Long
    Dim RREsults As Gadget, DResults As Gadget
    Dim ListOfNamesToForget As Gadget, ListOfNamesToForgetCNTR As Long
    Dim TotToForget As Long
    Dim Status As Gadget
    Dim TotDone As Long, TotToDo As Long, RCancel As Boolean
    Dim LParam As Gadget
    Dim CurAppGadgets() As Gadget, CurAppGadgetsCNTR As Long, CurAppGadgetsPTR As Long
    Dim Result As Gadget
    Dim StartDBPTR As Integer, LOCDBPTR As Integer
    Dim UCASESentence As String, TSentence As String
    Dim UCASEFrom As String
    Dim FromWhere As String
    Dim AllNames() As String, AllNamesPTR As Long, AllNamesCNTR As Long
    Dim AllNamesDBs() As Integer, AllNamesDBsPTR As Long, AllNamesDBsCNTR As Long
    Dim AllNamesIDs() As Long
    Dim PropsBookmark As String
    Dim TotalNamesChecked As Long
    Dim ThisID As Long
    Dim IncludeNameInList As Boolean
    Dim AccumulatedGadgets() As Gadget, AccumulatedGadgetsPTR As Long, AccumulatedGadgetsCNTR As Long
    Dim ObjectName As String
    Dim AllProps() As String, AllPropsPTR As Long, AllpropsCNTR As Long
    Dim Props() As String, PropsPTR As Long, PropsCNTR As Long
    Dim PropValues() As String
    Dim CurrentProp As String, CurrentPropValue As String
    Dim LocalError As String
    On Error GoTo LocalError
    SetProperty Trace, NextID("trace") & "Forget Start *********************************", "************************"
    SetProperty Trace, NextID("trace") & "Forgetting", Sentence
    StartDBPTR = DBGadgetsPTR
    Sentence = AllTrim(Sentence)
    UCASESentence = UCase(Sentence)
    From = AllTrim(From)
    UCASEFrom = UCase(From)
    Status.Name = Sentence
    
'    SetProperty Status, "Forgeting", Sentence
    Select Case True
        Case Left(UCASEFrom, 5) = "FROM "
            FromWhere = AllTrim(Right(From, Len(UCASEFrom) - 5))
        Case Else
            FromWhere = AllTrim(From)
    End Select
    
    If InStr(UCASESentence, " WITH: ") > 0 Then
        ' this one has properties
        TSentence = AllTrim(Right(Sentence, Len(UCASESentence) - InStr(UCASESentence, " WITH:") - 5))
        AllProps = Split(TSentence, ",")
        AllpropsCNTR = UBound(AllProps)
        For AllPropsPTR = 0 To AllpropsCNTR
            If InStr(AllProps(AllPropsPTR), "=") > 0 Then
                PropsCNTR = PropsCNTR + 1
                ReDim Preserve Props(PropsCNTR)
                ReDim Preserve PropValues(PropsCNTR)
                Props(PropsCNTR) = AllTrim(Left(AllProps(AllPropsPTR), InStr(AllProps(AllPropsPTR), "=") - 1))
                PropValues(PropsCNTR) = AllTrim(Right(AllProps(AllPropsPTR), Len(AllProps(AllPropsPTR)) - InStr(AllProps(AllPropsPTR), "=")))
                Msg = Msg & "[" & PropsCNTR & ": " & Props(PropsCNTR) & "=" & PropValues(PropsCNTR) & "] " & CrLf
            Else
                ' no property value, just property name
                PropsCNTR = PropsCNTR + 1
                ReDim Preserve Props(PropsCNTR)
                ReDim Preserve PropValues(PropsCNTR)
                Props(PropsCNTR) = AllTrim(AllProps(AllPropsPTR))
                PropValues(PropsCNTR) = ""
                Msg = Msg & "[" & PropsCNTR & ": " & Props(PropsCNTR) & "=" & PropValues(PropsCNTR) & "] " & CrLf
            End If
        Next
    End If
'    FloatMsgBox Msg, "Forget"
    If FromWhere <> "" Then
        Select Case True
            Case UCASEFrom = "BRAIN" Or _
                 UCASEFrom = "FROM BRAIN" Or _
                 UCASEFrom = "FROM: BRAIN" Or _
                 UCASEFrom = "FROM LONG TERM MEMORY"
            Case Else
                LOCDBPTR = DBFindIndex(FromWhere)
                If LOCDBPTR < 0 Then
                    SetProperty Trace, NextID("trace") & "ForgetByID Not trapped Error", "DB Findindex failed: " & FromWhere
                    Result.Name = From & " " & NotFound
                    SetProperty Result, "Error", From & " " & NotFound
                    GoTo EndSub
                End If
                LOCDBPTR = Val(LOCDBPTR)
                t = DBSwitch(LOCDBPTR)
                If t <> OK Then
                    Result.Name = "Forget From Failed DBSwitch"
                    SetProperty Trace, NextID("trace") & "Forget Not trapped Error", "DB Switch failed: " & CStr(t) & "/" & FromWhere
                    SetProperty VGBErrors, NextID("error") & "Forget Not trapped Error", "DB Switch failed: " & CStr(t) & "/" & FromWhere
                    SetProperty Result, "DBSwitch Failed", CStr(t)
                    GoTo EndSub
                End If
        End Select
    End If
    Select Case True
        Case UCASESentence = "ALL OBJECTS"
            ' whoa, deleting all
            SQLCmd = "DELETE Objects.* FROM Objects " '  where (((Props.Property)='group') AND ((Props.ValueAlpha)='user defined')) ORDER BY Objects.Name;"
            OpenDB(OpenDBPTR).Execute SQLCmd
            If LocalError <> "" Then
                Result.Name = LocalError
            Else
                Result.Name = "OK"
            End If
        Case UCASEFrom = "BRAIN" Or _
            UCASEFrom = "FROM BRAIN" Or _
            UCASEFrom = "FROM: BRAIN" Or _
            InStr(UCASEFrom, "MEMORIES") > 0 Or _
            InStr(UCASEFrom, "LONG TERM MEMORY") > 0
                 
            ' this is a removal of a memories pool
            ' this case the first parameter has the db designation
            ' save the appgadgets for reinit after delete
            For CurAppGadgetsPTR = 1 To AppGadgetsCNTR
                CurAppGadgetsCNTR = CurAppGadgetsPTR
                ReDim Preserve CurAppGadgets(CurAppGadgetsPTR)
                CurAppGadgets(CurAppGadgetsPTR) = AppGadgets(CurAppGadgetsPTR)
            Next
            ' get a list of all gadgets to delete
            ListOfNamesToForget = Recall("names with: DB name=" & Sentence, "From " & VGBDatabaseName)
            ListOfNamesToForgetCNTR = Val(ListOfNamesToForget.Name)
            If ListOfNamesToForgetCNTR = 0 Then
                Result.Name = "Forget From Brain Failed"
                SetProperty Trace, NextID("trace") & "Forget Not trapped Error", "No System files found" & CStr(t) & "/" & Sentence
                SetProperty VGBErrors, NextID("error") & "Forget Not trapped Error", "No System files found" & CStr(t) & "/" & Sentence
                SetProperty Result, "DB Delete Failed", "No Database Found"
                GoTo EndSub
            End If
            ' delete all the gadgets as needed
            For Cntr1 = 1 To ListOfNamesToForgetCNTR
                Msg = ReadProperty(ListOfNamesToForget, "Name " & CStr(Cntr1))
                If Msg = NotFound Then
                    Exit For
                End If
                RREsults = Recall(Msg, "from " & VGBDatabaseName)
                SetProperty Result, "Deleting " & CStr(Cntr1), Msg
                SetProperty Result, "Deleting ID" & CStr(Cntr1), CStr(RREsults.ObjectID)
                If InStr(UCase(Msg), VGBDatabaseName) Then
                    Result.Name = "System File Deleted"
                    SetProperty Result, "System File", "Deleted"
                Else
                    DResults = ForgetByID(RREsults.ObjectID, "from " & VGBDatabaseName)
                    SetProperty Result, "Delete Results " & CStr(Cntr1), CStr(DResults.Name)
                End If
            Next
            If Result.Name = "System File Deleted" Then
                ' they disable me, gotta go
                DResults = ForgetByID(RREsults.ObjectID, "from " & VGBDatabaseName)
                For Cntr1 = 0 To OpenDBPTR
                    OpenDB(Cntr1).Close
                Next
                GoTo Abort
            End If
            ' now we need to start ourselves again
            DebugVGB "clear trace"
            LParam.Name = "Reset"
            RREsults = InitVGB(LParam)
            For CurAppGadgetsPTR = 1 To CurAppGadgetsCNTR
                RREsults = WakeUp(CurAppGadgets(CurAppGadgetsPTR))
                SetProperty Trace, NextID("trace") & CurAppGadgets(CurAppGadgetsPTR).Name, "Restarted by forget"
                SetProperty Result, CurAppGadgets(CurAppGadgetsPTR).Name, "Restarted"
            Next CurAppGadgetsPTR
            Result.Name = Sentence & " memories pool forgotten"
            SetProperty Result, "Total Time", CStr(Timer - starttime)
            GoTo EndSub
                
        Case Left(UCASESentence, 4) = "ALL " And InStr(UCASESentence, " WITH: ") > 0
            ObjectsRS.Index = "PrimaryKey"
            PropsRS.Index = "ValueAlpha"
            PropsRS.Seek "=", PropValues(1)
            Do While PropsRS.NoMatch = False
                If UCase(PropsRS!Property) = UCase(Props(1)) Then
                    ObjectsRS.Seek "=", PropsRS!ObjectID
                    AllNamesCNTR = AllNamesCNTR + 1
                    ReDim Preserve AllNames(AllNamesCNTR)
                    ReDim Preserve AllNamesDBs(AllNamesCNTR)
                    ReDim Preserve AllNamesIDs(AllNamesCNTR)
                    AllNames(AllNamesCNTR) = ObjectsRS!Name
                    AllNamesDBs(AllNamesCNTR) = LOCDBPTR
                    AllNamesIDs(AllNamesCNTR) = PropsRS!ObjectID
                    Result.TotalProperties = Result.TotalProperties + 1
                    ReDim Preserve Result.Propity(Result.TotalProperties)
                    ReDim Preserve Result.ValueAlpha(Result.TotalProperties)
                    Result.Propity(Result.TotalProperties) = "Name " & CStr(AllNamesCNTR)
                    Result.ValueAlpha(Result.TotalProperties) = ObjectsRS!Name
                    If Result.TotalProperties Mod 50 = 0 Then
                        'FloatMsgBox "Total Done: " & CStr(Result.TotalProperties), "Forget Status"
'                       SetProperty Status, "Done", CStr(Result.TotalProperties)
                        TotDone = Result.TotalProperties
                        TotToDo = 0
'                       RaiseEvent RecallStatus(TotDone, TotToDo, RCancel)
                        If RCancel = True Then
                            Result.Name = Sentence & " Cancelled"
                            GoTo EndSub
                        End If
'                       DoEvents
                    End If
                End If
                PropsRS.MoveNext
                If PropsRS.EOF Then
                    Exit Do
                End If
                If PropsRS!ValueAlpha <> PropValues(1) Then
                    Exit Do
                End If
                
            Loop
        Case Else
            RREsults = Recall(Sentence, From)
            If UCase(RREsults.Name) <> UCase(Sentence) Then
                Result.Name = "Error Forgetting " & Sentence & " " & From
                SetProperty Result, "Error", "Forget didn't find Object"
                GoTo EndSub
            End If
                
            Result = ForgetByID(RREsults.ObjectID, From)
    End Select
    
    GoTo EndSub
LocalError:
    LocalError = Error
    SetProperty Trace, NextID("trace") & "Forget Trapped: " & LocalError, Sentence & " / " & From
    SetProperty VGBErrors, NextID("error") & "Forget Trapped: " & LocalError, Sentence & " / " & From
    Resume Next
EndSub:
    If StartDBPTR <> DBGadgetsPTR Then
        DBSwitch StartDBPTR
    End If
    SetProperty Trace, NextID("trace") & "Forget Time", CStr(Timer - starttime)
    SetProperty Trace, NextID("trace") & "Forget End *********************************", "************************"
    
    On Error GoTo 0
'    AmBusy = False
    DBEngine.Idle dbRefreshCache
Abort:
    Forget = Result
End Function

Friend Function StrTimer() As String
    StrTimer = " [" & CStr(Timer) & "] "
End Function
Friend Function NextID(V As String) As String
    Static LastErrorID As String, LastTraceID As String
    Dim NextIDString As String
    V = UCase(V)
    Select Case True
        Case TraceOn = False And (LastTraceID <> "")
            NextIDString = LastTraceID
        Case (V = "ERROR") Or ((V = "LAST ERROR") And (LastErrorID = ""))
            VGBErrorsCNTR = VGBErrorsCNTR + 1
            NextIDString = "[" & CStr(Timer) & "] " & "(" & CStr(VGBErrorsCNTR) & ") "
            LastErrorID = NextIDString
        Case V = "LAST ERROR"
            NextIDString = LastErrorID
        
        Case V = "TRACE" Or ((V = "LAST TRACE") And (LastTraceID = ""))
            TraceCNTR = TraceCNTR + 1
            NextIDString = "[" & CStr(Timer) & "] " & "(" & CStr(TraceCNTR) & ") "
            LastTraceID = NextIDString
        Case V = "LAST TRACE"
            NextIDString = LastTraceID
    End Select
    NextID = NextIDString
End Function
Friend Function ProcessTask(Task As Gadget, Param As Gadget) As Gadget
    ' this is the interface to the gadgetor module
    ' all calls to tasks go thru this portal
    Dim starttime As Single, stoptime As Single
    starttime = Timer
    Dim Cntr1 As Long, TotTasks As Long
    Dim ResultsGadget As Gadget
    SetProperty ResultsGadget, "Status", "Task Processor Start"
    SetProperty ResultsGadget, "Error", "Task Not Found"
    Select Case True
        Case UCase(Task.Name) = UCase("")
            ' this is a template
            
        Case UCase(Task.Name) = UCase("Wake Up")            ' start up
            ' mark instance only
            InstancesCNTR = InstancesCNTR + 1
            
        Case UCase(Task.Name) = UCase("STOP!")              ' STOP
            ' must stop NOW, questionable if works
            StopWhateverYourDoing = True
            
        Case UCase(Task.Name) = UCase("Send Status")        ' Send Status
            ' must stop NOW
            ResultsGadget = StatusGadget
            
        Case UCase(Task.Name) = UCase("Remember")           ' remember
            ' must remember
            ResultsGadget = Remember(Task, Param)
        
        Case UCase(Task.Name) = UCase("Describe")           ' describe
            ' must describe
            ResultsGadget = Describe(Task, Param)
        
'        Case UCase(Task.Name) = UCase("Rename")             ' rename
'            ' must rename
'            ResultsGadget = Rename(Task, Param)
            
        Case UCase(Task.Name) = UCase("Forget")             ' forget
            ' must forget
            'ResultsGadget = Forget(Task, Param)
            
        Case UCase(Task.Name) = UCase("Delete")             ' delete
            ' must forget
            ResultsGadget = Delete(Task, Param)
            
        Case UCase(Task.Name) = UCase("Group")              ' group
            ' must group
            ResultsGadget = Group(Task, Param)
            
        Case UCase(Task.Name) = UCase("Cut")                ' cut
            ' must cut
            ResultsGadget = Cut(Task, Param)
            
        Case UCase(Task.Name) = UCase("Copy")               ' copy
            ' must copy
            ResultsGadget = Copy(Task, Param)
            
        Case UCase(Task.Name) = UCase("Paste")              ' paste
            ' must paste
            ResultsGadget = Cut(Task, Param)
            
        Case UCase(Task.Name) = UCase("ReadGadget")         ' readgadget
            '
            ResultsGadget = ReadGadget(Param)
            
        Case UCase(Task.Name) = UCase("AddDatabase")        ' adddatabase
            '
            ResultsGadget = AddDatabase(Param)
        Case UCase(Task.Name) = UCase("dbswitch")
            ' low level stuff
            DBSwitch Val(ReadProperty(Task, "Switch to"))   ' switch database
            
        Case UCase(Task.Name) = UCase("Show Status")
            ' show the status screen
            VGBStatusScreen.Show
            
        Case UCase(Task.Name) = UCase("")
            '
            
        Case UCase(Task.Name) = UCase("")
            '
            
        Case UCase(Task.Name) = UCase("")
            '
            
        
    End Select
'    ResultsGadget = Task
'    ResultsGadget.Name = "Processor Results"
'    SetProperty ResultsGadget, "Status", "Test"
'    SetProperty ResultsGadget, "Result", "Returning Task only"
    If ResultsGadget.Status = "" Then
        ResultsGadget.Status = CStr(Timer - starttime) & " : Process Time"
    End If
    On Error GoTo 0
    ProcessTask = ResultsGadget
End Function

Friend Function Remember(Task As Gadget, Param As Gadget) As Gadget
    ' this will parse the remember command, build a rememberer task
    ' and pass it to the rememberer which remembers something
    Dim starttime As Single, stoptime As Single
    starttime = Timer
    Dim t, Msg As String, Msg2 As String, Cntr1 As Long, CNTR2 As Long
    Dim ResultsGadget As Gadget
'    Dim StatusGadget As Gadget
    Dim LTask As Gadget, LParam As Gadget
    Dim TGadget As Gadget
    Dim Criteria As String
    Dim SplitCriteria() As String
    Dim TotalParts As Long
    Dim Prop As String, PropValue As String
    Dim Props() As String, PropValues() As String
    Dim PropsCNTR As Long, PropsPTR As Long
    Dim TotalGadgetsFound As Long
    Dim AutoCreate As Boolean
    Dim DoAll As Boolean
    Dim WhatToRemember As String
    Dim Command As String
    Dim LongTermMemoryDBPTR As Integer
    Dim StartDBPTR As Integer
    Dim Aliases(5) As String, AliasesPTR As Long, AliasesCNTR As Long
    Dim LocalError As String, ErrorCNTR As Long
    On Error GoTo LocalError

    StartDBPTR = DBGadgetsPTR
    LongTermMemoryDBPTR = DBFindIndex(VGBDatabaseName)
    ResultsGadget = Task
    ResultsGadget.Name = "Remember Started"
    If LongTermMemoryDBPTR < 0 Then
        ' no long term memory
        ' can't be so
        SetProperty ResultsGadget, "Error", "No Database Found"
        FloatMsgBox "No Long Term Memory File!", "Severe Error"
        SetProperty ResultsGadget, "Error", "No Database Found"
        GoTo EndSub
    End If
    ' these are the accepted names of the command string we use
    Aliases(1) = UCase("Command")
    Aliases(2) = UCase("Remember")
    Aliases(3) = UCase("Remember Wut")
    Aliases(4) = UCase("Criteria")
    Aliases(5) = UCase("User")
    AliasesCNTR = UBound(Aliases)
    DBSwitch LongTermMemoryDBPTR
    For Cntr1 = 1 To AliasesCNTR
        Criteria = ReadProperty(Task, Aliases(Cntr1))
        If Criteria <> NotFound Then
            Exit For
        End If
    Next
    SetProperty ResultsGadget, "Criteria", Criteria
    If Criteria = NotFound Then
        SetProperty ResultsGadget, "Error", "No Command String to Process"
        GoTo EndSub
    End If
    ' let's doctor up the passed Criteria before splitting
    Criteria = AllTrim(Criteria)
    If Right(Criteria, 1) = "," Then
        Criteria = Left(Criteria, Len(Criteria) - 1)
    End If
    If Right(Criteria, 2) = CrLf Then
        Criteria = Left(Criteria, Len(Criteria) - 2)
    End If
    If Right(Criteria, 1) = Cr Then
        Criteria = Left(Criteria, Len(Criteria) - 1)
    End If
    If Right(Criteria, 1) = Lf Then
        Criteria = Left(Criteria, Len(Criteria) - 1)
    End If
    SplitCriteria = Split(Criteria, ",")
    TotalParts = UBound(SplitCriteria)
    ReDim Preserve SplitCriteria(TotalParts + 1)
    ' fix zero based array bs and remove commas
    For Cntr1 = TotalParts + 1 To 1 Step -1
        If AllTrim(SplitCriteria(Cntr1)) <> "," Then
            SplitCriteria(Cntr1) = AllTrim(SplitCriteria(Cntr1 - 1))
        End If
    Next
    TotalParts = UBound(SplitCriteria)
    AutoCreate = False
    AutoCreate = (ReadProperty(Task, "AutoCreate") = "True") Or (ReadProperty(Task, "AutoCreate") = NotFound)
    SetProperty StatusGadget, "AutoCreate Flag", CStr(AutoCreate)
'    DoAll = InStr(UCase(SplitCriteria(2)), "ALL ") > 0 And _
            (InStr(UCase(SplitCriteria(2)), " WITH ") > 0 Or _
             InStr(UCase(SplitCriteria(2)), " TYPE") > 0 Or _
             InStr(UCase(SplitCriteria(2)), " ALL GADGETS OF TYPE") > 0 Or _
             InStr(UCase(SplitCriteria(2)), " GADGET") > 0)


'    SetProperty ResultsGadget, "DoAll", CStr(DoAll)

    ' set status gadget up (client can read status to see what last happened)
    SetProperty ResultsGadget, "Total Parts", CStr(TotalParts)
    For Cntr1 = 1 To TotalParts
       SetProperty ResultsGadget, "Part " & CStr(Cntr1), SplitCriteria(Cntr1)
    Next
    StatusGadget = ResultsGadget
    Command = UCase(SplitCriteria(2))
    Select Case True
        Case InStr(Command, UCase("All Gadgets With Properties")) > 0
            ' remember, All Gadgets With Properties, prop1=value1,prop2=value2 ...etc
            SetProperty StatusGadget, "Case", "InStr(UCase(SplitCriteria(2)), ""All Gadgets With Properties"") > 0"
        Case InStr(Command, UCase("All Gadgets With Property X")) > 0
        Case InStr(Command, UCase("All Gadget Names")) > 0 Or (Command = UCase("All Gadgets")) Or (Command = UCase("All Names"))
            ' send gadget with all gadget names as properties
            SetProperty StatusGadget, "Case", "InStr(UCase(SplitCriteria(2)), ""All Gadget Names"") > 0"
            LocalError = ""
            ObjectsRS.Index = "Name"
            ObjectsRS.MoveFirst
            If LocalError <> "" Then
                SetProperty ResultsGadget, "Error", LocalError
                GoTo EndSub
            End If
            ResultsGadget = BlankObject
            ResultsGadget.Name = SplitCriteria(2)
            Cntr1 = 0
            Do While ObjectsRS.EOF = False
                Cntr1 = Cntr1 + 1
                SetProperty ResultsGadget, ObjectsRS!Name, CStr(Cntr1)
                ObjectsRS.MoveNext
                If LocalError <> "" Then
                    Exit Do
                End If
            Loop
        Case TotalParts > 2 And (InStr(SplitCriteria(2), "=") = 0) And _
            (InStr(SplitCriteria(3), "=") > 0)
            ' memorize all properties for this gadget
            ' remember, My Gadget, prop1=prop value1, prop2=prop value2... etc
            
            LTask.Name = SplitCriteria(2)
            LTask.ObjectID = "0"
            SetProperty LTask, "ReadBy", "Name"
            TGadget = ReadGadget(LTask)
            Select Case True
                Case TGadget.Name = NotFound
                    ' need to create this gadget
                    TGadget = BlankObject
                    TGadget.Name = SplitCriteria(2)
                    TGadget.ObjectID = 0
                Case Else
                    ' return the property
                    'SetProperty TGadget, SplitCriteria(3), SplitCriteria(4)
            End Select
            ' now, set all properties to the described values
            ' a property is like this prop name=prop value
            ' key in on equal
            For Cntr1 = 3 To TotalParts
                If InStr(SplitCriteria(Cntr1), "=") > 0 Then
                    Prop = Left(SplitCriteria(Cntr1), InStr(SplitCriteria(Cntr1), "=") - 1)
                    Prop = AllTrim(Prop)
                    PropValue = Right(SplitCriteria(Cntr1), Len(SplitCriteria(Cntr1)) - InStr(SplitCriteria(Cntr1), "="))
                    PropValue = AllTrim(PropValue)
                    Select Case True
                        Case UCase(Prop) = "TYPE"
                            TGadget.Type = PropValue
                        Case UCase(Prop) = "CONTAINER"
                            TGadget.Container = PropValue
                        Case Else
                    End Select
                    SetProperty TGadget, Prop, PropValue
                End If
            Next Cntr1
            WriteMemGadget TGadget.ObjectID, TGadget
            ResultsGadget = TGadget
            
            
        Case TotalParts >= 2 And (InStr(SplitCriteria(2), "=") > 0) Or _
             (InStr(Command, "All Gadgets With") > 0)
            ' remember the names of all gadgets with given properties
            '   remember, color,length=12,length units=inches
            ' or
            '   remember, All Gadgets With, color=red,length=12,length units=inches
            ' or, just with the property itself
            '   remember, All Gadgets With, color,length
            ' or, a combination of above
            '   remember, All Gadgets With, color=red,length
            ' remember, color=red,length=12,length units=inches
            ResultsGadget = BlankObject
            ResultsGadget.Name = "Results of " & Criteria
            SetProperty StatusGadget, "Case", "InStr(UCase(SplitCriteria(2)), ""ALL"") > 0"
            SetProperty StatusGadget, "Command", SplitCriteria(2)
'                    ShowGadget StatusGadget
            CNTR2 = 0
            For Cntr1 = 3 To TotalParts
                SetProperty StatusGadget, "Part: " & CStr(Cntr1), SplitCriteria(Cntr1)
                If InStr(SplitCriteria(Cntr1), "=") Then
                    'StatusGadget = BlankObject
                    StatusGadget.Name = "Started Parsing"
                    PropsCNTR = PropsCNTR + 1
                    ReDim Preserve Props(PropsCNTR)
                    ReDim Preserve PropValues(PropsCNTR)
                    Props(PropsCNTR) = Left(SplitCriteria(Cntr1), InStr(SplitCriteria(Cntr1), "=") - 1)
                    Props(PropsCNTR) = AllTrim(Props(PropsCNTR))
                    PropValues(PropsCNTR) = Right(SplitCriteria(Cntr1), Len(SplitCriteria(Cntr1)) - InStr(SplitCriteria(Cntr1), "="))
                    PropValues(PropsCNTR) = AllTrim(PropValues(PropsCNTR))
                    SetProperty StatusGadget, "Property: " & CStr(PropsCNTR) & " = " & Props(PropsCNTR), PropValues(PropsCNTR)
'                    ShowGadget StatusGadget
                End If
            Next Cntr1
            ' here we have all the properties and values in arrays, need to build a list
            ' of all gadget names wiht these things
            
        Case TotalParts = 2
            ' simple remember object statement
            ' remember, object name
            ' second part is the object to remember
            ' simple read from disk by name
            SetProperty StatusGadget, "Case", "TotalParts=2"
            LTask.Name = Command
            LTask.ObjectID = "0"
            SetProperty LTask, "ReadBy", "Name"
            TGadget = ReadGadget(LTask)
            Select Case True
                Case (TGadget.Name = NotFound) And (AutoCreate = False)
                    ' not found and autocreate is a not
                    SetProperty StatusGadget, "Status", Command & " " & NotFound
                    
                Case (TGadget.Name = NotFound) And (AutoCreate = True)
                    ' need to create it
                    SetProperty StatusGadget, "Status", "TGadget.Name = NotFound And (AutoCreate = True)"
                    TGadget = BlankObject
                    TGadget.ObjectID = 0
                    TGadget.Name = SplitCriteria(2)
                    WriteMemGadget TGadget.ObjectID, TGadget
                    ResultsGadget = TGadget
               Case TGadget.Name <> NotFound
                    ' found this gadget
                    SetProperty StatusGadget, "Status", "TGadget.Name <> NotFound"
                    ResultsGadget = TGadget
                    SetProperty StatusGadget, "Found", TGadget.Name
            End Select
        Case TotalParts > 2 And (InStr(SplitCriteria(3), "=") = 0)
            SetProperty StatusGadget, "Case", "TotalParts > 2 And (InStr(SplitCriteria(3), ""="") = 0)"
            ' asking for property(s) of a gadget
            ' must handle:
            ' remember, gadget, prop1, prop2 ...etc
            ' which properties do they want?
            LTask.Name = Command
            LTask.ObjectID = "0"
            SetProperty LTask, "ReadBy", "Name"
            TGadget = ReadGadget(LTask)
            Select Case True
                Case TGadget.Name = NotFound
                    SetProperty StatusGadget, "Status", "TGadget.Name = NotFound"
                    ResultsGadget = TGadget
                    SetProperty ResultsGadget, "Error", Command & " " & NotFound
                    SetProperty ResultsGadget, "Looking For", Command
                    SetProperty ResultsGadget, "Command", Criteria
                Case Else
                    ' return the property
                    SetProperty StatusGadget, "Status", "TGadget.Name <> NotFound"
                    ResultsGadget = BlankObject
                    ResultsGadget.Name = Criteria
                    For Cntr1 = 3 To TotalParts
                        SetProperty ResultsGadget, SplitCriteria(Cntr1), ReadProperty(TGadget, SplitCriteria(Cntr1))
                        SetProperty StatusGadget, SplitCriteria(Cntr1), ReadProperty(TGadget, SplitCriteria(Cntr1))
                    Next Cntr1
            End Select
            
        
        Case InStr(Command, UCase("")) > 0
        
    End Select
    GoTo EndSub
    
    
    
'///////////////////////////////////////////////////////////////////////////////////////////////////
'OLD STUFF
    Select Case True
        Case DoAll
            Select Case True
                Case (InStr(UCase(SplitCriteria(2)), "ALL GADGETS OF TYPE") > 0)
                    ' all gadgets of given type
                    LocalError = ""
                    ObjectsRS.Index = "Type"
                    ObjectsRS.Seek "=", SplitCriteria(3)
                    If LocalError <> "" Then
                        SetProperty ResultsGadget, "Error", LocalError
                        GoTo EndSub
                    End If
                    If ObjectsRS.NoMatch = True Then
                        SetProperty ResultsGadget, "Error", SplitCriteria(3) & " " & NotFound
                        GoTo EndSub
                    End If
                    ResultsGadget = BlankObject
                    ResultsGadget.Name = SplitCriteria(2)
                    Cntr1 = 0
                    Do While ObjectsRS.NoMatch = False
                        Cntr1 = Cntr1 + 1
                        SetProperty ResultsGadget, ObjectsRS!Name, CStr(Cntr1)
                        ObjectsRS.MoveNext
                        If LocalError <> "" Then
                            SetProperty StatusGadget, Criteria & " Failed", LocalError
                            Exit Do
                        End If
                        If ObjectsRS.EOF Then
                            SetProperty StatusGadget, Criteria & " Exited", "EOF"
                            Exit Do
                        End If
                        If UCase(ObjectsRS!Type) <> UCase(SplitCriteria(3)) Then
                            SetProperty StatusGadget, Criteria & " Exited", UCase(ObjectsRS!Type) & "<>" & (SplitCriteria(3))
                            Exit Do
                        End If
                    Loop

                    
                Case (InStr(UCase(SplitCriteria(2)), "GADGET") > 0) And (TotalParts = 2)
                    ' all gadget names
                    LocalError = ""
                    ObjectsRS.Index = "Name"
                    ObjectsRS.MoveFirst
                    If LocalError <> "" Then
                        SetProperty ResultsGadget, "Error", LocalError
                        GoTo EndSub
                    End If
                    ResultsGadget = BlankObject
                    ResultsGadget.Name = SplitCriteria(2)
                    Cntr1 = 0
                    Do While ObjectsRS.EOF = False
                        Cntr1 = Cntr1 + 1
                        SetProperty ResultsGadget, ObjectsRS!Name, CStr(Cntr1)
                        ObjectsRS.MoveNext
                        If LocalError <> "" Then
                            Exit Do
                        End If
                    Loop
                Case (InStr(UCase(SplitCriteria(2)), "GADGET") > 0) And (TotalParts > 2)
                    ' need to get all the properties coralled
                    ResultsGadget = BlankObject
                    ResultsGadget.Name = "Results of " & Criteria
                    SetProperty StatusGadget, "Case", "InStr(UCase(SplitCriteria(2)), ""ALL"") > 0"
                    SetProperty StatusGadget, "Do All Command", SplitCriteria(2)
'                    ShowGadget StatusGadget
                    CNTR2 = 0
                    For Cntr1 = 3 To TotalParts
                        SetProperty StatusGadget, "Part: " & CStr(Cntr1), SplitCriteria(Cntr1)
                        ShowGadget StatusGadget
                        If InStr(SplitCriteria(Cntr1), "=") Then
                            'StatusGadget = BlankObject
                            StatusGadget.Name = "Started Parsing"
                            PropsCNTR = PropsCNTR + 1
                            ReDim Preserve Props(PropsCNTR)
                            ReDim Preserve PropValues(PropsCNTR)
                            Props(PropsCNTR) = Left(SplitCriteria(Cntr1), InStr(SplitCriteria(Cntr1), "=") - 1)
                            Props(PropsCNTR) = AllTrim(Props(PropsCNTR))
                            PropValues(PropsCNTR) = Right(SplitCriteria(Cntr1), Len(SplitCriteria(Cntr1)) - InStr(SplitCriteria(Cntr1), "="))
                            PropValues(PropsCNTR) = AllTrim(PropValues(PropsCNTR))
                            SetProperty StatusGadget, "Property: " & CStr(PropsCNTR) & " = " & Props(PropsCNTR), PropValues(PropsCNTR)
                            ShowGadget StatusGadget
                        End If
                    Next Cntr1
'                    ShowGadget StatusGadget
                    PropsRS.Index = "Property"
                    Cntr1 = 0
                    For PropsPTR = 1 To PropsCNTR
                        PropsRS.Seek "=", Props(PropsPTR)
                        SetProperty StatusGadget, "BM After Seek", PropsRS.Bookmark
                        Do While PropsRS.NoMatch = False
                            SetProperty StatusGadget, "Seek Found", PropsRS!Property & ":" & PropsRS!ValueAlpha
                            ShowGadget StatusGadget
                            If UCase(PropsRS!ValueAlpha) = UCase(PropValues(PropsPTR)) Then
                                SetProperty StatusGadget, "Reading: " & Props(PropsPTR), PropValues(PropsPTR)
                                SetProperty StatusGadget, "Props ObjectID before Read", CStr(PropsRS!ObjectID)
                                SetProperty StatusGadget, "Props Name before Read", PropsRS!Property
                                SetProperty StatusGadget, "-", "-"
                                TGadget = BlankObject
                                TGadget = ReadDiskGadgetByID(PropsRS!ObjectID)
                                SetProperty StatusGadget, "Props ObjectID After Read", CStr(PropsRS!ObjectID)
                                SetProperty StatusGadget, "Props Name after Read", PropsRS!Property
                                SetProperty StatusGadget, "Found Gadget ID ", CStr(TGadget.ObjectID)
                                SetProperty StatusGadget, "Found Gadget Name", TGadget.Name
                                ShowGadget StatusGadget
                                If TGadget.Name <> NotFound Then
                                    SetProperty StatusGadget, "Seek: " & Props(PropsPTR), "Found"
                                    SetProperty StatusGadget, "Name", TGadget.Name
                                    ShowGadget StatusGadget
                                    For Cntr1 = 1 To ResultsGadget.TotalProperties
                                        If ResultsGadget.ValueAlpha(Cntr1) = TGadget.Name Then
                                            Exit For
                                        End If
                                    Next
                                    If Cntr1 > ResultsGadget.TotalProperties Then
                                        SetProperty StatusGadget, "Gadget Added", TGadget.Name
                                        ShowGadget StatusGadget
                                        TotalGadgetsFound = TotalGadgetsFound + 1
                                        SetProperty ResultsGadget, Format(CStr(TotalGadgetsFound), "#####") & ") ", TGadget.Name
                                    End If
                                End If
                            End If
                            SetProperty StatusGadget, "BM Before MoveNext", PropsRS.Bookmark
                            SetProperty StatusGadget, "Property Before MoveNext", PropsRS!Property & " : " & PropsRS!ValueAlpha
                            PropsRS.MoveNext
                            SetProperty StatusGadget, "BM After MoveNext", PropsRS.Bookmark
                            SetProperty StatusGadget, "Property After MoveNext", PropsRS!Property & " : " & PropsRS!ValueAlpha
                            CNTR2 = CNTR2 + 1
                            SetProperty StatusGadget, "MoveNext Counter", CStr(CNTR2)
                            If PropsRS.EOF Then
                                SetProperty StatusGadget, "Exit Reason", "EOF"
                                Exit Do
                            End If
                            If UCase(PropsRS!Property) <> UCase(Props(PropsPTR)) Then
                                SetProperty StatusGadget, "Exit Reason", UCase(PropsRS!Property) & "<>" & UCase(Props(PropsPTR))
                                Exit Do
                            End If
                        Loop
                    Next PropsPTR
'                    Select Case True
'                        Case UCase(Props(PropsPTR)) = "TYPE"
'                            TGadget.Type = PropValue
'                        Case UCase(Props(PropsPTR)) = "CONTAINER"
'                            TGadget.Container = PropValue
'                        Case Else
'                    End Select
                    
            End Select
            
            'ResultsGadget = TGadget
        Case TotalParts = 1
            ' 1 word command
            SetProperty StatusGadget, "Case", "TotalParts = 1"
            Select Case True
                Case InStr(UCase(Criteria), "TYPE") > 0
                    Cntr1 = 0
                    ObjectsRS.Index = "Type"
                    ObjectsRS.MoveFirst
                    Do While ObjectsRS.NoMatch = False
                        Cntr1 = Cntr1 + 1
                        SetProperty ResultsGadget, Format(CStr(Cntr1), "#####") & ") ", ObjectsRS!Type
                        Msg = ObjectsRS!Type
                        Do While Msg = ObjectsRS!Type
                            ObjectsRS.MoveNext
                            If ObjectsRS.EOF Then
                                GoTo EndSub
                            End If
                        Loop
                        If ObjectsRS.EOF Then
                            Exit Do
                        End If
                    Loop
                    
            End Select
        Case TotalParts = 2 And (InStr(UCase(SplitCriteria(2)), "TYPE") > 0) Or (InStr(UCase(SplitCriteria(2)), "ALL TYPE") > 0)
            ' send types
            SetProperty StatusGadget, "Case", "TotalParts = 2 And InStr(UCase(SplitCriteria(2)), ""TYPE"") > 0"
            Cntr1 = 0
            ObjectsRS.Index = "Type"
            ObjectsRS.MoveFirst
            ResultsGadget = BlankObject
            ResultsGadget.Name = "All Types"
            Do While ObjectsRS.NoMatch = False
                Cntr1 = Cntr1 + 1
                SetProperty ResultsGadget, ObjectsRS!Type, CStr(Cntr1)
                Msg = ObjectsRS!Type
                Do While Msg = ObjectsRS!Type
                    ObjectsRS.MoveNext
                    If ObjectsRS.EOF Then
                        GoTo EndSub
                    End If
                Loop
                If ObjectsRS.EOF Then
                    Exit Do
                End If
            Loop
        Case TotalParts = 2 And InStr(UCase(SplitCriteria(2)), " AS ") > 0
            SetProperty StatusGadget, "Case", "TotalParts = 2 And InStr(UCase(SplitCriteria(2)), "" AS "") > 0"
            ' gotta make clone of 1st gadget as 2nd gadget
            ' what is 1st gadget name
            Msg = Left(SplitCriteria(2), InStr(SplitCriteria(2), " AS "))
            
        Case TotalParts = 2 And Not DoAll
            SetProperty StatusGadget, "Case", "TotalParts = 2 And Not DoAll"
            ' simple remember object statement
            ' remember, object name
            ' second part is the object to remember
            ' simple read from disk by name
            LTask.Name = SplitCriteria(2)
            LTask.ObjectID = "0"
            SetProperty LTask, "ReadBy", "Name"
            TGadget = ReadGadget(LTask)
            Select Case True
                Case TGadget.Name = NotFound
                    ' need to create it
                    TGadget = BlankObject
                    TGadget.ObjectID = 0
                    TGadget.Name = SplitCriteria(2)
                    WriteMemGadget TGadget.ObjectID, TGadget
                    ResultsGadget = TGadget
                Case Else
                    ' found this gadget
                    ResultsGadget = TGadget
            End Select
        Case TotalParts = 3 And (InStr(SplitCriteria(3), "=") = 0) And Not DoAll
            SetProperty StatusGadget, "Case", "TotalParts = 3 And (InStr(SplitCriteria(3), ""="") = 0) And Not DoAll"
            ' asking for 1 property of a gadget
            ' remember <gadget> <property>
            LTask.Name = SplitCriteria(2)
            LTask.ObjectID = "0"
            SetProperty LTask, "ReadBy", "Name"
            TGadget = ReadGadget(LTask)
            Select Case True
                Case TGadget.Name = NotFound
                    ResultsGadget = TGadget
                    SetProperty ResultsGadget, "Command", Criteria
                Case Else
                    ' return the property
                    ResultsGadget = BlankObject
                    ResultsGadget.Name = SplitCriteria(2)
                    ResultsGadget.Type = "Results of Property Search: " & SplitCriteria(3)
                    SetProperty ResultsGadget, SplitCriteria(3), ReadProperty(TGadget, SplitCriteria(3))
            End Select
        Case TotalParts > 2 And Not DoAll
            SetProperty StatusGadget, "Case", "TotalParts > 2 And Not DoAll"
            ' asking to set property(s) of a gadget
            ' remember, My Gadget, prop1=prop value1, prop2=prop value2... etc
            
            LTask.Name = SplitCriteria(2)
            LTask.ObjectID = "0"
            SetProperty LTask, "ReadBy", "Name"
            TGadget = ReadGadget(LTask)
            Select Case True
                Case TGadget.Name = NotFound
                    ' need to create this gadget
                    TGadget = BlankObject
                    TGadget.Name = SplitCriteria(2)
                    TGadget.ObjectID = 0
                Case Else
                    ' return the property
                    'SetProperty TGadget, SplitCriteria(3), SplitCriteria(4)
            End Select
            ' now, set all properties to the described values
            ' a property is like this prop name=prop value
            ' key in on equal
            For Cntr1 = 3 To TotalParts
                If InStr(SplitCriteria(Cntr1), "=") > 0 Then
                    Prop = Left(SplitCriteria(Cntr1), InStr(SplitCriteria(Cntr1), "=") - 1)
                    Prop = AllTrim(Prop)
                    PropValue = Right(SplitCriteria(Cntr1), Len(SplitCriteria(Cntr1)) - InStr(SplitCriteria(Cntr1), "="))
                    PropValue = AllTrim(PropValue)
                    Select Case True
                        Case UCase(Prop) = "TYPE"
                            TGadget.Type = PropValue
                        Case UCase(Prop) = "CONTAINER"
                            TGadget.Container = PropValue
                        Case Else
                    End Select
                    SetProperty TGadget, Prop, PropValue
                End If
            Next Cntr1
            WriteMemGadget TGadget.ObjectID, TGadget
            ResultsGadget = TGadget
    End Select
    'ReadGadget (SplitCriteria(2))
    GoTo EndSub
'OLD STUFF
'///////////////////////////////////////////////////////////////////////////////////////////////////


LocalError:
    LocalError = Error
    ErrorCNTR = ErrorCNTR + 1
    SetProperty StatusGadget, "Error # " & CStr(ErrorCNTR), LocalError
    
    Resume Next
EndSub:
    GDSFreelocks
    DBSwitch StartDBPTR
    stoptime = Timer
    ResultsGadget.Status = CStr(stoptime - starttime) & " : Remember Time"
    Remember = ResultsGadget
'    ShowGadget StatusGadget
    On Error GoTo 0
End Function
Friend Function Evaluate(Sentence As String) As Gadget
End Function
Friend Function RecallOld(Task As Gadget, Param As Gadget) As Gadget
    ' this returns a gadget, or not based on the passed definition
    ' Recall Coffee Cup                             gets the entire gadget
    ' Recall Coffee Cup, Color; from VGBDatabaseName      gets the color of coffee cup from DBase VGBDatabaseName
    ' Recall Color                                  gets a list of all gadget names with Color property
    ' Recall Color=Red... ,PropertyX=Value X    gets a list of all gadget names with Color property that is Red
    '
    Dim starttime As Single, stoptime As Single
    starttime = Timer
    Dim t, Msg As String, Cntr1 As Long, CNTR2 As Long
    Dim PropCntr As Long
    Dim Crit() As String, CritCNTR As Long, CritPTR As Long
    Dim CritValue() As String
    
    Dim LTask As Gadget, LParam As Gadget
    Dim ResultsGadget As Gadget
    Dim ResultsArrayCNTR As Long
    Dim Accumulator As Gadget, AccumulatorCNTR As Long
    Dim What As String
    Dim From As String
    Dim Criteria As String
    Dim SplitCriteria() As String, SplitCriteriaCNTR As Long, SplitCriteriaPTR As Long
    Dim Prop As String, PropValue As String
    Dim Props() As String, PropValues() As String, PropsCNTR As Long, PropsPTR As Long
    Dim TotalGadgetsFound As Long
    Dim CompareGadgets() As Gadget, CompareGadgetsCntr As Long, CompareGadgetsPTR As Long
    Dim LeftSide As String, RightSide As String
    Dim ComparisonOperator As String
    Dim AutoCreateGadget As Boolean
    Dim LOCDBPTR As Integer
    Dim StartDBPTR As Integer
    Dim LocalError As String
    On Error GoTo LocalError
    LParam = Param
'    For ResultsArrayCNTR = 0 To 20
'        ReDim Preserve ResultsArray(ResultsArrayCNTR)
'        ResultsArray(ResultsArrayCNTR).Name = "Recall Results " & ResultsArrayCNTR
'        For Cntr2 = 1 To 20
'            SetProperty ResultsArray(ResultsArrayCNTR), "Property " & Cntr2, "Setted"
'        Next
'    Next
    For Cntr1 = 1 To 1000
        SetProperty ResultsGadget, "Property " & Cntr1, "Value " & Cntr1
    Next
    stoptime = Timer
    SetProperty ResultsGadget, "Time", CStr(stoptime - starttime)
    GoTo EndSub
    ' make name first lookup crit
    For PropCntr = 0 To Param.TotalProperties
        If UCase(Param.Propity(PropCntr)) = "NAME" Then
            CritCNTR = CritCNTR + 1
            ReDim Preserve Crit(CritCNTR)
            ReDim Preserve CritValue(CritCNTR)
            Crit(CritCNTR) = Param.Propity(PropCntr)
            CritValue(CritCNTR) = Param.ValueAlpha(PropCntr)
        End If
    Next
    
    
    For PropCntr = 0 To Param.TotalProperties
        If (Len(Param.Propity(PropCntr)) > 0) And (UCase(Param.Propity(PropCntr)) <> "NAME") Then
            CritCNTR = CritCNTR + 1
            ReDim Preserve Crit(CritCNTR)
            ReDim Preserve CritValue(CritCNTR)
            Crit(CritCNTR) = Param.Propity(PropCntr)
            CritValue(CritCNTR) = Param.ValueAlpha(PropCntr)
        End If
    Next
    ' here we have all the criteria and thier values
    For CritPTR = 1 To CritCNTR
        Select Case True
            Case UCase(Crit(CritPTR)) = "NAME"
                ObjectsRS.Index = "Name"
                ObjectsRS.Seek "=", CritValue(CritPTR)
                If ObjectsRS.NoMatch = True Then
                    ' no objects by this name
                    ResultsGadget.Name = NotFound
                    SetProperty StatusGadget, "Recall Results", "Failed"
                    SetProperty StatusGadget, CritValue(CritPTR), CritValue(CritPTR) & " " & NotFound
                    GoTo EndSub
                End If
                ' got to here means name ok
                ' load accumulator with names and id's of all gadgets that match all
                ' criteria
                Do While ObjectsRS.NoMatch = False
                                    
                    ObjectsRS.MoveNext
                    If ObjectsRS.EOF = True Then
                        Exit Do
                    End If
                    If ObjectsRS!Name <> CritValue(CritPTR) Then
                        Exit Do
                    End If
                Loop
        End Select
    Next
    
    
    SetProperty Param, "Been in ME Recall", "Yes"
    
    StartDBPTR = DBGadgetsPTR 'starting  db
    LocalError = ""
    StatusGadget = BlankObject
    StatusGadget.Name = "Recall " & Param.Name
    SetProperty StatusGadget, "Status", "Recall Started"
    LTask = Param
    LTask.Name = Command
    What = ReadProperty(Task, "What")
    If What = NotFound Then
        What = Param.Name
    End If
    What = UCase(What)
    From = ReadProperty(Task, "From")
    
    ' see did they send criteria
    Criteria = ReadProperty(Task, "Criteria")
    SetProperty Param, "Criteria", Criteria
    ' fix any boofs in criteria
    Criteria = AllTrim(Criteria)
    If Right(Criteria, 1) = "," Then
        Criteria = Left(Criteria, Len(Criteria) - 1)
    End If
    If Right(Criteria, 2) = CrLf Then
        Criteria = Left(Criteria, Len(Criteria) - 2)
    End If
    If Right(Criteria, 1) = Cr Then
        Criteria = Left(Criteria, Len(Criteria) - 1)
    End If
    If Right(Criteria, 1) = Lf Then
        Criteria = Left(Criteria, Len(Criteria) - 1)
    End If
    ' take it apart
    SplitCriteria = Split(Criteria, ",")
    SplitCriteriaCNTR = UBound(SplitCriteria)
    ReDim Preserve SplitCriteria(SplitCriteriaCNTR + 1)
    ' fix zero based array bs and remove commas
    For SplitCriteriaPTR = SplitCriteriaCNTR + 1 To 1 Step -1
        If AllTrim(SplitCriteria(SplitCriteriaPTR)) <> "," Then
            SplitCriteria(SplitCriteriaPTR) = AllTrim(SplitCriteria(SplitCriteriaPTR - 1))
        End If
    Next
    SplitCriteriaCNTR = UBound(SplitCriteria)
    
    
    
    ' let's get comparison definitions
    ' each comparison gadget has 3 properties
    '   left side (up to comparison operator)
    '   comparison operator (<>, <=, etc)
    '   right side (after comparison operator)
    CNTR2 = 0
    ' let's see if we have already set a recordset set up

    If LocalError <> "" Then
        Static LOCObjectsRS As Recordset, LOCPropsRS As Recordset
        Set LOCObjectsRS = ObjectsRS
        Set LOCPropsRS = PropsRS
    End If
    If LOCObjectsRS.Index <> "Name" Then
        LOCObjectsRS.Index = "Name"
    End If
    t = LOCObjectsRS.Fields
    For SplitCriteriaPTR = 1 To SplitCriteriaCNTR
        SetProperty StatusGadget, "Part: " & CStr(SplitCriteriaPTR), SplitCriteria(SplitCriteriaPTR)
        SetProperty Param, "Crit " & Cntr1, SplitCriteria(SplitCriteriaPTR)
        Select Case True
            Case InStr(SplitCriteria(SplitCriteriaPTR), "<>") > 0
                ' not equal to
                ComparisonOperator = "<>"
            Case InStr(SplitCriteria(SplitCriteriaPTR), ">=") > 0
                ' greater than or equal to
                ComparisonOperator = ">="
            Case InStr(SplitCriteria(SplitCriteriaPTR), "<=") > 0
                ' less than or equal to
                ComparisonOperator = "<="
            Case InStr(SplitCriteria(SplitCriteriaPTR), "=") > 0
                ' equal to
                ComparisonOperator = "="
            Case InStr(UCase(SplitCriteria(SplitCriteriaPTR)), UCase("Contains")) > 0
                ' contains "contains"
                ComparisonOperator = "CONTAINS"
            Case Else
                ComparisonOperator = ""
        End Select
        If ComparisonOperator <> "" Then
            CompareGadgetsCntr = CompareGadgetsCntr + 1
            ReDim Preserve CompareGadgets(CompareGadgetsCntr)
'            ReDim Preserve PropValues(PropsCNTR)
            LeftSide = AllTrim(Left(SplitCriteria(SplitCriteriaPTR), InStr(SplitCriteria(SplitCriteriaPTR), ComparisonOperator) - 1))
            SetProperty CompareGadgets(CompareGadgetsCntr), "Left Side", LeftSide
            
            SetProperty CompareGadgets(CompareGadgetsCntr), "Comparison Operator", ComparisonOperator
            
            RightSide = AllTrim(Right(SplitCriteria(SplitCriteriaPTR), Len(SplitCriteria(SplitCriteriaPTR)) - InStr(SplitCriteria(SplitCriteriaPTR), "=")))
            SetProperty CompareGadgets(CompareGadgetsCntr), "Right Side", RightSide
            ' build a statusgadget
            Msg = ReadProperty(CompareGadgets(CompareGadgetsCntr), "Left Side")
            Msg = Msg & ReadProperty(CompareGadgets(CompareGadgetsCntr), "Comparison Operator")
            Msg = Msg & ReadProperty(CompareGadgets(CompareGadgetsCntr), "Right Side")
            SetProperty StatusGadget, "Comparison: " & CStr(CompareGadgetsCntr), Msg
            '
            ' we've got some kind of comparison to do
            ' see if compare (right side) is gadget
            LOCObjectsRS.Seek "=", RightSide
            If LOCObjectsRS.NoMatch = False Then
                ' got a hit on this name as gadget
                
                
            End If
            
        End If
'        If InStr(SplitCriteria(SplitCriteriaPTR), "=") Then
'            ' this criterion contains an equal sign, a sign of properties
'            'StatusGadget = BlankObject
'            StatusGadget.Name = "Started Parsing"
'            PropsCNTR = PropsCNTR + 1
'            ReDim Preserve Props(PropsCNTR)
'            ReDim Preserve PropValues(PropsCNTR)
'            Props(PropsCNTR) = Left(SplitCriteria(SplitCriteriaPTR), InStr(SplitCriteria(SplitCriteriaPTR), "=") - 1)
'            Props(PropsCNTR) = AllTrim(Props(PropsCNTR))
'            PropValues(PropsCNTR) = Right(SplitCriteria(SplitCriteriaPTR), Len(SplitCriteria(SplitCriteriaPTR)) - InStr(SplitCriteria(SplitCriteriaPTR), "="))
'            PropValues(PropsCNTR) = AllTrim(PropValues(PropsCNTR))
'            SetProperty StatusGadget, "Property: " & CStr(PropsCNTR) & " = " & Props(PropsCNTR), PropValues(PropsCNTR)
'        '    ShowGadget StatusGadget
'        End If
    Next SplitCriteriaPTR
    ' we now have comparisons parsed into different gadgets
    ' we need to figure out which table and table index to use
    '



GoTo EndSub





    If Criteria <> NotFound Then
        ' they gave us criteria
'        SplitCriteria = Split(Criteria)
    End If
   ' make if not found?
    AutoCreateGadget = UCase(ReadProperty(Task, "Auto Create")) = "TRUE"
    ' cases possible
    ' Gadget
    '   All Names
    '   Name <
    '   Name <=
    '   Name =
    '   Name >=
    '   Name >
    '   Name <>
    '   Name Contains
    ' <, <=, =, >=, >
    Select Case True
        Case What = UCase("Gadget")
            ' 1 or more gadgets per criteria
            ' must Have at least one criterion to work
            For SplitCriteriaPTR = 1 To SplitCriteriaCNTR
                Select Case True
                    Case UCase(Left(SplitCriteria(SplitCriteriaPTR), 4)) = UCase("Name")
                        ' they want names and the want them now
                        Select Case True
                            Case InStr(SplitCriteria(SplitCriteriaPTR), "<>") > 0
                                ' not equal to
                                
                            Case InStr(SplitCriteria(SplitCriteriaPTR), ">=") > 0
                                ' greater than or equal to
                            Case InStr(SplitCriteria(SplitCriteriaPTR), "<=") > 0
                                ' less than or equal to
                            Case InStr(UCase(SplitCriteria(SplitCriteriaPTR)), UCase("Contains")) > 0
                                ' name contains
                            Case InStr(SplitCriteria(SplitCriteriaPTR), "=") > 0
                                ' equal to
                            
                            
'                            Case InStr(SplitCriteria(SplitCriteriaPTR), "<>") > 0
'                            Case InStr(SplitCriteria(SplitCriteriaPTR), "<>") > 0
'                            Case InStr(SplitCriteria(SplitCriteriaPTR), "<>") > 0
                        End Select
                    
                    
                    Case InStr(SplitCriteria(SplitCriteriaPTR), "=") > 0
                         '
                        Select Case True
                        
                        End Select
                    
                        ResultsGadget.Name = "Results of " & Criteria
                        SetProperty StatusGadget, "Case", "InStr(UCase(SplitCriteria(2)), ""ALL"") > 0"
                        SetProperty StatusGadget, "Command", SplitCriteria(2)
'                        ShowGadget StatusGadget
                    
                    Case InStr(SplitCriteria(1), "Name =") > 0
                        ' they want names and the want them now
                    
                
                    Case InStr(Criteria, "=") > 0
                
                End Select
            Next
        Case What = UCase("Gadget Names")
            For LOCDBPTR = 1 To DBGadgetsCNTR
                If From = "ALL" Then
                   DBSwitch LOCDBPTR
                Else
                    ' switch to the one they want to check
                    
                End If
                Msg = ReadProperty(DBGadgets(LOCDBPTR), "Path")
                Msg = AddBackSlash(Msg) & ReadProperty(DBGadgets(LOCDBPTR), "DB Name")
                LocalError = ""
                ObjectsRS.Index = "Name"
                ObjectsRS.MoveFirst
                If LocalError <> "" Then
                    SetProperty ResultsGadget, "Error", LocalError
                    GoTo EndSub
                End If
                ResultsGadget = BlankObject
'                ResultsGadget.Name = SplitCriteria(2)
                Cntr1 = 0
                Do While ObjectsRS.EOF = False
                    Cntr1 = Cntr1 + 1
                    SetProperty ResultsGadget, ObjectsRS!Name, Msg
                    ObjectsRS.MoveNext
                    If LocalError <> "" Then
                        Exit Do
                    End If
                Loop
                If From <> "ALL" Then
                   Exit For
                End If
            Next
        Case What = UCase("All Gadgets With Properties")
            
    End Select
    GoTo EndSub
LocalError:
    LocalError = Error
    Resume Next
EndSub:
    RecallOld = ResultsGadget
    stoptime = Timer
    DBSwitch StartDBPTR
    SetProperty StatusGadget, "Time in Recall", CStr(stoptime - starttime)
'    FloatMsgBox "Recall Time: " & CStr(stoptime - starttime), ucase(App.EXEName) & " Timing Status"
End Function

Friend Function Describe(Task As Gadget, Param As Gadget) As Gadget

End Function

Friend Function Rename(Crit As String) As Gadget
    ' this will rename the first to second name
    ' syntax: Rename,[property], Name1, Name2
    ' remember to check all is's to update properties
    Dim starttime As Single, stoptime As Single
    starttime = Timer
    Dim t, Msg As String, Cntr1 As Long
    Dim LocalError As String
    Dim ResultsGadget As Gadget
    Dim LTask As Gadget, LParam As Gadget
    Dim TGadget As Gadget
    Dim Sentence As String
    Dim SplitSentence() As String
    Dim TotalParts As Long
    Dim LongTermMemoryDBPTR As Integer
    Dim StartDBPTR As Integer
    On Error GoTo LocalError
    StartDBPTR = DBGadgetsPTR
    
'    LongTermMemoryDBPTR = DBFindIndex(VGBDatabaseName)
'    SetProperty ResultsGadget, "Error", "No Database Found"
'    ResultsGadget.Name = "Remember Started"
'    Sentence = ReadProperty(Task, "Rename")
'    SetProperty ResultsGadget, "Sentence", Sentence
'    If Sentence = NotFound Then
'        Sentence = ReadProperty(Task, "Remember Wut")
'        If Sentence = NotFound Then
'            Sentence = ReadProperty(Task, "Parameters")
'        End If
'    End If
'    If Sentence = NotFound Then
'        SetProperty ResultsGadget, "Error", "No Command String to Process"
'        GoTo EndSub
'    End If
'    SetProperty ResultsGadget, "Sentence", Sentence
'    ' figure out what they said
'    SplitSentence = Split(Sentence, ",")
'    TotalParts = UBound(SplitSentence)
'    ReDim Preserve SplitSentence(TotalParts + 1)
'    For Cntr1 = TotalParts + 1 To 1 Step -1
'        SplitSentence(Cntr1) = AllTrim(SplitSentence(Cntr1 - 1))
'    Next
'
    GoTo EndSub
LocalError:
    LocalError = Error
    Resume Next
EndSub:
    Rename = ResultsGadget
    On Error GoTo 0
End Function
Friend Function Delete(Task As Gadget, Param As Gadget) As Gadget

End Function
Friend Function Group(Task As Gadget, Param As Gadget) As Gadget

End Function
Friend Function Cut(Task As Gadget, Param As Gadget) As Gadget

End Function
Friend Function Copy(Task As Gadget, Param As Gadget) As Gadget

End Function
Friend Function Paste(Task As Gadget, Param As Gadget) As Gadget

End Function
'Public Function StartGadgetor() As Gadget
'    Dim Result As Gadget
'    Result.Name = "Start Results"
'    StartGadgetor = Result
'End Function
Friend Function Ramorize(Task As Gadget, Param As Gadget) As Gadget
    ' save the param in memories array
    Dim starttime As Single, stoptime As Single
    starttime = Timer
    Dim t, Msg As String, MemPTR As Long, Cntr1 As Long
    Dim MemProp As String, MemPropValue As String, MemPropPTR As Long
    Dim TaskProp As String, TaskPropValue As String, TaskPropPTR As Long
    Dim Result As Gadget
    Result = Task
    For MemPTR = 1 To MemoriesCNTR
        If Memories(MemPTR).Name = Param.Name Then
            Exit For
        End If
    Next
    Select Case True
        Case MemPTR > MemoriesCNTR
            MemoriesCNTR = MemoriesCNTR + 1
            MemPTR = MemoriesCNTR
            ReDim Preserve Memories(MemoriesCNTR)
            Memories(MemoriesCNTR) = Param
            SetProperty Result, "Status", "Added"
        Case Else
            ' found this one. update the properties only
            ' first, delete all properties in the memory gadget
            Memories(MemPTR).TotalProperties = 0
            ReDim Preserve Memories(MemPTR).Propity(0)
            ReDim Preserve Memories(MemPTR).ValueAlpha(0)
            For TaskPropPTR = 1 To Task.TotalProperties
                TaskProp = Task.Propity(TaskPropPTR)
                TaskPropValue = Task.ValueAlpha(TaskPropPTR)
                MemPropValue = SetProperty(Memories(MemPTR), TaskProp, TaskPropValue)
            Next TaskPropPTR
            SetProperty Result, "Status", "Updated"
    End Select
    SetProperty Result, "Index", CStr(MemPTR)
    stoptime = Timer
    SetProperty Result, "Total Time", CStr(stoptime - starttime)
    Ramorize = Result
    
End Function



Friend Sub SetCoreVariables()
    ' database
    OpenDBPTR = 0
    OpenDBCNTR = 0
    AppGadgetsPTR = 0
    DBGadgetsPTR = 0
    ReDim OpenRS(0)
    ReDim OpenDB(0)
End Sub


' this is the set of core tasks and miscellaneous functions
''''''''''''''''''''''''''''
' Gadgetorium Visual Basic global routines file for CORE (and seven modules ago).
' This file can be loaded into a code module.
' note: see glbldefs to see all the global variable definitions
' Use public sub GlobalInit to initialize GDS Global variables, th.
'
'
' Listing of OPAG-Callable Functions (Tell Gadgetor)
'
'
'

''''''''''''''''''''''''''''
'Public Function CountObjects(CountBy As Field, Criterion As Variant) As Long
'    Dim TotalFound As Integer
'    ObjectsRS.Index = CountBy
'    ObjectsRS.Seek "=", Criterion
'
'    TotalFound = 0
'    Do While ObjectsRS.EOF <> True
'        If ObjectsRS!Type = "Cellable" Then
'            TotalFound = TotalFound + 1
'        End If
'        ObjectsRS.MoveNext
'    Loop
'    CountObjects = TotalFound

'End Function
Friend Function ReadGadget(Param As Gadget) As Gadget
    ' Tell Gadgetor, ReadGadget,
    Dim StartDBPTR As Integer
    Dim Cntr1 As Integer
    Dim StatGadget As Gadget
    Dim ReadResults As Gadget
    Dim Accum() As Gadget, AccumCNTR As Long
    Dim DebugGadget As Gadget
    Dim LParam As Gadget
    LParam = Param
    DebugGadget = Param
    SetProperty DebugGadget, "DB: ", CStr(DBGadgetsPTR)
    StartDBPTR = DBGadgetsPTR
    Select Case True
        Case (UCase(ReadProperty(Param, "ReadBy")) = "NAME") And _
             (UCase(ReadProperty(Param, "SCOPE")) = "CURRENT")
            ReadGadget = ReadDiskGadgetByName(LParam)
            
        Case UCase(ReadProperty(Param, "ReadBy")) = "NAME"
            For Cntr1 = 0 To DBGadgetsCNTR
                DBSwitch Cntr1
                ReadResults = ReadDiskGadgetByName(LParam)
                If ReadResults.Name <> NotFound Then
                    AccumCNTR = AccumCNTR + 1
                    ReDim Preserve Accum(AccumCNTR)
                    Accum(AccumCNTR) = ReadResults
                    SetProperty StatGadget, "DB " & AccumCNTR, DBGadgets(Cntr1).Name
                End If
            Next
            Select Case True
                Case AccumCNTR = 0
                    ReadGadget = ReadResults
                Case AccumCNTR = 1
                    ReadGadget = Accum(AccumCNTR)
                Case Else
                    ReadGadget.Name = "Multiple Locations"
                    For Cntr1 = 1 To AccumCNTR
'                       SetProperty ReadResults, "Name " & Cntr1, Accum(Cntr1).Name
                        SetProperty ReadResults, "DB " & Cntr1, ReadProperty(StatGadget, "DB " & Cntr1)
                    Next
                    ReadGadget = ReadResults
            End Select
            DBSwitch StartDBPTR
            GoTo EndSub
        Case UCase(ReadProperty(Param, "ReadBy")) = "ID"
            ReadGadget = ReadDiskGadgetByID(LParam.ObjectID)
            
        Case Param.Name <> BlankObject.Name
            ReadGadget = ReadDiskGadgetByName(LParam)
    End Select
'    ShowGadget DebugGadget
EndSub:
    If StartDBPTR <> DBGadgetsPTR Then
        DBSwitch StartDBPTR
    End If

End Function

Friend Function ChangeGadgetName(Task As Gadget, Param As Gadget) As Gadget
    ' change an objects name, based on objectid
    Dim LocalError As String, Cntr1 As Integer
    Dim ObjectToChangeID As Long
    Dim NewName As String
    LocalError = ""
    On Error GoTo LocalError
    ObjectToChangeID = Param.ObjectID
    NewName = ReadProperty(Param, "New Name")
    ObjectsRS.Index = "PrimaryKey"
    ObjectsRS.Seek "=", ObjectToChangeID
    If ObjectsRS.NoMatch Then
        MsgBox "I can't find the object to change the name of.", , UCase(App.EXEName) & "Debug Message"
        GoTo EndSub:
    End If
    GadgetWorkspace.BeginTrans
    ObjectsRS.Edit
    ObjectsRS!Name = NewName
    LocalError = ""
    ObjectsRS.Update
    If LocalError <> "" Then
        Cntr1 = 0
        Do While Cntr1 <= 20
            LocalError = ""
            WasteTime 0.1
            ObjectsRS.Update
            If LocalError = "" Then
                Exit Do
            End If
            Cntr1 = Cntr1 + 1
        Loop
    End If
    If InStr(LocalError, "LOCKED") > 0 Then
        MsgBox "Change Object Nane: Record Locked"
    End If
    GadgetWorkspace.CommitTrans
    GoTo EndSub
LocalError:
    LocalError = Error
    Resume Next
EndSub:
    On Error GoTo 0
    GDSFreelocks
End Function

Friend Function ReadGDSGadget(ObjectToReadName As String, ObjectToReadInto As Gadget) As String
    ' read an object from the GDSReg database
    ' be careful, this reads only 1st instance of object
    Dim t, Result As String
    Dim StartAppPTR As Integer
    Dim StartAppDBGadgetsPTR As Integer
    Dim StartObjectsRS As Recordset
    Dim StartPropsRS As Recordset
'    Dim StartMethodsRS As Recordset
    Dim StartOpenDBPTR As Integer
    If Suicide Then
        On Error Resume Next
    End If
    OpenDBPTR = StartOpenDBPTR
    StartAppPTR = AppGadgetsPTR
    StartAppDBGadgetsPTR = DBGadgetsPTR
    Set StartObjectsRS = ObjectsRS
    Set StartPropsRS = PropsRS
'    Set StartMethodsRS = MethodsRS
    StartOpenDBPTR = OpenDBPTR
    DBSwitch 0
    t = ReadGadgetByName(ObjectToReadName, ObjectToReadInto)
'    If t <> "OK" Then
'        MsgBox "Error Reading GDS Registry object: " & ObjectToReadName, , ucase(App.EXEName) & " Debug Message"
'    End If
    AppGadgetsPTR = StartAppPTR
'    Set ObjectsRS = StartObjectsRS
'    Set PropsRS = StartPropsRS
'    Set MethodsRS = StartMethodsRS
    DBSwitch StartAppDBGadgetsPTR
    ReadGDSGadget = t
    On Error GoTo 0
End Function

Friend Function GODReadGDSObjectByID(ObjectToReadID As Long) As String
    ' read a GDSReg object by ID
    Dim t, Result As String
    Dim StartAppPTR As Integer
    Dim StartAppDBGadgetsPTR As Integer
    Dim StartObjectsRS As Recordset
    Dim StartPropsRS As Recordset
    Dim StartMethodsRS As Recordset
    Dim StartOpenDBPTR As Integer
    If Suicide Then
        On Error Resume Next
    End If
    StartAppPTR = AppGadgetsPTR
    StartAppDBGadgetsPTR = DBGadgetsPTR
    StartOpenDBPTR = OpenDBPTR
    DBSwitch 0
    t = ReadGadgetByID(ObjectToReadID)
    If t <> "OK" Then
        MsgBox "Error Reading GDS Registry object: " & ObjectToReadID, , UCase(App.EXEName) & " Debug Message"
    End If
    AppGadgetsPTR = StartAppPTR
    DBSwitch StartAppDBGadgetsPTR
    GODReadGDSObjectByID = t
    On Error GoTo 0
    GDSFreelocks
End Function

Friend Function WriteGDSGadget(ObjectToWriteID As Long, ObjectToWriteFrom As Gadget) As String
    ' write a GDS Object (unknown ID creates new object)
    Dim t, Result As String
    Dim StartAppPTR As Integer
    Dim StartAppDBGadgetsPTR As Integer
    Dim StartObjectsRS As Recordset
    Dim StartPropsRS As Recordset
'    Dim StartMethodsRS As Recordset
    Dim StartOpenDBPTR As Integer
    Dim StartBookMark As String, StartKey As String
    Dim LocalError As String
    On Error GoTo LocalError
    StartBookMark = ObjectsRS.Bookmark
    StartKey = ObjectsRS.Index
    StartAppPTR = AppGadgetsPTR
    StartAppDBGadgetsPTR = DBGadgetsPTR
    Set StartObjectsRS = ObjectsRS
    Set StartPropsRS = PropsRS
'    Set StartMethodsRS = MethodsRS
    StartOpenDBPTR = OpenDBPTR
    If ObjectToWriteFrom.Name = UCase(App.EXEName) & "-" & "RWS.RWS" Then
        If UCase(App.EXEName) = "RWS_VIEW" Then
            MsgBox "Writing: " & ObjectToWriteFrom.Name
        End If
    End If
    t = DBSwitch(0)
    If t <> OK Then
        MsgBox "Switching to Registry Database (1) Failed", , UCase(App.EXEName) & " Debug Message"
    End If
    t = WriteMemGadget(ObjectToWriteID, ObjectToWriteFrom)
    If t <> "OK" Then
        MsgBox "Error Writing GDS Registry object: " & ObjectToWriteFrom.Name, , UCase(App.EXEName) & " Debug Message"
    End If
    Result = t
    AppGadgetsPTR = StartAppPTR
    GoTo EndSub
LocalError:
    LocalError = Error
    Resume Next
EndSub:
    If StartAppDBGadgetsPTR <= AppDBGadgetsCNTR Then
        t = DBSwitch(StartAppDBGadgetsPTR)
        If DBGadgetsPTR <> StartAppDBGadgetsPTR Then
'            MsgBox "DB Pointer Wrong"
        End If
    End If
    WriteGDSGadget = Result
    ObjectsRS.Index = StartKey
    ObjectsRS.Bookmark = StartBookMark
    GDSFreelocks
    On Error GoTo 0
End Function

Friend Function WriteMemGadget(GadgetToWriteID As Long, GadgetToWriteFrom As Gadget) As String
    ' This one will write the Gadgettowrite from Gadget to disk as GadgetToWriteID
    ' if GadgetToWriteID doesn't exist, a new is created
    ' added the deletion of properties from disk that do not exist in the gadgettowrite
    Dim starttime As Single, stoptime As Single
    starttime = Timer
    Static WriteCNTR As Long
    WriteCNTR = WriteCNTR + 1
    Static MemPropsRS As Recordset
    Static LastMemPropsQuery As String
    Dim t, Msg As String, PropertyNDX As Long, Cntr1 As Integer, CNTR2 As Integer
    Dim ExistingGadget As Gadget
    Dim MemPoolName As String
    Dim DeletePropIDs() As Long, DeletePropIDsCNTR As Long, DeletePropIDsPTR As Long
    Dim SavedPropIDs() As Long, SavedPropIDsCNTR As Long, SavedPropIDsPTR As Long
    Dim ThisMemPropsQuery As String
    Dim Crit As String
    Dim ShowedOnce As Boolean
    Dim LGadget As Gadget
    Dim Result As String
    Dim WriteGadget As Boolean
    Dim GadgetAdded As Boolean
    Dim GadgetsStartRec As String, ResetGadgets As Boolean
    Dim PropsStartRec As String, ResetProps As Boolean
    Dim UpdateNeeded As Boolean
    Dim AddThisProp As Boolean
    Dim LocalError As String
    Dim StartBookMark As String, StartKey As String
    Dim StartPropBookmark As String, StartPropKey As String
    Dim TempPropBookmark As String, TempPropKey As String
    LocalError = ""
    On Error GoTo LocalError
        
    ThisMemPropsQuery = "Select * from props where props.objectid=" & CStr(GadgetToWriteFrom.ObjectID) & " order by props.valuealpha;"
    'ThisMemPropsQuery = "Select * from props where props.objectid=" & CStr(GadgetToWriteFrom.ObjectID) & ";"
    If ThisMemPropsQuery <> LastMemPropsQuery Then
        Set MemPropsRS = OpenDB(OpenDBPTR).OpenRecordset(ThisMemPropsQuery, dbOpenDynaset)
        MemPropsRS.MoveLast
    End If
    LastMemPropsQuery = ThisMemPropsQuery
    Msg = CStr(Len(GadgetToWriteFrom.Name))
    SetProperty Trace, NextID("trace") & "WriteMemGadget", GadgetToWriteFrom.Name & " (L=" & Msg & ")" & " / Type: " & GadgetToWriteFrom.Type & " / ID: " & CStr(GadgetToWriteFrom.ObjectID)
    SetProperty Trace, NextID("trace") & "WriteMemGadget", "Writing [" & GadgetToWriteFrom.Name & "] to DB: " & DBGadgets(DBGadgetsPTR).Name
    WriteGadget = False
    ShowedOnce = False
    Result = "OK"
    GadgetAdded = False
    ' take care of null values in fields
    If Len(GadgetToWriteFrom.Type) = 0 Then
        GadgetToWriteFrom.Type = "None"
    End If
    If Len(GadgetToWriteFrom.GAppName) = 0 Then
        GadgetToWriteFrom.GAppName = UCase(App.EXEName)
    End If
    If Len(GadgetToWriteFrom.Container) = 0 Then
        GadgetToWriteFrom.Container = "None"
    End If
    If Len(GadgetToWriteFrom.Tag) = 0 Then
        ' not required
        GadgetToWriteFrom.Tag = 0
    End If
    If Len(GadgetToWriteFrom.Level) = 0 Then
        GadgetToWriteFrom.Level = 0
    End If
    If ObjectsRS.RecordCount = 0 Then
        ' creating a new Gadget in empty db
        If LocalError <> "" Then
            SetProperty Trace, NextID("trace") & "WriteMemGadget NOT an Error", "Checking Reccount: " & LocalError
        End If
        GadgetAdded = True
        WriteGadget = True
        GoTo WriteNow
    End If
    If LocalError = "" Then
        StartBookMark = ObjectsRS.Bookmark
        StartKey = ObjectsRS.Index
        StartPropBookmark = PropsRS.Bookmark
        StartPropKey = PropsRS.Index
'        If LocalError <> "" Then
'            SetProperty Trace, NextID("trace") & "WriteMemGadget NOT an Error", "setting Start Positions: " & LocalError
'        End If
    End If
    LocalError = ""
    ObjectsRS.Index = "PrimaryKey"
    ObjectsRS.Seek "=", GadgetToWriteID
    If ObjectsRS.NoMatch = True Then
        ' creating a new Gadget
        GadgetAdded = True
        WriteGadget = True
        GoTo WriteNow
    Else
        ' writing a Gadget that exists
        ' see if the objectid's are ok
        If UCase(GadgetToWriteFrom.Name) = UCase(ObjectsRS!Name) Then
            If (GadgetToWriteID > 0) And (GadgetToWriteFrom.ObjectID <> ObjectsRS!ObjectID) Then
                ' got us a situation here
                SetProperty Trace, NextID("trace") & "WriteMemGadget ERROR", "Passed ID: " & CStr(GadgetToWriteFrom.ObjectID) & "Disk ID: " & CStr(ObjectsRS!ObjectID)
                Result = "Error: GadgetIDs Goof"
                GoTo EndSub
            End If
        End If
    End If
    ' do we really need to write the Gadget to the object table?
    LocalError = ""
    Select Case True
        Case WriteGadget = True
        Case ObjectsRS![Name] <> GadgetToWriteFrom.Name
            WriteGadget = True
        Case ObjectsRS![Type] <> GadgetToWriteFrom.Type
            WriteGadget = True
        Case ObjectsRS![Container] <> GadgetToWriteFrom.Container
            WriteGadget = True
        Case ObjectsRS![Level] <> GadgetToWriteFrom.Level
            WriteGadget = True
        Case ObjectsRS![GAppName] <> UCase(App.EXEName)
            WriteGadget = True
        Case ObjectsRS![Tag] <> GadgetToWriteFrom.Tag
            If IsNull(ObjectsRS![Tag]) Then
                If GadgetToWriteFrom.Tag <> "" Then
                    WriteGadget = True
                End If
            Else
                If ObjectsRS![Tag] <> GadgetToWriteFrom.Tag Then
                    WriteGadget = True
                End If
            End If
    End Select
    If LocalError <> "" Then
        SetProperty Trace, NextID("trace") & "WriteMemGadget Check if Write Error", LocalError
    End If
    
    LocalError = ""
    If WriteGadget = False Then
        GoTo SkipWriteGadget
    End If
    ' we need to write the Gadget for some reason
    
WriteNow:
    GadgetWorkspace.BeginTrans
    If GadgetAdded = True Then
        ObjectsRS.AddNew
    Else
        ObjectsRS.Edit
    End If
    ' let's set the fields
    LocalError = ""
    ObjectsRS![Name] = GadgetToWriteFrom.Name
    If LocalError <> "" Then
        SetProperty Trace, NextID("trace") & "WriteMemGadget Name Error", LocalError
    End If

    LocalError = ""
    ObjectsRS![Type] = GadgetToWriteFrom.Type
    If LocalError <> "" Then
        SetProperty Trace, NextID("trace") & "WriteMemGadget Type Error", LocalError
    End If
    
    LocalError = ""
    ObjectsRS![GAppName] = GadgetToWriteFrom.GAppName
    If LocalError <> "" Then
        SetProperty Trace, NextID("trace") & "WriteMemGadget GAppName Error", LocalError
    End If
    
    LocalError = ""
    ObjectsRS![Container] = GadgetToWriteFrom.Container
    If LocalError <> "" Then
        SetProperty Trace, NextID("trace") & "WriteMemGadget Container Error", LocalError
    End If
    
    LocalError = ""
    ObjectsRS![Tag] = GadgetToWriteFrom.Tag
    If LocalError <> "" Then
        SetProperty Trace, NextID("trace") & "WriteMemGadget Tag Error", LocalError
    End If
    
    LocalError = ""
    ObjectsRS![Level] = GadgetToWriteFrom.Level
    If LocalError <> "" Then
        SetProperty Trace, NextID("trace") & "WriteMemGadget Level Error", LocalError
    End If
    
    LocalError = ""
    ObjectsRS.Update
'    MsgBox Timer - starttime, , "Memory Gadget Write"
'    starttime = Timer
    If LocalError <> "" Then
        If LocalError = "Disk I/O error during read." Then
            ' error number 3040, trappable data access errors off of trappable errors in help
            ErrorCNTR = ErrorCNTR + 1
            ReDim Preserve ErrorObjects(ErrorCNTR)
            Msg = ""
            ErrorObjects(ErrorCNTR) = BlankObject
            ErrorObjects(ErrorCNTR).Name = "Error Gadget: " & CStr(Date) & " @ " & CStr(Time)
            ErrorObjects(ErrorCNTR).Type = "Error"
            ErrorObjects(ErrorCNTR).Container = "ObjectsRS"
            ErrorObjects(ErrorCNTR).Tag = "Not Logged"
            t = SetProperty(ErrorObjects(ErrorCNTR), "App ExeName", UCase(App.EXEName))
            t = SetProperty(ErrorObjects(ErrorCNTR), "Error", LocalError)
            t = SetProperty(ErrorObjects(ErrorCNTR), "AppGadget", AppGadgets(AppGadgetsPTR).Name)
            t = SetProperty(ErrorObjects(ErrorCNTR), "DB", DBGadgets(DBGadgetsPTR).Name)
'            WriteErrorLog
        End If
    End If
    If LocalError <> "" Then
        Cntr1 = 0
        Do While Cntr1 <= 50
'            DoEvents
            If Cntr1 = 50 Then
                GlobalErrorsCNTR = GlobalErrorsCNTR + 1
                ReDim Preserve GlobalErrors(GlobalErrorsCNTR)
                GlobalErrors(GlobalErrorsCNTR) = BlankObject
                GlobalErrors(GlobalErrorsCNTR).Name = UCase(App.EXEName) & ": Write Memory Gadget Error"
                GlobalErrors(GlobalErrorsCNTR).Type = "Error"
                GlobalErrors(GlobalErrorsCNTR).Container = "Error"
                GlobalErrors(GlobalErrorsCNTR).Tag = CStr(Now())
    '            t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Writing", GadgetToWriteFrom.Name & "/" & CStr(GadgetToWriteFrom.ObjectID))
                t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "App", UCase(App.EXEName))
                t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Error Occurred", "Gadget Update: " & GadgetToWriteFrom.Name & "/" & CStr(GadgetToWriteFrom.ObjectID))
                t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Error Date", CStr(Now()))
                t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Error", LocalError)
                t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Retry Counter", CStr(Cntr1))
            Else
'                t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Retry Counter", CStr(Cntr1))
            End If
            LocalError = ""
            WasteTime 0.1
            ObjectsRS.Update
            If LocalError = "" Then
                Exit Do
            End If
            GDSFreelocks
            If Cntr1 Mod 20 = 0 Then
'                DoEvents
            End If
            Cntr1 = Cntr1 + 1
        Loop
    End If
    If InStr(UCase(LocalError), "LOCKED") > 0 Then
        
'        FloatMsgBox "Write Memory Gadget: Lock Error", "Error Writing Gadget"
    End If
    ObjectsRS.Bookmark = ObjectsRS.LastModified
    GadgetToWriteFrom.ObjectID = ObjectsRS![ObjectID]
    
    GadgetWorkspace.CommitTrans
    GDSFreelocks
SkipWriteGadget:
    ' now do the props
    MemPoolName = ReadProperty(DBGadgets(DBGadgetsPTR), "DB Name")
    If GadgetAdded = False Then
        ' read the old one from disk and use a memory version to manipulate
        ' since we are going to do many iterations through this thing
        ExistingGadget = RecallByID(GadgetToWriteID, "from " & MemPoolName)
        If ExistingGadget.ObjectID <> GadgetToWriteID Then
            SetProperty Trace, NextID("trace") & "WriteMemGadget DB Trapped", "Error: Recall Object failed to find the disk object: " & CStr(GadgetToWriteID) & " Got: " & CStr(ExistingGadget.ObjectID)
            SetProperty VGBErrors, NextID("error") & "WriteMemGadget DB Trapped", "Error: Recall Object failed to find the disk object: " & CStr(GadgetToWriteID) & " Got: " & CStr(ExistingGadget.ObjectID)
            Result = "Error Locating Existing (Disk) Object"
            GoTo EndSub
        End If
    End If
    CNTR2 = 0
    SavedPropIDsCNTR = GadgetToWriteFrom.TotalProperties
    ReDim SavedPropIDs(SavedPropIDsCNTR)
    ' let's delete all properties that are not in the
    ' to write from and are in the existing gadget
    For Cntr1 = 1 To ExistingGadget.TotalProperties
        For CNTR2 = 1 To GadgetToWriteFrom.TotalProperties
            If (GadgetToWriteFrom.Propity(CNTR2) = ExistingGadget.Propity(Cntr1)) Then
                Exit For
            End If
        Next CNTR2
        Select Case True
            Case CNTR2 > GadgetToWriteFrom.TotalProperties
                ' needs deleted
                PropsRS.Index = "PropertyID"
                PropsRS.Seek "=", ExistingGadget.PropertyID(Cntr1)
                If PropsRS.NoMatch = False Then
                    DeletePropIDsCNTR = DeletePropIDsCNTR + 1
                    PropsRS.Delete
                Else
                    Result = "Error Locating Existing (Disk) Object's Property: " & ExistingGadget.Propity(Cntr1)
                    GoTo EndSub
                End If
        End Select
    Next Cntr1
    If DeletePropIDsCNTR > 0 Then
        ExistingGadget = RecallByID(GadgetToWriteID, "from " & MemPoolName)
    End If
    ' now we need to save all the properties in the to write from one
    For Cntr1 = 1 To GadgetToWriteFrom.TotalProperties
        UpdateNeeded = False
        AddThisProp = False
        For CNTR2 = 1 To ExistingGadget.TotalProperties
            If (GadgetToWriteFrom.Propity(Cntr1) = ExistingGadget.Propity(CNTR2)) Then
                Exit For
            End If
        Next CNTR2

        Select Case True
            Case ExistingGadget.TotalProperties = 0
                UpdateNeeded = True
                PropsRS.AddNew
            Case (GadgetToWriteFrom.Propity(Cntr1) <> ExistingGadget.Propity(CNTR2))
                ' needs added
                UpdateNeeded = True
                PropsRS.AddNew
                
            Case (GadgetToWriteFrom.Propity(Cntr1) = ExistingGadget.Propity(CNTR2))
                ' they have the same property
                ' simply update if necessary
                If PropsRS.NoMatch = False Then
                    If UCase(GadgetToWriteFrom.ValueAlpha(Cntr1)) <> UCase(ExistingGadget.ValueAlpha(CNTR2)) Then
                        UpdateNeeded = True
                    End If
                    If UCase(GadgetToWriteFrom.Propity(Cntr1)) <> UCase(ExistingGadget.Propity(CNTR2)) Then
                        UpdateNeeded = True
                    End If
                    If UCase(GadgetToWriteFrom.PropSource(Cntr1)) <> UCase(ExistingGadget.PropSource(CNTR2)) Then
                        UpdateNeeded = True
                    End If
                    If (GadgetToWriteFrom.PropType(Cntr1) <> ExistingGadget.PropType(CNTR2)) Then
                        UpdateNeeded = True
                    End If
                    If UpdateNeeded Then
                        PropsRS.Index = "PropertyID"
                        PropsRS.Seek "=", ExistingGadget.PropertyID(CNTR2)
                        If (PropsRS.NoMatch = True) Or PropsRS!Property <> GadgetToWriteFrom.Propity(Cntr1) Then
                            Result = "Error Locating Existing (Disk) Object's Property: " & ExistingGadget.Propity(Cntr1)
                            GoTo EndSub
                        End If
                        PropsRS.Edit
                    End If
                End If
        End Select
                If UpdateNeeded Then
                    SavedPropIDsPTR = SavedPropIDsPTR + 1
                    SavedPropIDs(SavedPropIDsPTR) = PropsRS!PropertyID
                    PropsRS!ObjectID = GadgetToWriteFrom.ObjectID
                    PropsRS!Property = GadgetToWriteFrom.Propity(Cntr1)
                    'PropsRS!Caption = GadgetToWriteFrom.Caption(Cntr1)
                    PropsRS!ValueAlpha = GadgetToWriteFrom.ValueAlpha(Cntr1)
                    If Len(GadgetToWriteFrom.ValueAlpha(Cntr1)) > PropsRS!ValueAlpha.Size Then
                        SetProperty Trace, NextID("trace") & "Write Error", GadgetToWriteFrom.Propity(Cntr1) & " Value Too Long: " & GadgetToWriteFrom.ValueAlpha(Cntr1)
                        SetProperty VGBErrors, NextID("error") & "Write Error", GadgetToWriteFrom.Propity(Cntr1) & " Value Too Long: " & GadgetToWriteFrom.ValueAlpha(Cntr1)
                    End If
                    PropsRS!ValueNum = GadgetToWriteFrom.ValueNum(Cntr1)
                    PropsRS!PropSource = GadgetToWriteFrom.PropSource(Cntr1)
                    PropsRS!PropType = GadgetToWriteFrom.PropType(Cntr1)
                    LocalError = ""
                '   starttime = Timer
                    PropsRS.Update
                '   MsgBox "Added: " & AddThisProp & CrLf & Timer - starttime, , "One prop update"
                    If LocalError <> "" Then
                        ' got an error on update
                        SetProperty VGBErrors, NextID("error") & "Trapped WriteMemGadget Error", "Field: " & GadgetToWriteFrom.Propity(Cntr1) & "/" & GadgetToWriteFrom.ValueAlpha(Cntr1)
                    End If
                End If
    Next Cntr1  'existinggadget
    If DeletePropIDsCNTR > 0 Then
        ' we deleted some properties
    End If
    
    If SavedPropIDsPTR = GadgetToWriteFrom.TotalProperties Then
        GoTo EndSub
    End If
    
    GoTo SkipOldPropsCode
    
    
    
    
    MemPropsRS.MoveFirst
    ' these are in valuealpha order
    Do While MemPropsRS.EOF = False
        For Cntr1 = 1 To GadgetToWriteFrom.TotalProperties
        
        Next
    
        MemPropsRS.MoveNext
    Loop
    
    
    
    GoTo SkipOldPropsCode
    
    
    
    
    
'    DoEvents '!!!! questionable sanity, 12/31/98
    LocalError = ""
    PropsRS.Index = "ObjectID"
    PropertyNDX = 0
    ' we need to delete any properties not in current object
    PropsRS.Seek "=", GadgetToWriteID
    Do Until PropsRS!ObjectID <> GadgetToWriteID
        For Cntr1 = 1 To GadgetToWriteFrom.TotalProperties
            If UCase(GadgetToWriteFrom.Propity(Cntr1)) = UCase(PropsRS!Property) Then
                Exit For
            End If
            If Cntr1 > GadgetToWriteFrom.TotalProperties Then
                ' delete this property from disk
                PropsRS.Delete
            End If
        Next
        PropsRS.MoveNext
        If PropsRS.EOF Then
            Exit Do
        End If
    Loop
    
'    starttime = Timer
    For PropertyNDX = 1 To GadgetToWriteFrom.TotalProperties
        ' start at first property for this Gadget
        GadgetWorkspace.BeginTrans
        UpdateNeeded = False
        LocalError = ""
        PropsRS.Seek "=", GadgetToWriteID
        If PropsRS.NoMatch = True Then
            AddThisProp = True
        Else
            AddThisProp = False
            Do
                Select Case True
                    Case UCase(GadgetToWriteFrom.Propity(PropertyNDX)) = "IS" Or _
                         UCase(GadgetToWriteFrom.Propity(PropertyNDX)) = "DOES"
                        ' special case of is
                        ' need to see if this is a new one
                        If (PropsRS!ObjectID = GadgetToWriteFrom.ObjectID) And _
                           (PropsRS!Property = GadgetToWriteFrom.Propity(PropertyNDX)) Then
                            ' this is the same property
                            If PropsRS!ValueAlpha = GadgetToWriteFrom.ValueAlpha(PropertyNDX) Then
                                UpdateNeeded = False
                            Else
                                ' need to see if there is another like this with same value
                                For CNTR2 = 1 To GadgetToWriteFrom.TotalProperties
                                    If (GadgetToWriteFrom.Propity(CNTR2) = GadgetToWriteFrom.Propity(PropertyNDX)) And _
                                       GadgetToWriteFrom.ValueAlpha(CNTR2) = GadgetToWriteFrom.ValueAlpha(PropertyNDX) Then
                                        Exit For
                                    End If
                                Next
                                If CNTR2 > GadgetToWriteFrom.TotalProperties Then
                                    ' need to add this property if it is not already a property
                                    TempPropBookmark = PropsRS.Bookmark
                                    PropsRS.Seek "=", GadgetToWriteID
                                    Do While PropsRS.NoMatch = False
                                        If (PropsRS!ObjectID = GadgetToWriteFrom.ObjectID) And _
                                           (PropsRS!Property = GadgetToWriteFrom.Propity(PropertyNDX)) Then
                                            If PropsRS!ValueAlpha = GadgetToWriteFrom.ValueAlpha(PropertyNDX) Then
                                                UpdateNeeded = False
                                                TempPropBookmark = PropsRS.Bookmark
                                                Exit Do
                                            End If
                                        End If
                                        PropsRS.MoveNext
                                        If PropsRS.EOF Then
                                            AddThisProp = True
                                            TempPropBookmark = PropsRS.Bookmark
                                            Exit Do
                                        End If
                                        If PropsRS!ObjectID <> GadgetToWriteID Then
                                            AddThisProp = True
                                            TempPropBookmark = PropsRS.Bookmark
                                            Exit Do
                                        End If
                                    Loop
                                End If
                            End If
                        End If
                    Case Else
                        If (PropsRS!ObjectID = GadgetToWriteFrom.ObjectID) And _
                           ((UCase(PropsRS!Property)) = UCase(GadgetToWriteFrom.Propity(PropertyNDX))) Then
                    
                            If UCase(PropsRS!ValueAlpha) = UCase(GadgetToWriteFrom.ValueAlpha(PropertyNDX)) Then
                                UpdateNeeded = False
                            Else
                                PropsRS.Edit
                                UpdateNeeded = True
                            End If
                            Exit Do
                        End If
                End Select
                PropsRS.MoveNext
                If PropsRS.EOF Then
                    AddThisProp = True
                    Exit Do
                End If
                If PropsRS!ObjectID <> GadgetToWriteFrom.ObjectID Then
                    AddThisProp = True
                    Exit Do
                End If
            Loop
        End If
        If AddThisProp = True Then
            UpdateNeeded = True
            PropsRS.AddNew
        End If
        LocalError = ""
        If UpdateNeeded Then
            PropsRS!ObjectID = GadgetToWriteFrom.ObjectID
            PropsRS!Property = GadgetToWriteFrom.Propity(PropertyNDX)
            'PropsRS!Caption = GadgetToWriteFrom.Caption(PropertyNDX)
            PropsRS!ValueAlpha = GadgetToWriteFrom.ValueAlpha(PropertyNDX)
            If Len(GadgetToWriteFrom.ValueAlpha(PropertyNDX)) > PropsRS!ValueAlpha.Size Then
                SetProperty Trace, NextID("trace") & "Write Error", GadgetToWriteFrom.Propity(PropertyNDX) & " Value Too Long: " & GadgetToWriteFrom.ValueAlpha(PropertyNDX)
                SetProperty VGBErrors, NextID("error") & "Write Error", GadgetToWriteFrom.Propity(PropertyNDX) & " Value Too Long: " & GadgetToWriteFrom.ValueAlpha(PropertyNDX)
            End If
            PropsRS!ValueNum = GadgetToWriteFrom.ValueNum(PropertyNDX)
            PropsRS!PropSource = GadgetToWriteFrom.PropSource(PropertyNDX)
            PropsRS!PropType = GadgetToWriteFrom.PropType(PropertyNDX)
            LocalError = ""
    '        starttime = Timer
            PropsRS.Update
    '        MsgBox "Added: " & AddThisProp & CrLf & Timer - starttime, , "One prop update"
            If LocalError <> "" Then
                ' got an error on update
                SetProperty VGBErrors, NextID("error") & "Trapped WriteMemGadget Error", "Field: " & GadgetToWriteFrom.Propity(PropertyNDX) & "/" & GadgetToWriteFrom.ValueAlpha(PropertyNDX)
                Cntr1 = 0
                Do While Cntr1 <= 50
'                    DoEvents
                    If Cntr1 = 50 Then
                        GlobalErrorsCNTR = GlobalErrorsCNTR + 1
                        ReDim Preserve GlobalErrors(GlobalErrorsCNTR)
                        GlobalErrors(GlobalErrorsCNTR) = BlankObject
                        GlobalErrors(GlobalErrorsCNTR).Name = UCase(App.EXEName) & ": Write Memory Gadget Error"
                        GlobalErrors(GlobalErrorsCNTR).Type = "Error"
                        GlobalErrors(GlobalErrorsCNTR).Container = "Error"
                        GlobalErrors(GlobalErrorsCNTR).Tag = CStr(Now())
    '                   t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Writing", GadgetToWriteFrom.Name & "/" & CStr(GadgetToWriteFrom.ObjectID) & "/" & PropsRS!Property)
                        t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "App", UCase(App.EXEName))
                        t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Error Occurred", "Property Update: " & GadgetToWriteFrom.Name & "/" & CStr(GadgetToWriteFrom.ObjectID) & "/" & PropsRS!Property)
                        t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Error Date", CStr(Now()))
                        t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Error", LocalError)
                        t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Retry Counter", CStr(Cntr1))
                    Else
                        t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Retry Counter", CStr(Cntr1))
                    End If
                    LocalError = ""
                    WasteTime 0.1
                    PropsRS.Update
                    If LocalError = "" Then
                        Exit Do
                    End If
                    GDSFreelocks
                    If Cntr1 Mod 20 = 0 Then
'                        DoEvents
                    End If
                    Cntr1 = Cntr1 + 1
                Loop
            End If
        End If
        GadgetWorkspace.CommitTrans
        GDSFreelocks
    Next
SkipOldPropsCode:
    GoTo EndSub
LocalError:
    LocalError = Error
    If (InStr(UCase(LocalError), "YOU TRIED") = 0) And (InStr(UCase(LocalError), "SUBSCRIPT OUT") = 0) And (InStr(UCase(LocalError), "NO CURRENT RECORD") = 0) Then
        SetProperty VGBErrors, NextID("error") & "Trapped WriteMemGadget Error Start ", CStr(WriteCNTR) & " ///////////////"
        SetProperty Trace, NextID("trace") & "Trapped WriteMemGadget Error: ", GadgetToWriteFrom.Name & "/" & LocalError
        SetProperty VGBErrors, NextID("error") & "Trapped WriteMemGadget Error: ", GadgetToWriteFrom.Name & "/" & LocalError
        SetProperty VGBErrors, NextID("error") & "WriteMemGadget", GadgetToWriteFrom.Name & " (L=" & Msg & ")" & " / Type: " & GadgetToWriteFrom.Type & " / ID: " & CStr(GadgetToWriteFrom.ObjectID)
        SetProperty VGBErrors, NextID("error") & "WriteMemGadget", "Writing [" & GadgetToWriteFrom.Name & "] to DB: " & DBGadgets(DBGadgetsPTR).Name
        SetProperty VGBErrors, NextID("error") & "Trapped WriteMemGadget Error End ", CStr(WriteCNTR) & " ///////////////"
    End If
    Resume Next
EndSub:
 
    If (ObjectsRS.EditMode <> dbEditNone) Or (PropsRS.EditMode <> dbEditNone) Then
'        FloatMsgBox "Recordset is Still in editmode", UCase(App.EXEName) & " Debug Message"
        SetProperty Trace, NextID("trace") & "NT WriteMemGadget Error", "A Recordset is Still in EditMode: ObjectsRS: " & CStr(ObjectsRS.EditMode) & "PropsRS: " & CStr(PropsRS.EditMode)
    End If
    LocalError = ""
    Do While LocalError = ""
        GadgetWorkspace.CommitTrans
    Loop
    If LocalError = "" Then
 '       GlobalErrorsCNTR = GlobalErrorsCNTR + 1
 '       ReDim Preserve GlobalErrors(GlobalErrorsCNTR)
 '       GlobalErrors(GlobalErrorsCNTR) = BlankObject
 '       GlobalErrors(GlobalErrorsCNTR).Name = UCase(App.EXEName) & ": CommitTrans still open - " & Now
 '       GlobalErrors(GlobalErrorsCNTR).Type = "Error"
 '       GlobalErrors(GlobalErrorsCNTR).Container = "Error"
 '       GlobalErrors(GlobalErrorsCNTR).Tag = CStr(Now())
 '   '    t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Writing", GadgetToWriteFrom.Name & "/" & CStr(GadgetToWriteFrom.ObjectID))
 '       t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "App", UCase(App.EXEName))
 '       t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Error Occurred", "Gadget Update: " & GadgetToWriteFrom.Name & "/" & CStr(GadgetToWriteFrom.ObjectID))
 '       t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Error Date", CStr(Now()))
 '       t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Error", "CommitTrans still open")
    End If

    If StartKey <> "" Then
        ObjectsRS.Index = StartKey
        ObjectsRS.Bookmark = StartBookMark
        PropsRS.Index = StartPropKey
        PropsRS.Bookmark = StartPropBookmark
    End If
    
    WriteMemGadget = Result
    GDSFreelocks
    On Error GoTo 0
    stoptime = Timer
'    GadgetWorkspace.Refresh
'    If GadgetToWriteFrom.TotalProperties > 3000 Then
'        MsgBox stoptime - starttime & CrLf & GadgetToWriteFrom.TotalProperties, , "Memory Object Write"
'    End If
    SetProperty Trace, NextID("trace") & "WriteMemGadget Time", CStr(Timer - starttime)
End Function
Friend Function WriteMemGadgetOLD(GadgetToWriteID As Long, GadgetToWriteFrom As Gadget) As String
    ' This one will write the Gadgettowrite from Gadget to disk as GadgetToWriteID
    ' if GadgetToWriteID doesn't exist, a new is created
    ' added the deletion of properties from disk that do not exist in the gadgettowrite
    Static WriteCNTR As Long
    WriteCNTR = WriteCNTR + 1
    Dim t, Msg As String, PropertyNDX As Long, Cntr1 As Integer, CNTR2 As Integer
    Dim Crit As String
    Dim ShowedOnce As Boolean
    Dim LGadget As Gadget
    Dim starttime As Single
    starttime = Timer
    Dim Result As String
    Dim WriteGadget As Boolean
    Dim GadgetAdded As Boolean
    Dim GadgetsStartRec As String, ResetGadgets As Boolean
    Dim PropsStartRec As String, ResetProps As Boolean
    Dim UpdateNeeded As Boolean
    Dim AddThisProp As Boolean
    Dim LocalError As String
    Dim StartBookMark As String, StartKey As String
    Dim StartPropBookmark As String, StartPropKey As String
    Dim TempPropBookmark As String, TempPropKey As String
    ' Dim TempRS As Recordset
    LocalError = ""
'    GadgetWorkspace.Refresh
    On Error GoTo LocalError
    Msg = CStr(Len(GadgetToWriteFrom.Name))
    SetProperty Trace, NextID("trace") & "WriteMemGadget", GadgetToWriteFrom.Name & " (L=" & Msg & ")" & " / Type: " & GadgetToWriteFrom.Type & " / ID: " & CStr(GadgetToWriteFrom.ObjectID)
    SetProperty Trace, NextID("trace") & "WriteMemGadget", "Writing [" & GadgetToWriteFrom.Name & "] to DB: " & DBGadgets(DBGadgetsPTR).Name
    WriteGadget = False
    ShowedOnce = False
    Result = "OK"
    GadgetAdded = False
    ' take care of null values in fields
    If Len(GadgetToWriteFrom.Type) = 0 Then
        GadgetToWriteFrom.Type = "None"
    End If
    
    If Len(GadgetToWriteFrom.GAppName) = 0 Then
        GadgetToWriteFrom.GAppName = UCase(App.EXEName)
    End If
    
    If Len(GadgetToWriteFrom.Container) = 0 Then
        GadgetToWriteFrom.Container = "None"
    End If
    
    If Len(GadgetToWriteFrom.Tag) = 0 Then
        ' not required
        GadgetToWriteFrom.Tag = 0
    End If
    
    If Len(GadgetToWriteFrom.Level) = 0 Then
        GadgetToWriteFrom.Level = 0
    End If
    
    If ObjectsRS.RecordCount = 0 Then
        ' creating a new Gadget in empty db
        If LocalError <> "" Then
            SetProperty Trace, NextID("trace") & "WriteMemGadget NOT an Error", "Checking Reccount: " & LocalError
        End If
        GadgetAdded = True
        WriteGadget = True
        GoTo WriteNow
    End If
    If LocalError = "" Then
        StartBookMark = ObjectsRS.Bookmark
        StartKey = ObjectsRS.Index
        StartPropBookmark = PropsRS.Bookmark
        StartPropKey = PropsRS.Index
        If LocalError <> "" Then
            SetProperty Trace, NextID("trace") & "WriteMemGadget NOT an Error", "setting Start Positions: " & LocalError
        End If
    End If
    ObjectsRS.Index = "PrimaryKey"
    ObjectsRS.Seek "=", GadgetToWriteID
    If ObjectsRS.NoMatch = True Then
        ' creating a new Gadget
        GadgetAdded = True
        WriteGadget = True
        GoTo WriteNow
    Else
        ' writing a Gadget that exists
        ' see if the objectid's are ok
        If UCase(GadgetToWriteFrom.Name) = UCase(ObjectsRS!Name) Then
            If (GadgetToWriteID > 0) And (GadgetToWriteFrom.ObjectID <> ObjectsRS!ObjectID) Then
                ' got us a situation here
                SetProperty Trace, NextID("trace") & "WriteMemGadget ERROR", "Passed ID: " & CStr(GadgetToWriteFrom.ObjectID) & "Disk ID: " & CStr(ObjectsRS!ObjectID)
'                LGadget = BlankObject
'                LGadget.Name = "WMO Error @ " & Format(Now, "mm/dd/yyyy") & Format(Now, "Long Time")
'                LGadget.Type = "GDS Error"
'                LGadget.Container = "WriteMemGadget"
'                t = SetProperty(LGadget, "From Name", GadgetToWriteFrom.Name)
'                t = SetProperty(LGadget, "From ID ", CStr(GadgetToWriteFrom.ObjectID))
'                t = SetProperty(LGadget, "To Name", ObjectsRS!Name)
'                t = SetProperty(LGadget, "To ID", CStr(ObjectsRS!ObjectID))
'                t = SetProperty(LGadget, "Action", "Aborted Write")
'                t = WriteMemGadget(0, LGadget)
''                If Not ExecutingSchedule Then
''                    ShowGadget LGadget
''                End If
                Result = "Error: GadgetIDs Goof"
'                GadgetWorkspace.CommitTrans
                GoTo EndSub
            End If
        End If
'        ObjectsRS.Edit
    End If
    ' do we really need to write the Gadget to the object table?
    LocalError = ""
    Select Case True
        Case WriteGadget = True
        Case ObjectsRS![Name] <> GadgetToWriteFrom.Name
            WriteGadget = True
        Case ObjectsRS![Type] <> GadgetToWriteFrom.Type
            WriteGadget = True
        Case ObjectsRS![Container] <> GadgetToWriteFrom.Container
            WriteGadget = True
        Case ObjectsRS![Level] <> GadgetToWriteFrom.Level
            WriteGadget = True
        Case ObjectsRS![GAppName] <> UCase(App.EXEName)
            WriteGadget = True
        Case ObjectsRS![Tag] <> GadgetToWriteFrom.Tag
            If IsNull(ObjectsRS![Tag]) Then
                If GadgetToWriteFrom.Tag <> "" Then
                    WriteGadget = True
                End If
            Else
                If ObjectsRS![Tag] <> GadgetToWriteFrom.Tag Then
                    WriteGadget = True
                End If
            End If
    End Select
    If LocalError <> "" Then
        SetProperty Trace, NextID("trace") & "WriteMemGadget Check if Write Error", LocalError
    End If
    
    LocalError = ""
    If WriteGadget = False Then
        GoTo SkipWriteGadget
    End If
    ' we need to write the Gadget for some reason
    
WriteNow:
    GadgetWorkspace.BeginTrans
    If GadgetAdded = True Then
        ObjectsRS.AddNew
    Else
        ObjectsRS.Edit
    End If
    ' let's set the fields
    LocalError = ""
    ObjectsRS![Name] = GadgetToWriteFrom.Name
    If LocalError <> "" Then
        SetProperty Trace, NextID("trace") & "WriteMemGadget Name Error", LocalError
    End If

    LocalError = ""
    ObjectsRS![Type] = GadgetToWriteFrom.Type
    If LocalError <> "" Then
        SetProperty Trace, NextID("trace") & "WriteMemGadget Type Error", LocalError
    End If
    
    LocalError = ""
    ObjectsRS![GAppName] = GadgetToWriteFrom.GAppName
    If LocalError <> "" Then
        SetProperty Trace, NextID("trace") & "WriteMemGadget GAppName Error", LocalError
    End If
    
    LocalError = ""
    ObjectsRS![Container] = GadgetToWriteFrom.Container
    If LocalError <> "" Then
        SetProperty Trace, NextID("trace") & "WriteMemGadget Container Error", LocalError
    End If
    
    LocalError = ""
    ObjectsRS![Tag] = GadgetToWriteFrom.Tag
    If LocalError <> "" Then
        SetProperty Trace, NextID("trace") & "WriteMemGadget Tag Error", LocalError
    End If
    
    LocalError = ""
    ObjectsRS![Level] = GadgetToWriteFrom.Level
    If LocalError <> "" Then
        SetProperty Trace, NextID("trace") & "WriteMemGadget Level Error", LocalError
    End If
    
    LocalError = ""
    ObjectsRS.Update
'    MsgBox Timer - starttime, , "Memory Gadget Write"
'    starttime = Timer
    If LocalError <> "" Then
        If LocalError = "Disk I/O error during read." Then
            ' error number 3040, trappable data access errors off of trappable errors in help
            ErrorCNTR = ErrorCNTR + 1
            ReDim Preserve ErrorObjects(ErrorCNTR)
            Msg = ""
            ErrorObjects(ErrorCNTR) = BlankObject
            ErrorObjects(ErrorCNTR).Name = "Error Gadget: " & CStr(Date) & " @ " & CStr(Time)
            ErrorObjects(ErrorCNTR).Type = "Error"
            ErrorObjects(ErrorCNTR).Container = "ObjectsRS"
            ErrorObjects(ErrorCNTR).Tag = "Not Logged"
            t = SetProperty(ErrorObjects(ErrorCNTR), "App ExeName", UCase(App.EXEName))
            t = SetProperty(ErrorObjects(ErrorCNTR), "Error", LocalError)
            t = SetProperty(ErrorObjects(ErrorCNTR), "AppGadget", AppGadgets(AppGadgetsPTR).Name)
            t = SetProperty(ErrorObjects(ErrorCNTR), "DB", DBGadgets(DBGadgetsPTR).Name)
'            WriteErrorLog
        End If
    End If
    If LocalError <> "" Then
        Cntr1 = 0
        Do While Cntr1 <= 50
'            DoEvents
            If Cntr1 = 50 Then
                GlobalErrorsCNTR = GlobalErrorsCNTR + 1
                ReDim Preserve GlobalErrors(GlobalErrorsCNTR)
                GlobalErrors(GlobalErrorsCNTR) = BlankObject
                GlobalErrors(GlobalErrorsCNTR).Name = UCase(App.EXEName) & ": Write Memory Gadget Error"
                GlobalErrors(GlobalErrorsCNTR).Type = "Error"
                GlobalErrors(GlobalErrorsCNTR).Container = "Error"
                GlobalErrors(GlobalErrorsCNTR).Tag = CStr(Now())
    '            t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Writing", GadgetToWriteFrom.Name & "/" & CStr(GadgetToWriteFrom.ObjectID))
                t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "App", UCase(App.EXEName))
                t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Error Occurred", "Gadget Update: " & GadgetToWriteFrom.Name & "/" & CStr(GadgetToWriteFrom.ObjectID))
                t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Error Date", CStr(Now()))
                t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Error", LocalError)
                t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Retry Counter", CStr(Cntr1))
            Else
'                t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Retry Counter", CStr(Cntr1))
            End If
            LocalError = ""
            WasteTime 0.1
            ObjectsRS.Update
            If LocalError = "" Then
                Exit Do
            End If
            GDSFreelocks
            If Cntr1 Mod 20 = 0 Then
'                DoEvents
            End If
            Cntr1 = Cntr1 + 1
        Loop
    End If
    If InStr(UCase(LocalError), "LOCKED") > 0 Then
        
'        FloatMsgBox "Write Memory Gadget: Lock Error", "Error Writing Gadget"
    End If
    ObjectsRS.Bookmark = ObjectsRS.LastModified
    GadgetToWriteFrom.ObjectID = ObjectsRS![ObjectID]
    
    GadgetWorkspace.CommitTrans
    GDSFreelocks
SkipWriteGadget:
'    DoEvents '!!!! questionable sanity, 12/31/98
    LocalError = ""
    PropsRS.Index = "ObjectID"
    PropertyNDX = 0
    ' we need to delete any properties not in current object
    PropsRS.Seek "=", GadgetToWriteID
    Do Until PropsRS!ObjectID <> GadgetToWriteID
        For Cntr1 = 1 To GadgetToWriteFrom.TotalProperties
            If UCase(GadgetToWriteFrom.Propity(Cntr1)) = UCase(PropsRS!Property) Then
                Exit For
            End If
            If Cntr1 > GadgetToWriteFrom.TotalProperties Then
                ' delete this property from disk
                PropsRS.Delete
            End If
        Next
        PropsRS.MoveNext
        If PropsRS.EOF Then
            Exit Do
        End If
    Loop
'    starttime = Timer
    For PropertyNDX = 1 To GadgetToWriteFrom.TotalProperties
        ' start at first property for this Gadget
        GadgetWorkspace.BeginTrans
        UpdateNeeded = False
        LocalError = ""
        PropsRS.Seek "=", GadgetToWriteID
        If PropsRS.NoMatch = True Then
            AddThisProp = True
        Else
            AddThisProp = False
            Do
                Select Case True
                    Case UCase(GadgetToWriteFrom.Propity(PropertyNDX)) = "IS" Or _
                         UCase(GadgetToWriteFrom.Propity(PropertyNDX)) = "DOES"
                        ' special case of is
                        ' need to see if this is a new one
                        If (PropsRS!ObjectID = GadgetToWriteFrom.ObjectID) And _
                           (PropsRS!Property = GadgetToWriteFrom.Propity(PropertyNDX)) Then
                            ' this is the same property
                            If PropsRS!ValueAlpha = GadgetToWriteFrom.ValueAlpha(PropertyNDX) Then
                                UpdateNeeded = False
                            Else
                                ' need to see if there is another like this with same value
                                For CNTR2 = 1 To GadgetToWriteFrom.TotalProperties
                                    If (GadgetToWriteFrom.Propity(CNTR2) = GadgetToWriteFrom.Propity(PropertyNDX)) And _
                                       GadgetToWriteFrom.ValueAlpha(CNTR2) = GadgetToWriteFrom.ValueAlpha(PropertyNDX) Then
                                        Exit For
                                    End If
                                Next
                                If CNTR2 > GadgetToWriteFrom.TotalProperties Then
                                    ' need to add this property if it is not already a property
                                    TempPropBookmark = PropsRS.Bookmark
                                    PropsRS.Seek "=", GadgetToWriteID
                                    Do While PropsRS.NoMatch = False
                                        If (PropsRS!ObjectID = GadgetToWriteFrom.ObjectID) And _
                                           (PropsRS!Property = GadgetToWriteFrom.Propity(PropertyNDX)) Then
                                            If PropsRS!ValueAlpha = GadgetToWriteFrom.ValueAlpha(PropertyNDX) Then
                                                UpdateNeeded = False
                                                TempPropBookmark = PropsRS.Bookmark
                                                Exit Do
                                            End If
                                        End If
                                        PropsRS.MoveNext
                                        If PropsRS.EOF Then
                                            AddThisProp = True
                                            TempPropBookmark = PropsRS.Bookmark
                                            Exit Do
                                        End If
                                        If PropsRS!ObjectID <> GadgetToWriteID Then
                                            AddThisProp = True
                                            TempPropBookmark = PropsRS.Bookmark
                                            Exit Do
                                        End If
                                    Loop
                                End If
                            End If
                        End If
                    Case Else
                        If (PropsRS!ObjectID = GadgetToWriteFrom.ObjectID) And _
                           ((UCase(PropsRS!Property)) = UCase(GadgetToWriteFrom.Propity(PropertyNDX))) Then
                    
                            If UCase(PropsRS!ValueAlpha) = UCase(GadgetToWriteFrom.ValueAlpha(PropertyNDX)) Then
                                UpdateNeeded = False
                            Else
                                PropsRS.Edit
                                UpdateNeeded = True
                            End If
                            Exit Do
                        End If
                End Select
                PropsRS.MoveNext
                If PropsRS.EOF Then
                    AddThisProp = True
                    Exit Do
                End If
                If PropsRS!ObjectID <> GadgetToWriteFrom.ObjectID Then
                    AddThisProp = True
                    Exit Do
                End If
            Loop
        End If
        If AddThisProp = True Then
            UpdateNeeded = True
            PropsRS.AddNew
        End If
        LocalError = ""
        If UpdateNeeded Then
            PropsRS!ObjectID = GadgetToWriteFrom.ObjectID
            PropsRS!Property = GadgetToWriteFrom.Propity(PropertyNDX)
            'PropsRS!Caption = GadgetToWriteFrom.Caption(PropertyNDX)
            PropsRS!ValueAlpha = GadgetToWriteFrom.ValueAlpha(PropertyNDX)
            If Len(GadgetToWriteFrom.ValueAlpha(PropertyNDX)) > PropsRS!ValueAlpha.Size Then
                SetProperty Trace, NextID("trace") & "Write Error", GadgetToWriteFrom.Propity(PropertyNDX) & " Value Too Long: " & GadgetToWriteFrom.ValueAlpha(PropertyNDX)
                SetProperty VGBErrors, NextID("error") & "Write Error", GadgetToWriteFrom.Propity(PropertyNDX) & " Value Too Long: " & GadgetToWriteFrom.ValueAlpha(PropertyNDX)
            End If
            PropsRS!ValueNum = GadgetToWriteFrom.ValueNum(PropertyNDX)
            PropsRS!PropSource = GadgetToWriteFrom.PropSource(PropertyNDX)
            PropsRS!PropType = GadgetToWriteFrom.PropType(PropertyNDX)
            LocalError = ""
    '        starttime = Timer
            PropsRS.Update
    '        MsgBox "Added: " & AddThisProp & CrLf & Timer - starttime, , "One prop update"
            If LocalError <> "" Then
                ' got an error on update
                SetProperty VGBErrors, NextID("error") & "Trapped WriteMemGadget Error", "Field: " & GadgetToWriteFrom.Propity(PropertyNDX) & "/" & GadgetToWriteFrom.ValueAlpha(PropertyNDX)
                Cntr1 = 0
                Do While Cntr1 <= 50
'                    DoEvents
                    If Cntr1 = 50 Then
                        GlobalErrorsCNTR = GlobalErrorsCNTR + 1
                        ReDim Preserve GlobalErrors(GlobalErrorsCNTR)
                        GlobalErrors(GlobalErrorsCNTR) = BlankObject
                        GlobalErrors(GlobalErrorsCNTR).Name = UCase(App.EXEName) & ": Write Memory Gadget Error"
                        GlobalErrors(GlobalErrorsCNTR).Type = "Error"
                        GlobalErrors(GlobalErrorsCNTR).Container = "Error"
                        GlobalErrors(GlobalErrorsCNTR).Tag = CStr(Now())
    '                   t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Writing", GadgetToWriteFrom.Name & "/" & CStr(GadgetToWriteFrom.ObjectID) & "/" & PropsRS!Property)
                        t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "App", UCase(App.EXEName))
                        t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Error Occurred", "Property Update: " & GadgetToWriteFrom.Name & "/" & CStr(GadgetToWriteFrom.ObjectID) & "/" & PropsRS!Property)
                        t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Error Date", CStr(Now()))
                        t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Error", LocalError)
                        t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Retry Counter", CStr(Cntr1))
                    Else
                        t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Retry Counter", CStr(Cntr1))
                    End If
                    LocalError = ""
                    WasteTime 0.1
                    PropsRS.Update
                    If LocalError = "" Then
                        Exit Do
                    End If
                    GDSFreelocks
                    If Cntr1 Mod 20 = 0 Then
'                        DoEvents
                    End If
                    Cntr1 = Cntr1 + 1
                Loop
            End If
        End If
        GadgetWorkspace.CommitTrans
        GDSFreelocks
    Next
    GoTo EndSub
LocalError:
    LocalError = Error
    If (InStr(UCase(LocalError), "YOU TRIED") = 0) And (InStr(UCase(LocalError), "SUBSCRIPT OUT") = 0) And (InStr(UCase(LocalError), "NO CURRENT RECORD") = 0) Then
        SetProperty VGBErrors, NextID("error") & "Trapped WriteMemGadget Error Start ", CStr(WriteCNTR) & " ///////////////"
        SetProperty Trace, NextID("trace") & "Trapped WriteMemGadget Error: ", GadgetToWriteFrom.Name & "/" & LocalError
        SetProperty VGBErrors, NextID("error") & "Trapped WriteMemGadget Error: ", GadgetToWriteFrom.Name & "/" & LocalError
        SetProperty VGBErrors, NextID("error") & "WriteMemGadget", GadgetToWriteFrom.Name & " (L=" & Msg & ")" & " / Type: " & GadgetToWriteFrom.Type & " / ID: " & CStr(GadgetToWriteFrom.ObjectID)
        SetProperty VGBErrors, NextID("error") & "WriteMemGadget", "Writing [" & GadgetToWriteFrom.Name & "] to DB: " & DBGadgets(DBGadgetsPTR).Name
        SetProperty VGBErrors, NextID("error") & "Trapped WriteMemGadget Error End ", CStr(WriteCNTR) & " ///////////////"
    End If
    Resume Next
EndSub:
 
    If (ObjectsRS.EditMode <> dbEditNone) Or (PropsRS.EditMode <> dbEditNone) Then
'        FloatMsgBox "Recordset is Still in editmode", UCase(App.EXEName) & " Debug Message"
        SetProperty Trace, NextID("trace") & "NT WriteMemGadget Error", "A Recordset is Still in EditMode: ObjectsRS: " & CStr(ObjectsRS.EditMode) & "PropsRS: " & CStr(PropsRS.EditMode)
    End If
    LocalError = ""
    Do While LocalError = ""
        GadgetWorkspace.CommitTrans
    Loop
    If LocalError = "" Then
 '       GlobalErrorsCNTR = GlobalErrorsCNTR + 1
 '       ReDim Preserve GlobalErrors(GlobalErrorsCNTR)
 '       GlobalErrors(GlobalErrorsCNTR) = BlankObject
 '       GlobalErrors(GlobalErrorsCNTR).Name = UCase(App.EXEName) & ": CommitTrans still open - " & Now
 '       GlobalErrors(GlobalErrorsCNTR).Type = "Error"
 '       GlobalErrors(GlobalErrorsCNTR).Container = "Error"
 '       GlobalErrors(GlobalErrorsCNTR).Tag = CStr(Now())
 '   '    t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Writing", GadgetToWriteFrom.Name & "/" & CStr(GadgetToWriteFrom.ObjectID))
 '       t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "App", UCase(App.EXEName))
 '       t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Error Occurred", "Gadget Update: " & GadgetToWriteFrom.Name & "/" & CStr(GadgetToWriteFrom.ObjectID))
 '       t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Error Date", CStr(Now()))
 '       t = SetProperty(GlobalErrors(GlobalErrorsCNTR), "Error", "CommitTrans still open")
    End If

    If StartKey <> "" Then
        ObjectsRS.Index = StartKey
        ObjectsRS.Bookmark = StartBookMark
        PropsRS.Index = StartPropKey
        PropsRS.Bookmark = StartPropBookmark
    End If
    
    WriteMemGadgetOLD = Result
    GDSFreelocks
    On Error GoTo 0
'    GadgetWorkspace.Refresh
'    MsgBox Timer - starttime, , "Memory Object Write"
    SetProperty Trace, NextID("trace") & "WriteMemGadget Time", CStr(Timer - starttime)
End Function


Friend Function GODLoadObjectChildren(RO As Long)
    ' This will load all the given object's chilren object names into loadedchildren() array
    ' and pass it back to caller
    ' note, this routine DOES NOT CLEAR passed array!  It appends items to end.
    ' also, the passed name goes into first available element
    Dim t, TempObject As Gadget, Result As String
    Dim ChildrenNDX As Integer, px As Integer, py As Integer
    If CurrentObject.ObjectID <> RO Then
        t = ReadGadgetByID(RO)
        If t <> "OK" Then
            MsgBox t, , UCase(App.EXEName) & " Debug Message"
            Exit Function
        End If
        TempObject = ReadObjectBuffer
    Else
        TempObject = CurrentObject
    End If
    ' add the first one (the one that was passed
    ChildrenNDX = UBound(LoadedChildren())
    ChildrenNDX = ChildrenNDX + 1
'   Load the passed object name in next element
    ReDim Preserve LoadedChildren(ChildrenNDX)
    ReDim Preserve LoadedChildrenIDs(ChildrenNDX)
    LoadedChildren(ChildrenNDX) = TempObject.Name
    LoadedChildrenIDs(ChildrenNDX) = TempObject.ObjectID
    'load all children
    For px = 1 To TempObject.TotalProperties
        Select Case True
            Case UCase(TempObject.Propity(px)) = "CHILD"
                Dim NewObject As Long
                NewObject = Val(TempObject.ValueAlpha(px))
                t = GODLoadObjectChildren(NewObject)
        End Select
    Next
EndGLOC:
    GODLoadObjectChildren = Result
End Function
Friend Function ReadGadgetByName(ObjectToReadName As String, GORReadObjectBuffer As Gadget) As String
    ' read an object by name into passed gadget
    ' Note: reads only 1st encountered objet with this name
    ' also, if GORReadObjectBuffer has property "type" this will get that type only
    
    Dim Crit As String, t, GadgetNDX As Integer, starttime As Single, stoptime As Single
    Dim StartBookMark As String
    Dim StartKey As String
    Dim IDToRead As Long
    Dim ContainerToFind As String, TypeToFind As String
    starttime = Timer
    Dim SourceRS As Recordset, SourceMethodRS As Recordset
    Dim NewRS As String, OldPropRS As String
    Dim Result As String
    Result = OK
    ' get this, since I have provided a read by id function, all this thing has to do
    ' is look up the name, get the id and sic read object by id on it.
    ' this only gets the first object of a name, do not use if you need to get
    ' anything but the first object with the given name.
    On Error GoTo LocalError
    ContainerToFind = ReadProperty(GORReadObjectBuffer, "Container")
    If ContainerToFind = "" Then
        ContainerToFind = NotFound
    End If
    TypeToFind = ReadProperty(GORReadObjectBuffer, "Type")
    If TypeToFind = "" Then
        TypeToFind = NotFound
    End If
    
    
    StartKey = ObjectsRS.Index
    StartBookMark = ObjectsRS.Bookmark
    ObjectsRS.Index = "Name"
    ObjectsRS.Seek "=", ObjectToReadName
    If ObjectsRS.NoMatch Then
        GORReadObjectBuffer.Name = ""
        Result = "ERROR: Object read failed to locate the object named:" & ObjectToReadName
        GoTo EndGORO
    End If
    Select Case True
        Case (TypeToFind = NotFound) And (ContainerToFind = NotFound)
            ' nothing to do
        Case (TypeToFind <> NotFound) And (ContainerToFind = NotFound)
            ' find type only
            Do While ObjectsRS.NoMatch = False
                If ObjectsRS!Type = TypeToFind Then
                    Exit Do
                End If
                ObjectsRS.MoveNext
                If ObjectsRS.EOF Then
                    Result = "ERROR: Read failed to locate object: " & ObjectToReadName & " of Type: " & TypeToFind
                    Exit Do
                End If
                If ObjectsRS!Name <> ObjectToReadName Then
                    Result = "ERROR: Read failed to locate object: " & ObjectToReadName & " of Type: " & TypeToFind
                    Exit Do
                End If
            Loop
        Case (TypeToFind = NotFound) And (ContainerToFind <> NotFound)
            ' find container only
            Do While ObjectsRS.NoMatch = False
                If ObjectsRS!Container = ContainerToFind Then
                    Exit Do
                End If
                ObjectsRS.MoveNext
                If ObjectsRS.EOF Then
                    Result = "ERROR: Read failed to locate object: " & ObjectToReadName & " in container: " & ContainerToFind
                    Exit Do
                End If
                If ObjectsRS!Name <> ObjectToReadName Then
                    Result = "ERROR: Read failed to locate object: " & ObjectToReadName & " in container: " & ContainerToFind
                    Exit Do
                End If
            Loop
        Case (TypeToFind <> NotFound) And (ContainerToFind <> NotFound)
            ' find type and container
            Do While ObjectsRS.NoMatch = False
                If (ObjectsRS!Type = TypeToFind) And (ObjectsRS!Container = ContainerToFind) Then
                    Exit Do
                End If
                ObjectsRS.MoveNext
                If ObjectsRS.EOF Then
                    Result = "ERROR: Read failed to locate object: " & ObjectToReadName & " Cont: " & ContainerToFind & " Type:" & TypeToFind
                End If
                If ObjectsRS!Name <> ObjectToReadName Then
                    Result = "ERROR: Read failed to locate object: " & ObjectToReadName & " Cont: " & ContainerToFind & " Type:" & TypeToFind
                    Exit Do
                End If
            Loop
    End Select
    If Result = OK Then
        IDToRead = ObjectsRS!ObjectID
        t = ReadGadgetByID(IDToRead)
        If t = "OK" Then
            GORReadObjectBuffer = ReadObjectBuffer
        Else
            Result = t
        End If
    End If
    GoTo EndGORO:
LocalError:
    Resume Next
EndGORO:
ReadGadgetByName = Result
stoptime = Timer
ObjectsRS.Index = StartKey
ObjectsRS.Bookmark = StartBookMark
On Error GoTo 0
GDSFreelocks
'MsgBox "Time to load object: " & GORReadObjectBuffer.Name & "-" & CrLf & stoptime - starttime
End Function
Friend Function ReadDiskGadgetByName(Param As Gadget) As Gadget
    ' read an object by name into passed gadget
    ' Note: reads only 1st encountered object with this name
    ' also, if param has property "type" this will get that type only
    ' ditto for container
    Dim t, Msg As String
    Dim Crit As String, GadgetNDX As Integer, starttime As Single, stoptime As Single
    Dim ObjectToReadName As String ', ReadObjectBuffer As Gadget
    Dim ReadObjectBuffer As Gadget
    Dim StartBookMark As String
    Dim StartKey As String
    Dim IDToRead As Long
    Dim ContainerToFind As String, TypeToFind As String
    starttime = Timer
    Dim SourceRS As Recordset, SourceMethodRS As Recordset
    Dim NewRS As String, OldPropRS As String
    Dim Result As String
    ObjectToReadName = ReadProperty(Param, "Name")
    If ObjectToReadName = NotFound Then
        ObjectToReadName = Param.Name
    End If
    Result = OK
    ' get this, since I have provided a read by id function, all this thing has to do
    ' is look up the name, get the id and sic read object by id on it.
    ' this only gets the first object of a name, do not use if you need to get
    ' anything but the first object with the given name.
    On Error GoTo LocalError
    ContainerToFind = ReadProperty(Param, "Container")
    TypeToFind = ReadProperty(Param, "Type")
    StartKey = ObjectsRS.Index
    StartBookMark = ObjectsRS.Bookmark
    ObjectsRS.Index = "Name"
    ObjectsRS.Seek "=", ObjectToReadName
    If ObjectsRS.NoMatch Then
        ReadObjectBuffer.Name = NotFound
        Msg = "ERROR: Object read failed to locate the object named:" & ObjectToReadName
        t = SetProperty(ReadObjectBuffer, "Error:", Msg)
        GoTo EndSub
    End If
    Select Case True
        Case (TypeToFind = NotFound) And (ContainerToFind = NotFound)
            ' they didn't specify a container or a type
            ' nothing to do
        Case (TypeToFind <> NotFound) And (ContainerToFind = NotFound)
            ' find type only
            Do While ObjectsRS.NoMatch = False
                If ObjectsRS!Type = TypeToFind Then
                    Exit Do
                End If
                ObjectsRS.MoveNext
                If ObjectsRS.EOF Then
                    Result = "ERROR: Read failed to locate object: " & ObjectToReadName & " of Type: " & TypeToFind
                    Exit Do
                End If
                If ObjectsRS!Name <> ObjectToReadName Then
                    Result = "ERROR: Read failed to locate object: " & ObjectToReadName & " of Type: " & TypeToFind
                    Exit Do
                End If
            Loop
        Case (TypeToFind = NotFound) And (ContainerToFind <> NotFound)
            ' find container only
            Do While ObjectsRS.NoMatch = False
                If ObjectsRS!Container = ContainerToFind Then
                    Exit Do
                End If
                ObjectsRS.MoveNext
                If ObjectsRS.EOF Then
                    Result = "ERROR: Read failed to locate object: " & ObjectToReadName & " in container: " & ContainerToFind
                    Exit Do
                End If
                If ObjectsRS!Name <> ObjectToReadName Then
                    Result = "ERROR: Read failed to locate object: " & ObjectToReadName & " in container: " & ContainerToFind
                    Exit Do
                End If
            Loop
        Case (TypeToFind <> NotFound) And (ContainerToFind <> NotFound)
            ' find type and container
            Do While ObjectsRS.NoMatch = False
                If (ObjectsRS!Type = TypeToFind) And (ObjectsRS!Container = ContainerToFind) Then
                    Exit Do
                End If
                ObjectsRS.MoveNext
                If ObjectsRS.EOF Then
                    Result = "ERROR: Read failed to locate object: " & ObjectToReadName & " Cont: " & ContainerToFind & " Type:" & TypeToFind
                End If
                If ObjectsRS!Name <> ObjectToReadName Then
                    Result = "ERROR: Read failed to locate object: " & ObjectToReadName & " Cont: " & ContainerToFind & " Type:" & TypeToFind
                    Exit Do
                End If
            Loop
    End Select
    If Result = OK Then
        IDToRead = ObjectsRS!ObjectID
        ReadObjectBuffer = ReadDiskGadgetByID(IDToRead)
    End If
    GoTo EndSub:
LocalError:
    Resume Next
EndSub:
ReadDiskGadgetByName = ReadObjectBuffer
stoptime = Timer
ObjectsRS.Index = StartKey
ObjectsRS.Bookmark = StartBookMark
On Error GoTo 0
GDSFreelocks
'MsgBox "Time to load object: " & ReadObjectBuffer.Name & "-" & CrLf & stoptime - starttime
End Function

Friend Function ReadGadgetByID(ObjectToReadID As Long) As String
    Static MemPropsRS As Recordset
    Dim starttime As Single, stoptime As Single
    Dim Cntr As Integer, TotAllObjects As Integer, AOPntr As Integer
    Dim StartBookMark As Variant, StartKey As String
    Dim StartPropBookmark As Variant, StartPropKey As String
    Dim GadgetNDX As Integer
    starttime = Timer
    Dim Result As String
    Dim SQLCmd As String
    Dim RS As Recordset
    Dim LocalError As String
    On Error GoTo LocalError
    
    
    ReadObjectBuffer = BlankObject
    StartBookMark = ObjectsRS.Bookmark
    StartKey = ObjectsRS.Index
    StartPropBookmark = PropsRS.Bookmark
    StartPropKey = PropsRS.Index
'    On Error GoTo LocalError
    Result = "OK"
'    ReadObjectBuffer.ObjectID = 0
'    If UBound(AllObjects()) > 0 Then
'        TotAllObjects = UBound(AllObjects())
'        If TotAllObjects < ObjectsRS.RecordCount Then GoTo SkipMem
'        For Cntr = 1 To TotAllObjects
'            If AllObjects(Cntr).ObjectID = ObjectToReadID Then
'                ReadObjectBuffer = AllObjects(Cntr)
'                Exit For
'            End If
'        Next
'        If Cntr <= TotAllObjects Then
'            GoTo EndGORO
'        End If
'    End If
SkipMem:
    ' don't seek if already there
    ' this is the new Universal Object ID Change
'    PropsRS.Index = "ValueAlpha"
'    PropsRS.Seek "=", ObjectToReadID
'    Do While PropsRS.NoMatch = False
'        If PropsRS!Property = "ugid" Then
'            ObjectToReadID = PropsRS!ObjectID
'            Exit Do
'        End If
'        PropsRS.MoveNext
'        If PropsRS.EOF Then
'            Exit Do
'        End If
'        If PropsRS!Property <> "ugid" Then
'            Exit Do
'        End If
'    Loop
    If ObjectsRS![ObjectID] <> ObjectToReadID Then
        ObjectsRS.Index = "PrimaryKey"
        ObjectsRS.Seek "=", ObjectToReadID
    End If
    If ObjectsRS![ObjectID] <> ObjectToReadID Then
        ReadObjectBuffer.Name = ""
        SetProperty Trace, NextID("trace") & "NT ReadGadgetByID Error", "Object read failed to locate the object #: " & ObjectToReadID
        SetProperty VGBErrors, NextID("error") & "NT RedGadgetByID Error", "Object read failed to locate the object #: " & ObjectToReadID
        Result = "ERROR: Object read failed to locate the object #: " & ObjectToReadID
        GoTo EndGORO
    End If
'    GadgetWorkspace.BeginTrans removed 03/21/00
    ReadObjectBuffer.ObjectID = ObjectsRS![ObjectID]
    ReadObjectBuffer.Level = ObjectsRS![Level]
    ReadObjectBuffer.GAppName = ObjectsRS![GAppName]
    ReadObjectBuffer.Container = ObjectsRS![Container]
    ReadObjectBuffer.Type = ObjectsRS![Type]
    ReadObjectBuffer.Name = ObjectsRS![Name]
'    GadgetWorkspace.CommitTrans removed 03/21/00
    GDSFreelocks
    'GoTo OldWay
    starttime = Timer
    SQLCmd = "select * from props where props.objectid=" & ReadObjectBuffer.ObjectID & " order by props.propertyID;"
    Set RS = OpenDB(OpenDBPTR).OpenRecordset(SQLCmd, dbOpenDynaset)
    RS.MoveLast
    GadgetNDX = RS.RecordCount
    ReadObjectBuffer.TotalProperties = GadgetNDX
    ReDim ReadObjectBuffer.PropertyID(GadgetNDX)
    ReDim ReadObjectBuffer.Propity(GadgetNDX)
    ReDim ReadObjectBuffer.Caption(GadgetNDX)
    ReDim ReadObjectBuffer.ValueAlpha(GadgetNDX)
    ReDim ReadObjectBuffer.ValueNum(GadgetNDX)
    ReDim ReadObjectBuffer.PropSource(GadgetNDX)
    ReDim ReadObjectBuffer.PropType(GadgetNDX)
    GadgetNDX = 0
    RS.MoveFirst
    Do While RS.EOF = False
        GadgetNDX = GadgetNDX + 1
        ReadObjectBuffer.PropertyID(GadgetNDX) = RS!PropertyID
        ReadObjectBuffer.Propity(GadgetNDX) = RS!Property
        ReadObjectBuffer.ValueAlpha(GadgetNDX) = RS!ValueAlpha
        ReadObjectBuffer.ValueNum(GadgetNDX) = RS!ValueNum
        ReadObjectBuffer.PropSource(GadgetNDX) = RS!PropSource
        ReadObjectBuffer.PropType(GadgetNDX) = RS!PropType
        RS.MoveNext
    Loop
'    stoptime = Timer
'MsgBox "Time to load object By ID: " & CrLf & ReadObjectBuffer.Name & "-" & CrLf & stoptime - starttime & CrLf & "Props: " & ReadObjectBuffer.TotalProperties
    GoTo SkipProps
    
OldWay:
    PropsRS.Index = "ObjectID"
    PropsRS.Seek "=", ObjectToReadID
    GadgetNDX = 0
    If PropsRS.NoMatch = True Then
        ReDim ReadObjectBuffer.PropertyID(GadgetNDX)
        ReDim ReadObjectBuffer.Propity(GadgetNDX)
        ReDim ReadObjectBuffer.Caption(GadgetNDX)
        ReDim ReadObjectBuffer.ValueAlpha(GadgetNDX)
        ReDim ReadObjectBuffer.ValueNum(GadgetNDX)
        ReDim ReadObjectBuffer.PropSource(GadgetNDX)
        ReDim ReadObjectBuffer.PropType(GadgetNDX)
        GoTo SkipProps
    End If
    ' flush out the old stuff
    
'    SQLCmd = "SELECT all count (objectid) " & _
              "as [TotProps] From Props " & _
               "where props.objectid=" & CStr(ObjectToReadID) & " and (Props.ValueAlpha <> 'VBasic') And (Props.ValueAlpha <> 'TLHicky');"
    'starttime = Timer
'    Set MemPropsRS = OpenDB(OpenDBPTR).OpenRecordset(SQLCmd, dbOpenDynaset)
                'AllNamesCNTR = AllNamesCNTR + Val(MemPropsRS!TotProps)
'    GadgetNDX = MemPropsRS!TotProps
    'stoptime = Timer
    'MsgBox stoptime - starttime
    
    
    GadgetNDX = 0
    Do Until (PropsRS!ObjectID <> ObjectToReadID)
        If (PropsRS!ValueAlpha <> "VBasic") And (PropsRS!ValueAlpha <> "TLHicky") Then
            GadgetNDX = GadgetNDX + 1
        End If
        PropsRS.MoveNext
        If PropsRS.EOF Then
            Exit Do
        End If
    Loop
    ReDim ReadObjectBuffer.PropertyID(GadgetNDX)
    ReDim ReadObjectBuffer.Propity(GadgetNDX)
    ReDim ReadObjectBuffer.Caption(GadgetNDX)
    ReDim ReadObjectBuffer.ValueAlpha(GadgetNDX)
    ReDim ReadObjectBuffer.ValueNum(GadgetNDX)
    ReDim ReadObjectBuffer.PropSource(GadgetNDX)
    ReDim ReadObjectBuffer.PropType(GadgetNDX)
    ' suck in the new Props
    PropsRS.Seek "=", ObjectToReadID
    If (PropsRS.NoMatch Or PropsRS.EOF) Then
        GoTo SkipProps
    End If
    GadgetNDX = 0
    
    Do Until (PropsRS!ObjectID <> ObjectToReadID)
        If (PropsRS!ValueAlpha <> "VBasic") And (PropsRS!ValueAlpha <> "TLHicky") Then
'            GadgetWorkspace.BeginTrans removed 03/21/00
            GadgetNDX = GadgetNDX + 1
            ReadObjectBuffer.PropertyID(GadgetNDX) = PropsRS!PropertyID
'            GDSFreelocks
            ReadObjectBuffer.Propity(GadgetNDX) = PropsRS!Property
'            GDSFreelocks
            ReadObjectBuffer.ValueAlpha(GadgetNDX) = PropsRS!ValueAlpha
'            GDSFreelocks
            ReadObjectBuffer.ValueNum(GadgetNDX) = PropsRS!ValueNum
'            GDSFreelocks
            ReadObjectBuffer.PropSource(GadgetNDX) = PropsRS!PropSource
'            GDSFreelocks
            ReadObjectBuffer.PropType(GadgetNDX) = PropsRS!PropType
'            GDSFreelocks
'            GadgetWorkspace.CommitTrans removed 03/21/00
        Else
'            MsgBox "Debug"
        End If
'        GDSFreelocks
        PropsRS.MoveNext
        If PropsRS.EOF Then
            Exit Do
        End If
'        If PropsRS!ObjectID <> ObjectToReadID Then
'            Exit Do
'        End If
    Loop
    ReadObjectBuffer.TotalProperties = GadgetNDX
SkipProps:
    
GoTo EndGORO:
    
'    ' flush old methods down the toilet
'    GadgetNDX = 0
'    ReDim ReadObjectBuffer.MethodID(GadgetNDX)
'    ReDim ReadObjectBuffer.MethType(GadgetNDX)
'    ReDim ReadObjectBuffer.Method(GadgetNDX)
'    ReDim ReadObjectBuffer.MethAction(GadgetNDX)
'    MethodsRS.Index = "Objectid"
'    MethodsRS.Seek "=", ObjectToReadID
'    ' suck in the methods
'    If (MethodsRS.NoMatch Or MethodsRS.EOF) Then
'        GoTo EndGORO
'    End If
'    Do Until (MethodsRS!ObjectID <> ObjectToReadID)
'        GadgetNDX = GadgetNDX + 1
'        ReDim Preserve ReadObjectBuffer.MethodID(GadgetNDX)
'        ReDim Preserve ReadObjectBuffer.MethType(GadgetNDX)
'        ReDim Preserve ReadObjectBuffer.Method(GadgetNDX)
'        ReDim Preserve ReadObjectBuffer.MethAction(GadgetNDX)
'        ReadObjectBuffer.MethodID(GadgetNDX) = MethodsRS!MethodID
'        ReadObjectBuffer.MethType(GadgetNDX) = MethodsRS!MethType
'        ReadObjectBuffer.Method(GadgetNDX) = MethodsRS!Method
'        ReadObjectBuffer.MethAction(GadgetNDX) = MethodsRS!MethAction
'        GDSFreelocks
'        PropsRS.MoveNext
'        If MethodsRS.EOF Then
'            Exit Do
'        End If
'    Loop
    GoTo EndGORO:
LocalError:
'    MsgBox Error
    LocalError = Error
    SetProperty Trace, NextID("trace") & "Trapped ReadGadgetByID Error", ObjectToReadID & " / " & LocalError
    SetProperty VGBErrors, NextID("error") & "Trapped ReadGadgetByID Error", ObjectToReadID & " / " & LocalError
    Resume Next
EndGORO:
    ObjectsRS.Index = StartKey
    ObjectsRS.Bookmark = StartBookMark
    
    PropsRS.Index = StartPropKey
    PropsRS.Bookmark = StartPropBookmark
    ReadGadgetByID = Result
    stoptime = Timer
    GDSFreelocks
'    MsgBox "Time to load object By ID: " & CrLf & ReadObjectBuffer.Name & "-" & CrLf & stoptime - starttime & CrLf & "Props: " & ReadObjectBuffer.TotalProperties
End Function
Friend Function ReadDiskGadgetByID(ObjectToReadID As Long) As Gadget
    ' read a gadget from the current db and return it to caller
    Dim starttime As Single, stoptime As Single
    Dim ReadObjectBuffer As Gadget
    Dim Cntr As Integer, TotAllObjects As Integer, AOPntr As Integer
    Dim StartBookMark As String, StartKey As String
    Dim StartPropBookmark As String, StartPropKey As String
    Dim GadgetNDX As Integer
    starttime = Timer
    Dim Result As String
    On Error GoTo LocalError
    ReadObjectBuffer = BlankObject
    ReadObjectBuffer.Name = NotFound
    StartBookMark = ObjectsRS.Bookmark
    StartKey = ObjectsRS.Index
    StartPropBookmark = PropsRS.Bookmark
    StartPropKey = PropsRS.Index
'    On Error GoTo LocalError
    Result = "OK"
'    ReadObjectBuffer.ObjectID = 0
    If UBound(AllObjects()) > 0 Then
        TotAllObjects = UBound(AllObjects())
        If TotAllObjects < ObjectsRS.RecordCount Then GoTo SkipMem
        For Cntr = 1 To TotAllObjects
            If AllObjects(Cntr).ObjectID = ObjectToReadID Then
                ReadObjectBuffer = AllObjects(Cntr)
                Exit For
            End If
        Next
        If Cntr <= TotAllObjects Then
            GoTo EndGORO
        End If
SkipMem:
    End If
    ObjectsRS.Index = "PrimaryKey"
    ObjectsRS.Seek "=", ObjectToReadID
    If ObjectsRS.NoMatch = True Then
        ReadObjectBuffer.Name = NotFound
        Result = "ERROR: Object read failed to locate the object #: " & ObjectToReadID
        GoTo EndGORO
    End If
    If ObjectsRS!ObjectID <> ObjectToReadID Then
        FloatMsgBox "Readbyid Boof! ID in=" & CStr(ObjectToReadID) & " Out=" & CStr(ObjectsRS!ObjectID), "ERROR!!!!"
    End If
    GadgetWorkspace.BeginTrans
    ReadObjectBuffer.ObjectID = ObjectsRS![ObjectID]
    ReadObjectBuffer.Level = ObjectsRS![Level]
    ReadObjectBuffer.GAppName = ObjectsRS![GAppName]
    ReadObjectBuffer.Container = ObjectsRS![Container]
    ReadObjectBuffer.Type = ObjectsRS![Type]
    ReadObjectBuffer.Name = ObjectsRS![Name]
    GadgetWorkspace.CommitTrans
    GDSFreelocks
    PropsRS.Index = "ObjectID"
    PropsRS.Seek "=", ObjectToReadID
    GadgetNDX = 0
    If PropsRS.NoMatch = True Then
        ReDim ReadObjectBuffer.PropertyID(GadgetNDX)
        ReDim ReadObjectBuffer.Propity(GadgetNDX)
        ReDim ReadObjectBuffer.Caption(GadgetNDX)
        ReDim ReadObjectBuffer.ValueAlpha(GadgetNDX)
        ReDim ReadObjectBuffer.ValueNum(GadgetNDX)
        ReDim ReadObjectBuffer.PropSource(GadgetNDX)
        ReDim ReadObjectBuffer.PropType(GadgetNDX)
        GoTo SkipProps
    End If
    ' flush out the old stuff
    GadgetNDX = 0
    Do Until (PropsRS!ObjectID <> ObjectToReadID)
        If (PropsRS!ValueAlpha <> "VBasic") And (PropsRS!ValueAlpha <> "TLHicky") Then
            GadgetNDX = GadgetNDX + 1
        End If
        PropsRS.MoveNext
        If PropsRS.EOF Then
            Exit Do
        End If
    Loop
    ReDim ReadObjectBuffer.PropertyID(GadgetNDX)
    ReDim ReadObjectBuffer.Propity(GadgetNDX)
    ReDim ReadObjectBuffer.Caption(GadgetNDX)
    ReDim ReadObjectBuffer.ValueAlpha(GadgetNDX)
    ReDim ReadObjectBuffer.ValueNum(GadgetNDX)
    ReDim ReadObjectBuffer.PropSource(GadgetNDX)
    ReDim ReadObjectBuffer.PropType(GadgetNDX)
    ' suck in the new Props
    PropsRS.Seek "=", ObjectToReadID
    If (PropsRS.NoMatch Or PropsRS.EOF) Then
        GoTo SkipProps
    End If
    GadgetNDX = 0
    
    Do Until (PropsRS!ObjectID <> ObjectToReadID)
        If (PropsRS!ValueAlpha <> "VBasic") And (PropsRS!ValueAlpha <> "TLHicky") Then
        GadgetWorkspace.BeginTrans
        GadgetNDX = GadgetNDX + 1
'        ReDim Preserve ReadObjectBuffer.PropertyID(GadgetNDX)
'        ReDim Preserve ReadObjectBuffer.Propity(GadgetNDX)
'        ReDim Preserve ReadObjectBuffer.Caption(GadgetNDX)
'        ReDim Preserve ReadObjectBuffer.ValueAlpha(GadgetNDX)
'        ReDim Preserve ReadObjectBuffer.ValueNum(GadgetNDX)
'        ReDim Preserve ReadObjectBuffer.PropSource(GadgetNDX)
'        ReDim Preserve ReadObjectBuffer.PropType(GadgetNDX)
        GDSFreelocks
        ReadObjectBuffer.PropertyID(GadgetNDX) = PropsRS!PropertyID
        GDSFreelocks
        ReadObjectBuffer.Propity(GadgetNDX) = PropsRS!Property
        GDSFreelocks
        ReadObjectBuffer.ValueAlpha(GadgetNDX) = PropsRS!ValueAlpha
        GDSFreelocks
        ReadObjectBuffer.ValueNum(GadgetNDX) = PropsRS!ValueNum
        GDSFreelocks
        ReadObjectBuffer.PropSource(GadgetNDX) = PropsRS!PropSource
        GDSFreelocks
        ReadObjectBuffer.PropType(GadgetNDX) = PropsRS!PropType
        GDSFreelocks
        GadgetWorkspace.CommitTrans
        End If
        PropsRS.MoveNext
        If PropsRS.EOF Then
            Exit Do
        End If
    Loop
SkipProps:
    ReadObjectBuffer.TotalProperties = GadgetNDX
    ' flush old methods down the toilet
    GadgetNDX = 0
    ReDim ReadObjectBuffer.MethodID(GadgetNDX)
    ReDim ReadObjectBuffer.MethType(GadgetNDX)
    ReDim ReadObjectBuffer.Method(GadgetNDX)
    ReDim ReadObjectBuffer.MethAction(GadgetNDX)
'    MethodsRS.Index = "Objectid"
'    MethodsRS.Seek "=", ObjectToReadID
'    ' suck in the methods
'    If (MethodsRS.NoMatch Or MethodsRS.EOF) Then
'        GoTo EndGORO
'    End If
'    Do Until (MethodsRS!ObjectID <> ObjectToReadID)
'        GadgetNDX = GadgetNDX + 1
'        ReDim Preserve ReadObjectBuffer.MethodID(GadgetNDX)
'        ReDim Preserve ReadObjectBuffer.MethType(GadgetNDX)
'        ReDim Preserve ReadObjectBuffer.Method(GadgetNDX)
'        ReDim Preserve ReadObjectBuffer.MethAction(GadgetNDX)
'        ReadObjectBuffer.MethodID(GadgetNDX) = MethodsRS!MethodID
'        ReadObjectBuffer.MethType(GadgetNDX) = MethodsRS!MethType
'        ReadObjectBuffer.Method(GadgetNDX) = MethodsRS!Method
'        ReadObjectBuffer.MethAction(GadgetNDX) = MethodsRS!MethAction
'        GDSFreelocks
'        PropsRS.MoveNext
'        If MethodsRS.EOF Then
'            Exit Do
'        End If
'    Loop
    GoTo EndGORO:
LocalError:
'    MsgBox Error
    Resume Next
EndGORO:
    ObjectsRS.Index = StartKey
    ObjectsRS.Bookmark = StartBookMark
    PropsRS.Index = StartPropKey
    PropsRS.Bookmark = StartPropBookmark
    ReadDiskGadgetByID = ReadObjectBuffer
    stoptime = Timer
    GDSFreelocks
    If ReadObjectBuffer.ObjectID <> ObjectToReadID Then
        FloatMsgBox "Readbyid Boof! ID in=" & CStr(ObjectToReadID) & " Readobjectbuffer Out=" & CStr(ReadObjectBuffer.ObjectID), "ERROR!!!!"
    End If
    
    On Error GoTo 0
'    MsgBox "Time to load object By ID: " & CrLf & ReadObjectBuffer.Name & "-" & CrLf & stoptime - starttime & CrLf & "Props: " & ReadObjectBuffer.TotalProperties
End Function

Friend Function GODReadContainedAndLinked(Param As Gadget, MasterGadgets() As Gadget, ContainedGadgets() As Gadget, LinkedGadgets() As Gadget) As Gadget
    ' this routine will read gadget object(s), all contained and/or linked
    ' objects into the respective arrays of gadgets
    
    Dim starttime As Single, stoptime As Single
    starttime = Timer
    Dim t, Msg As String, Msg2 As String, Cntr1 As Integer, CNTR2 As Integer
    Dim SourcesRead As Integer, ContainersRead As Integer, LinksRead As Integer
    Dim SourcesWrote As Integer, ContainersWrote As Integer, LinksWrote As Integer
    Dim AddedLinkedToCNTR As Integer, FoundLinkedToCNTR As Integer
    Dim DoEventCNTR As Integer
    Dim TempGadget As Gadget
    Dim SourceDBGadgetPTR As Integer
    Dim DestDBGadgetPTR As Integer
    Dim ContainerToMove As String
    Dim LinkProp As String, LinkType As String
    Dim TransportMode As String
    Dim ResultsGadget As Gadget
    Dim CurrContainedObject As Gadget
    Dim LoadMasterGadgetsPTR As Integer, LoadMasterGadgetsCNTR As Integer
    Dim MasterGadgetsPTR As Integer, MasterGadgetsCNTR As Integer
    Dim SourceExisted As Boolean
    Dim ContainedGadgetsPTR As Integer, ContainedGadgetsCNTR As Integer
    Dim LinkedGadgetsPTR As Integer, LinkedGadgetsCNTR As Integer
    Dim DestGadget As Gadget
    Dim OldColName As String
    Dim NewColName As String
    Dim ExcludeTypes() As String, ExcludeTypesCNTR As Integer
    Dim ThisRS As Recordset
    Dim StartDBGPTR As Integer
    StartDBGPTR = DBGadgetsPTR
    ' begin a resultsgadget
    ResultsGadget = BlankObject
    ResultsGadget.Name = "Results of Container Loader"
    ResultsGadget.Type = "Function Status"
    ResultsGadget.Container = "Results"
    t = SetProperty(ResultsGadget, "Status", "Started")
    t = SetProperty(ResultsGadget, "StartTimer", CStr(starttime))
    ' load excluded types
    For Cntr1 = 1 To 1000
        If DoEventCNTR Mod 15 = 0 Then
            DoEventCNTR = 0
'            DoEvents
        Else
            DoEventCNTR = DoEventCNTR + 1
        End If
        Msg = "Exclude Type" & CStr(Cntr1)
        Msg2 = UCase(ReadProperty(Param, Msg))
        If Msg2 <> NotFound Then
            ExcludeTypesCNTR = ExcludeTypesCNTR + 1
            ReDim Preserve ExcludeTypes(ExcludeTypesCNTR)
            ExcludeTypes(ExcludeTypesCNTR) = UCase(Msg2)
        Else
            Exit For
        End If
    Next
    ' set up source/destination variables
    ' see if there is a link property (a property that points to another object)
    MasterGadgetsCNTR = UBound(MasterGadgets)
    ContainedGadgetsCNTR = UBound(ContainedGadgets)
    LinkProp = ReadProperty(Param, "Take Link Property")
    If LinkProp = NotFound Then
        LinkProp = "None"
    End If
    LinkType = ReadProperty(Param, "Take Link Type")
    Msg = ReadProperty(Param, "Source Database")
    SourceDBGadgetPTR = DBFindIndex(Msg)
    LoadMasterGadgetsCNTR = Val(ReadProperty(Param, "Total Source Objects"))
    If LoadMasterGadgetsCNTR = 0 Then
        t = SetProperty(ResultsGadget, "Error", "No Master Gadget Specified")
        GoTo EndSub
    End If
'Read ////////////////////////////////////////////////////////////////////////////////////////////
    ' read source, contained and linked to objects
'    MasterGadgetsCNTR = 1
    For LoadMasterGadgetsPTR = 1 To LoadMasterGadgetsCNTR
        SourcesRead = SourcesRead + 1
        ' switch to source db
        Msg = DBSwitch(SourceDBGadgetPTR)
        If Msg <> OK Then
            MsgBox Msg, , UCase(App.EXEName) & " Debug Message"
            t = SetProperty(ResultsGadget, "Error", Msg)
            GoTo NextMasterGadgets
        End If
        ' check to see if there is a seal of approval to  check
        Msg = ReadProperty(Param, "Verification Object") '= "Seal of Approval"
        TempGadget = BlankObject
        If Msg <> NotFound Then
            t = ReadGadgetByName(Msg, TempGadget)
            If t <> OK Then
                Msg2 = "Failed to find: " & Msg
                MsgBox Msg2, vbExclamation, "Error: DB Verify Failure"
                t = SetProperty(ResultsGadget, "Error", "DB Verify Failure")
                GoTo EndSub
            End If
        End If
        Msg = ReadProperty(Param, "Source Object ID" & CStr(LoadMasterGadgetsPTR))
        t = ReadGadgetByID(Val(Msg))
        If t <> OK Then
            ' could not find this object
            GoTo NextMasterGadgets
        End If
        Msg = "Add"
        For Cntr1 = 1 To MasterGadgetsCNTR
            If MasterGadgets(Cntr1).ObjectID = ReadObjectBuffer.ObjectID Then
                Msg = "Found"
                Exit For
            End If
        Next
        If Msg = "Add" Then
            MasterGadgetsCNTR = MasterGadgetsCNTR + 1
            ReDim Preserve MasterGadgets(MasterGadgetsCNTR)
            MasterGadgets(MasterGadgetsCNTR) = ReadObjectBuffer
        End If
        ' place the oid of original in tag of MasterGadgets to use later
        MasterGadgets(MasterGadgetsCNTR).Tag = MasterGadgets(MasterGadgetsCNTR).ObjectID
        Set ThisRS = OpenDB(OpenDBPTR).OpenRecordset("Objects", dbOpenTable) ', dbForwardOnly)
        ' need to fix up the links in the contained objects
        ThisRS.Index = "Container"
        ThisRS.Seek "=", MasterGadgets(MasterGadgetsCNTR).Tag
        Do While ThisRS.NoMatch = False
'            DoEvents
            If ThisRS!Name = MasterGadgets(MasterGadgetsCNTR).Name Then
                GoTo NextRecord:
            End If
            t = ReadGadgetByID(ThisRS!ObjectID)
            CurrContainedObject = ReadObjectBuffer
            If t <> OK Then
                MsgBox "Error Reading Contained Object: " & t, , UCase(App.EXEName) & " Debug Message"
                GoTo NextMasterGadgets
            End If
            Msg = "Include"
            For Cntr1 = 1 To ExcludeTypesCNTR
                If UCase(CurrContainedObject.Type) = ExcludeTypes(Cntr1) Then
                    Msg = "Exclude"
                    Exit For
                End If
            Next
            If Msg = "Exclude" Then
                GoTo NextRecord
            End If
            Msg = "Add"
            For Cntr1 = 1 To ContainedGadgetsCNTR
                If ContainedGadgets(Cntr1).ObjectID = ReadObjectBuffer.ObjectID Then
                    If ContainedGadgets(Cntr1).Container = CStr(MasterGadgets(LoadMasterGadgetsPTR).ObjectID) Then
                        Msg = "Skip"
                        Exit For
                    End If
                End If
            Next
            If Msg = "Add" Then
                ContainersRead = ContainersRead + 1
                ContainedGadgetsCNTR = ContainedGadgetsCNTR + 1
                ReDim Preserve ContainedGadgets(ContainedGadgetsCNTR)
                ContainedGadgets(ContainedGadgetsCNTR) = CurrContainedObject
                ContainedGadgets(ContainedGadgetsCNTR).Tag = MasterGadgets(MasterGadgetsCNTR).ObjectID
                If LinkProp <> "None" Then
                    t = ReadProperty(ContainedGadgets(ContainedGadgetsCNTR), LinkProp)
                    If (t <> NotFound) And t <> "None" Then
                        ' there is a linked property
                        t = ReadGadgetByID(Val(t))
                        If t <> OK Then
                            MsgBox "Error Reading Linked Object: " & t, , UCase(App.EXEName) & " Debug Message"
                        Else
                            LinksRead = LinksRead + 1
                            LinkedGadgetsCNTR = LinkedGadgetsCNTR + 1
                            ReDim Preserve LinkedGadgets(LinkedGadgetsCNTR)
                            LinkedGadgets(LinkedGadgetsCNTR) = ReadObjectBuffer
                            LinkedGadgets(LinkedGadgetsCNTR).ObjectID = 0
                            LinkedGadgets(LinkedGadgetsCNTR).Tag = ReadObjectBuffer.ObjectID
                        End If
                    End If
                End If
            End If
NextRecord:
            ThisRS.MoveNext
            If ThisRS.EOF Then Exit Do
            If ThisRS!Container <> MasterGadgets(MasterGadgetsCNTR).Tag Then Exit Do
        Loop
        t = SetProperty(ResultsGadget, "Total Contained" & CStr(LoadMasterGadgetsPTR), CStr(ContainedGadgetsCNTR))
        t = SetProperty(ResultsGadget, "Total Linked" & CStr(LoadMasterGadgetsPTR), CStr(LinkedGadgetsCNTR))
'        t = SetProperty(ResultsGadget, "Read Timer", CStr(Timer))
'        t = SetProperty(ResultsGadget, "Read Time", CStr(Timer - starttime))
'        DoEvents
NextMasterGadgets:
        If AbortRead Then GoTo EndSub
    Next LoadMasterGadgetsPTR
    t = SetProperty(ResultsGadget, "Status", "Done")
EndSub:
    DBSwitch 1
    stoptime = Timer
    t = SetProperty(ResultsGadget, "Masters Loaded", CStr(SourcesRead))
    t = SetProperty(ResultsGadget, "Contained Gadgets Loaded", CStr(ContainersRead))
    t = SetProperty(ResultsGadget, "Linked Gadgets Loaded", CStr(LinksRead))
'    t = SetProperty(ResultsGadget, "Contained Gadgets Loaded", CStr(ContainersRead))
    t = SetProperty(ResultsGadget, "StopTimer", CStr(stoptime))
    t = SetProperty(ResultsGadget, "Total Time", CStr(stoptime - starttime))
'    MsgBox stoptime - starttime
    GODReadContainedAndLinked = ResultsGadget
    AbortRead = False
    DBSwitch StartDBGPTR
    On Error GoTo 0
End Function
Friend Function GODReadContainerObject(ObjectToReadName As String, _
                                       ContainerToUse As String, _
                                       GORReadObjectBuffer As Gadget) As String
    ' read
    Dim Crit As String, t, GadgetNDX As Integer, starttime As Single, stoptime As Single
    Dim IDToRead As Long
    starttime = Timer
    Dim SourceRS As Recordset, SourceMethodRS As Recordset
    Dim NewRS As String, OldPropRS As String
    Dim Result As String
    Result = "OK"
    GORReadObjectBuffer.Name = ""
    ObjectsRS.Index = "Container"
    ObjectsRS.Seek "=", ContainerToUse
    If ObjectsRS.NoMatch Then
        Result = "ERROR: Object read failed to locate the object named:" & ObjectToReadName & " in: " & ContainerToUse
        GoTo EndGORO
    End If
    With ObjectsRS
        Do Until .EOF
            If UCase(!Name) = UCase(ObjectToReadName) Then
                ' we have a winner
                Exit Do
            End If
            .MoveNext
            If .EOF Then
                Result = "NOT FOUND"
                GoTo EndGORO
            End If
            If !Container <> ContainerToUse Then
                Result = "NOT FOUND"
                GoTo EndGORO
            End If
        Loop
    End With
    IDToRead = ObjectsRS!ObjectID
    t = ReadGadgetByID(IDToRead)
    If t = "OK" Then
        GORReadObjectBuffer = ReadObjectBuffer
    Else
        Result = t
    End If
EndGORO:
GODReadContainerObject = Result
stoptime = Timer
GDSFreelocks
'MsgBox "Time to load object: " & GORReadObjectBuffer.Name & "-" & CrLf & stoptime - starttime
End Function
Friend Function CopyDatabase(Param As Gadget) As Gadget
    ' this is the remotely requested db creater
    ' it will really clone any db (not currently open)
    
End Function

Friend Function AddDatabase(Param As Gadget) As Gadget
    ' this will add a database to the system
    '   Caller provides:
    '     "SourcePath"
    '     "SourceFile"
    '     "DestPath"
    '     "DestFile"
    '     "Stop on error"
    '     "Write Param"
    '     "Write Param File DBGadgetPTR"
    '     "Created by"
    ' and this creates/adds the dbgadget and appdbgadgets for this app
    ' note: a new database is a copy of the db specified in the sourcefile property
    Dim starttime As Single, stoptime As Single, tracetime As Single
    starttime = Timer
    Dim t, Msg As String, Cntr1 As Integer
    Dim RREsults As Gadget, MResults As Gadget
    Dim AppPath As String
    Dim SourcePath As String
    Dim SourceFile As String
    Dim SourceFileName As String
    Dim DestPath As String
    Dim DestFile As String
    Dim DestFileName As String
    Dim LocalError As String
    Dim ResultsGadget As Gadget
    Dim LParam As Gadget
    Dim StartDBGadgetsPTR As Integer
    StartDBGadgetsPTR = DBGadgetsPTR
    ResultsGadget.Name = "Started"
    SetProperty ResultsGadget, "Status", OK
    LParam = Recall(Param.Name, "from " & VGBDatabaseNameAndPath)
    If LParam.Name = Param.Name Then
        Param.ObjectID = LParam.ObjectID
    End If
    SourceFile = ReadProperty(Param, "SourceFile")
    SourcePath = AddBackSlash(ReadProperty(Param, "SourcePath"))
    SourceFileName = SourcePath & SourceFile
    
    DestFile = ReadProperty(Param, "DestFile")
    DestPath = AddBackSlash(ReadProperty(Param, "DestPath"))
    DestFileName = DestPath & DestFile
    
    SetProperty Trace, NextID("trace") & "AddDatabase", "SourceFileName: " & SourceFileName & "/ DestFileName: " & DestFileName
'    Result = "OK"
    On Error GoTo LocalError:
    If Not FileExists(SourceFileName) Then
        t = SetProperty(Param, "Error", SourceFileName & ": Blank File NOT FOUND" & Msg)
        SetProperty Trace, NextID("trace") & "AddDatabase ERROR", SourceFileName & ": File NOT FOUND"
        SetProperty VGBErrors, NextID("error") & "AddDatabase ERROR", SourceFileName & ": File NOT FOUND"
        Msg = "No Blank File!" & CrLf
        Msg = Msg & "Please make sure that " & SourceFile & " is in directory:" & CrLf
        Msg = Msg & SourcePath & CrLf
        Msg = Msg & "and retry create database function."
'        FloatMsgBox Msg, UCase(App.EXEName) & " [No Blank Database Error]"
        t = SetProperty(ResultsGadget, "Error", SourceFileName & ": Blank File NOT FOUND" & Msg)
        t = SetProperty(ResultsGadget, "Status", "Error")
        GoTo EndSub
    End If
    If FileExists(DestFileName) Then
        ' need to register and leave
        LParam = BlankObject
        Msg = ReadProperty(Param, "User Name")
        If Msg = NotFound Then
            Msg = ""
        End If
        ' !!! need to add the ability to use indexed list of databases with
        ' us maintaining the relationships
        If Msg <> "" Then
            ' this means that they have a long name
            ' we will create another indexed db and assign it to this long name
            ' or not
        End If
        t = SetProperty(LParam, "DB Path", DestPath)
        t = SetProperty(LParam, "DB Name", DestFile)
        t = SetProperty(LParam, "DB Path and Name", DestFileName)
        Msg = ReadProperty(Param, "Show DB to User")
        If Msg = NotFound Then
            Msg = "True"
        End If
        t = SetProperty(LParam, "Show DB to User", Msg)
        t = SetProperty(LParam, "DB GadgetsPTR Template", "1")
        t = SetProperty(LParam, "Created by", ReadProperty(Param, "Created by"))
        RegisterDatabase LParam
        ' we now have this database in dbgadgets and in appgadgets
        t = SetProperty(Param, "Error", "Dest File Exists" & Msg)
        Msg = ""
        Msg = Msg & "File: " & DestFileName & CrLf
        Msg = Msg & "is already on disk." & CrLf & CrLf
        Msg = Msg & "Existing File Registered" & CrLf
        If ReadProperty(Param, "Stop on error") = "Yes" Then
            If Not ExecutingSchedule Then
                t = MsgBox(Msg, vbOK + vbExclamation, "Error: Requested File Already Exists")
            End If
        End If
        t = SetProperty(ResultsGadget, "Status", SourceFileName & ": Already On Disk")
        
        SetProperty Trace, NextID("trace") & "AddDatabase", DestFileName & ": File Exists, registering"
        GoTo RegisterOnly
    End If
    ' here we know that the file doesn't exist on disk
    LocalError = ""
    FileCopy SourceFileName, DestFileName
    If LocalError <> "" Then
        ' copy got an error
        Msg = ""
        Msg = Msg & "Copying Empty File to:" & CrLf
        Msg = Msg & DestFileName & CrLf
        t = SetProperty(Param, "Local Error", "After DB Copy: " & LocalError)
        If ReadProperty(Param, "Stop on error") = "Yes" Then
            t = MsgBox(Msg, vbOKOnly + vbExclamation, "Error: " & LocalError)
        End If
        GoTo EndSub
    End If
    If Not FileExists(DestFileName) Then
        ' something wierd happened, copy didn't get error but file is not there
        t = SetProperty(Param, "Copy Error", ": " & "File not found after copy had no error")
        SetProperty Trace, NextID("trace") & "AddDatabase Copy ERROR", DestFileName & ": NOT FOUND after copy"
        SetProperty VGBErrors, NextID("error") & "AddDatabase Copy ERROR", DestFileName & ": NOT FOUND after copy"
        
'        MsgBox "Database Creation failed: " & LocalError, , ucase(App.EXEName) & " Debug Error"
        Msg = "Database Creation failed.  VB Error: " & LocalError
        If ReadProperty(Param, "Stop on error") = "Yes" Then
            MsgBox Msg, , UCase(App.EXEName) & " Debug Message"
        End If
        t = SetProperty(ResultsGadget, "Error", SourceFileName & ": Blank File NOT FOUND" & Msg)
        
        GoTo EndSub
    End If
    ' copy succeeded, need to register this new db
RegisterOnly:
    LParam = BlankObject
    t = SetProperty(LParam, "DB Path", DestPath)
    t = SetProperty(LParam, "DB Name", DestFile)
    t = SetProperty(LParam, "DB Path and Name", DestFileName)
    t = SetProperty(LParam, "DB GadgetsPTR Template", "1")
    Msg = ReadProperty(Param, "Show DB to User")
    If Msg = NotFound Then
        Msg = "True"
    End If
    t = SetProperty(LParam, "Show DB to User", Msg)
    t = SetProperty(LParam, "Created by", ReadProperty(Param, "Created by"))
    RegisterDatabase LParam
    Cntr1 = DBFindIndex(DestFileName)
    If Cntr1 < 0 Then
        SetProperty Trace, NextID("trace") & "AddDatabase DBSwitch ERROR", DestFileName & ": Index NOT FOUND"
        SetProperty VGBErrors, NextID("error") & "AddDatabase DBSwitch ERROR", DestFileName & ": Index NOT FOUND"
        ResultsGadget.Name = "Error"
        SetProperty ResultsGadget, "Status", "Error Switching to Database"
        GoTo EndSub
    End If
'    t = DBSwitch(Cntr1)
'    MResults = Memorize(LParam, "in " & VGBDatabaseNameAndPath)
    ResultsGadget.Name = OK
    SetProperty ResultsGadget, "Status", OK
    GoTo EndSub
LocalError:
    LocalError = Error
    SetProperty Trace, NextID("trace") & "AddDatabse Error", "" & Param.Name & "/" & "Error: " & LocalError
    SetProperty VGBErrors, NextID("error") & "AddDatabse Error", "" & Param.Name & "/" & "Error: " & LocalError
    Resume Next
EndSub:
    If DBGadgetsPTR <> StartDBGadgetsPTR Then
        DBSwitch StartDBGadgetsPTR
    End If
    On Error GoTo 0
    GDSFreelocks
    AddDatabase = ResultsGadget
End Function
Friend Function RegisterDatabase(Param As Gadget) As Gadget
'   add a database to the dbgadgets pool
'   Param properties
'        "DB Path"
'        "DB Name"
'        "DB Path and Name"
'        "DB GadgetsPTR Template"
'        "Created by"

    Dim t, Msg As String, Cntr1 As Integer
    Dim RREsults As Gadget, MResults As Gadget
    Dim TotDbs As Integer
    Dim ThisDBGadget As Gadget
    Dim ThisDBName As String
    Dim DBPTRToUse As Integer
    Dim StartAppPTR As Integer, StartDBPTR As Integer
    Dim MYAppPTR As Integer
    Dim MyDBPTR As Integer
    Dim CheckDBPathAndName As String
    Dim AppDBPathAndName As String
    Dim DBPathAndName As String
    Dim LocalError As String
    Dim Result As String
    Dim ResultsGadget As Gadget
    Dim RegResults As Gadget
    Dim OpenResults As Gadget
    SetProperty Trace, NextID("trace") & "RegisterDatabase Start *********************************", "***"
    StartAppPTR = AppGadgetsPTR
    StartDBPTR = DBGadgetsPTR
    If DBGadgetsPTR > 0 Then
        DBSwitch 0
    End If
    ' this is the one to do
    CheckDBPathAndName = UCase(ReadProperty(Param, "DB Path and Name"))
    ' find an app that is me
    For MYAppPTR = 1 To AppGadgetsCNTR
        If AppGadgets(MYAppPTR).Name = UCase(App.EXEName) Then
            Exit For
        End If
    Next MYAppPTR
    If MYAppPTR > AppGadgetsCNTR Then
        FloatMsgBox "RegisterDatabase Function didn't find itself", UCase(App.EXEName) & " Error"
        ' need to cread an error object
    End If
    ' check dbgadgets for this db (path and name), if exists, flag status found
    For MyDBPTR = 0 To DBGadgetsCNTR
        ThisDBName = ReadProperty(DBGadgets(MyDBPTR), "DB Name")
        DBPathAndName = ReadProperty(DBGadgets(MyDBPTR), "Path")
        If Right(DBPathAndName, 1) <> "\" Then
            DBPathAndName = DBPathAndName & "\"
        End If
        DBPathAndName = DBPathAndName & ThisDBName
        If UCase(DBPathAndName) = CheckDBPathAndName Then
            ' this db is this dbgadget
            SetProperty Param, "DBGadgetsPTR", CStr(MyDBPTR)
            SetProperty Param, "DBGadgetStatus", "Found"
            Exit For
        End If
    Next MyDBPTR
    ' was this dbgadget found?
    If MyDBPTR > DBGadgetsCNTR Then
        ' not found, need to create and add the dbgadget to the disk
        ' create the blank object
        DBGadgetsCNTR = DBGadgetsCNTR + 1
        MyDBPTR = DBGadgetsCNTR
        ReDim Preserve DBGadgets(DBGadgetsCNTR)
        t = SetProperty(Param, "DBGadgetsPTR", CStr(MyDBPTR))
        t = SetProperty(Param, "DBGadgetStatus", "Added")
        ' see if there is a specific dbgadgets object to use as template
        t = ReadProperty(Param, "DB GadgetsPTR Template")
        ' this is if no specific dbgadget was given for the object template
        ' use dbgadget #1, if not
        If Val(t) = 0 Then
            t = 1
        End If
        DBPTRToUse = Val(t)
        ' set new dbgadget to the template one
        DBGadgets(MyDBPTR) = DBGadgets(DBPTRToUse)
        ' it's new gadget, save as such (id=0 forces save new object)
        DBGadgets(MyDBPTR).ObjectID = 0
        DBGadgets(MyDBPTR).Tag = "RegisterDatabase: MyDBPTR>DBGadgetsCNTR " & Now
        ' get a new dbgadget index
        t = ReadProperty(DBGadgetDef, "Last DBGadget Name Index")
        t = Val(t) + 1
        Msg = SetProperty(DBGadgetDef, "Last DBGadget Name Index", CStr(t))
        ' save the index to definition file
        MResults = Memorize(DBGadgetDef, VGBDatabaseNameAndPath)
        ' use the thisdbname variable to refer to this db, duh
        ThisDBName = UCase(ReadProperty(Param, "DB Name"))
        ' the dbgadgets name is the dbname + index (allows for same name, different dirs)
        DBGadgets(MyDBPTR).Name = ThisDBName & "-" & CStr(t)
        DBGadgets(MyDBPTR).Type = "DBGadget"
        DBGadgets(MyDBPTR).Container = "AppGadget"
        ' fix up all the properties of the new dbgadget
        t = SetProperty(DBGadgets(MyDBPTR), "DB Name", ThisDBName)
        Msg = ReadProperty(Param, "DB Path")
        t = SetProperty(DBGadgets(MyDBPTR), "Path", UCase(Msg))
        Msg = Format(Date, "mm/dd/yyyy") & " " & Format(Time, "Long Time")
        t = SetProperty(DBGadgets(MyDBPTR), "Date Created", Msg)
        Msg = ReadProperty(Param, "Created by")
        t = SetProperty(DBGadgets(MyDBPTR), "Created by", Msg)
        t = SetProperty(DBGadgets(MyDBPTR), "AutoOpen", "True")
        DBPathAndName = ReadProperty(DBGadgets(MyDBPTR), "Path")
        If Right(DBPathAndName, 1) <> "\" Then
            DBPathAndName = DBPathAndName & "\"
        End If
        DBPathAndName = DBPathAndName & ThisDBName
        ' this db is this dbgadget
        t = SetProperty(Param, "DBGadgetsPTR", CStr(MyDBPTR))
        t = SetProperty(Param, "DBGadgetStatus", "Added")
        ' bronze it
        MResults = Memorize(DBGadgets(MyDBPTR), VGBDatabaseNameAndPath)
        ' t = WriteGDSGadget(DBGadgets(MyDBPTR).ObjectID, DBGadgets(MyDBPTR))
    End If
    ' here, this db already has a db gadget defined
    ' is it already registered to this app?
    ' set the appdbgadget (these are db's for this app only)
    ' the appdbgadget is used to flag enabled per application
    ' format: appname + dbgadget name (has index number)
    Msg = UCase(App.EXEName) & "-" & UCase(DBGadgets(MyDBPTR).Name)
    For Cntr1 = 0 To AppDBGadgetsCNTR
        If AppDBGadgets(Cntr1).Name = Msg Then
            t = SetProperty(Param, "AppDBGadgetStatus", "Found")
            AppDBGadgetsPTR = Cntr1
            Exit For
        End If
    Next
    If Cntr1 > AppDBGadgetsCNTR Then
        ' not found, added
        AppDBGadgetsCNTR = AppDBGadgetsCNTR + 1
        AppDBGadgetsPTR = AppDBGadgetsCNTR
        ReDim Preserve AppDBGadgets(AppDBGadgetsPTR)
        AppDBGadgets(AppDBGadgetsPTR) = BlankObject
        AppDBGadgets(AppDBGadgetsPTR).Name = UCase(App.EXEName) & "-" & DBGadgets(MyDBPTR).Name
        AppDBGadgets(AppDBGadgetsPTR).ObjectID = 0
        AppDBGadgets(AppDBGadgetsPTR).Type = "AppDBGadget"
        AppDBGadgets(AppDBGadgetsPTR).Container = UCase(App.EXEName)
        AppDBGadgets(AppDBGadgetsPTR).Tag = "RegisterDatabase/AppDBGadgetsPTR > AppDBGadgetsCNTR"
        Msg = ReadProperty(Param, "Show DB to User")
        If Msg = NotFound Then
            Msg = "True"
        End If
        t = SetProperty(AppDBGadgets(AppDBGadgetsPTR), "DB Name", ThisDBName)
        t = SetProperty(AppDBGadgets(AppDBGadgetsPTR), "Show DB to User", Msg)
        t = SetProperty(AppDBGadgets(AppDBGadgetsPTR), "DBGadgets ID", CStr(DBGadgets(MyDBPTR).ObjectID))
        t = SetProperty(AppDBGadgets(AppDBGadgetsPTR), "Enabled", "True")
        t = SetProperty(AppDBGadgets(AppDBGadgetsPTR), "Open in this App?", "True")
        t = SetProperty(Param, "AppDBGadgetStatus", "Added")
    Else
        t = ReadProperty(AppDBGadgets(AppDBGadgetsPTR), "Enabled")
        If t = NotFound Then
            t = SetProperty(AppDBGadgets(AppDBGadgetsPTR), "Enabled", "True")
        End If
    End If
    MResults = Memorize(AppDBGadgets(AppDBGadgetsPTR), VGBDatabaseNameAndPath)
'    t = WriteGDSGadget(AppDBGadgets(AppDBGadgetsPTR).ObjectID, AppDBGadgets(AppDBGadgetsPTR))
    ' these are the recordsets for this app only
    For Cntr1 = 0 To AppRSGadgetsCNTR
        If UCase(ReadProperty(AppRSGadgets(Cntr1), "DB Name")) = ThisDBName Then
            If AppRSGadgets(Cntr1).Container = UCase(App.EXEName) Then
                Exit For
            End If
        End If
    Next
    If Cntr1 > AppRSGadgetsCNTR Then
        ' need to create all new app rs ojects
        For Cntr1 = 1 To 3
            Select Case True
                Case Cntr1 = 1
                    Msg = "Objects"
                Case Cntr1 = 2
                    Msg = "Props"
                Case Cntr1 = 3
                    Msg = "Methods"
            End Select
            AppRSGadgetsCNTR = AppRSGadgetsCNTR + 1
            AppRSGadgetsPTR = AppRSGadgetsCNTR
            ReDim Preserve AppRSGadgets(AppRSGadgetsCNTR)
            AppRSGadgets(AppRSGadgetsCNTR) = BlankObject
            AppRSGadgets(AppRSGadgetsCNTR).ObjectID = 0
            AppRSGadgets(AppRSGadgetsCNTR).Name = UCase(App.EXEName) & "-" & DBGadgets(MyDBPTR).Name & "-" & Msg
            AppRSGadgets(AppRSGadgetsCNTR).Type = "AppRSGadget"
            AppRSGadgets(AppRSGadgetsCNTR).Container = UCase(App.EXEName)
            t = SetProperty(AppRSGadgets(AppRSGadgetsCNTR), "DB Name", ThisDBName)
            t = SetProperty(AppRSGadgets(AppRSGadgetsCNTR), "RS Name", Msg & "RS")
            t = SetProperty(AppRSGadgets(AppRSGadgetsCNTR), "RS Source", Msg)
            t = SetProperty(AppRSGadgets(AppRSGadgetsCNTR), "RS Index", "?")
            t = ReadGadgetByName(AppRSGadgets(AppRSGadgetsCNTR).Name, ReadObjectBuffer)
            If t = OK Then
                AppRSGadgets(AppRSGadgetsCNTR).ObjectID = ReadObjectBuffer.ObjectID
            End If
            MResults = Memorize(AppRSGadgets(AppRSGadgetsCNTR), "in " & VGBDatabaseNameAndPath)
'            t = WriteGDSGadget(AppRSGadgets(AppRSGadgetsCNTR).ObjectID, AppRSGadgets(AppRSGadgetsCNTR))
        Next Cntr1
    End If
    ' this db is registered, need to open it?
    ResultsGadget = OpenJetDataBase(DBGadgets(MyDBPTR))
    GoTo EndSub
LocalError:
    LocalError = Error
    SetProperty Trace, NextID("trace") & "Register DB Trapped", "Error: " & Param.Name & " / " & LocalError
    SetProperty VGBErrors, NextID("error") & "Register DB Trapped", "Error: " & Param.Name & " / " & LocalError
    
'    MsgBox "Error in RegisterDatabase" & CrLf & LocalError, , UCase(App.EXEName) & " Debug Message"
    Resume Next
EndSub:
    On Error GoTo 0
    DBSwitch StartDBPTR
    SetProperty Trace, NextID("trace") & "RegisterDatabase End *********************************", "***"
    RegisterDatabase = ResultsGadget
End Function
Friend Function GODDeleteDatabase(Param As Gadget) As String
    ' delete a database!  WARNING: Permanent operation.  DB is Gone, Gone, Gone and Gone
    ' provide the database name and path in Param:
    '   "DBPath And Name"
    Dim t, Msg As String, Cntr1 As Integer, CNTR2 As Integer
    Dim LParam As Gadget
    Dim ResultsGadget As Gadget
    Dim DBPath As String, DBName As String, DBPathAndName As String
    Dim LDBFile As String
    Dim PromptUser As Boolean
    Dim StartDBGadgetsPTR As Integer
    Dim NumObjects As Long, NumProps As Long
    Dim TempDBGadgetsPTR As Integer
    Dim ClosedDBGadgetPTR As Integer
    Dim Result As String
    Dim LocalError As String
    LocalError = ""
    On Error GoTo LocalError
    Result = "Error"
    
    StartDBGadgetsPTR = DBGadgetsPTR
    DBPathAndName = ReadProperty(Param, "DBPath And Name")
    LParam = BlankObject
    t = SetProperty(LParam, "PathFile", DBPathAndName)
    ResultsGadget = ExtractPathAndFile(LParam)
    DBPath = UCase(ReadProperty(ResultsGadget, "Path Only"))
    DBName = UCase(ReadProperty(ResultsGadget, "File Only"))
    LDBFile = DBPath & UCase(ReadProperty(ResultsGadget, "File Name Without Extension"))
    LDBFile = LDBFile & ".LDB"
    PromptUser = (ReadProperty(Param, "Prompt User") = "True")
    For TempDBGadgetsPTR = 1 To DBGadgetsCNTR
        If ReadProperty(DBGadgets(TempDBGadgetsPTR), "DB Name") = DBName Then
            If UCase(AddBackSlash(ReadProperty(DBGadgets(TempDBGadgetsPTR), "Path"))) = DBPath Then
                Exit For
            End If
        End If
    Next
    If TempDBGadgetsPTR > DBGadgetsCNTR Then
        If PromptUser Then
            Msg = "Error Locating DB: "
            MsgBox Msg & DBPathAndName
        End If
        Result = Msg
        GoTo EndSub
    End If
    If TempDBGadgetsPTR < 2 Then
        If PromptUser Then
            Msg = ""
            Msg = Msg & "Sorry, Can't Delete a System File" & CrLf
            MsgBox Msg, vbExclamation, "Error: Can't Perform Delete"
        End If
        Result = Msg
        GoTo EndSub
    End If
    If Not FileExists(DBPathAndName) Then
        If PromptUser Then
            Msg = "File Not Found: " & CrLf
            Msg = Msg & DBPathAndName
            MsgBox "Error Locating DB: " & DBPathAndName
        End If
        Result = Msg
        GoTo EndSub
    End If
    Cntr1 = DBFindIndex(DBPathAndName)
    If Cntr1 < 0 Then
        '!!!!!!!! fix this
    End If
    t = DBSwitch(Cntr1)
    If t = OK Then
        NumObjects = ObjectsRS.RecordCount
        NumProps = PropsRS.RecordCount
    End If
    DBSwitch 1
    If PromptUser Then
        Msg = ""
        Msg = Msg & Space(13) & "WARNING!" & CrLf
        Msg = Msg & "DELETING IS PERMANENT!" & CrLf
        Msg = Msg & "  IT CANNOT BE UNDONE!" & CrLf & CrLf
        Msg = Msg & "You are about to Delete Database:" & CrLf
        Msg = Msg & DBPathAndName & CrLf
        Msg = Msg & "" & CrLf
        Msg = Msg & "Total Objects in Database: " & CStr(NumObjects) & CrLf
        Msg = Msg & "" & CrLf
        Msg = Msg & "Are You ABSOLUTELY Sure About this?" & CrLf
        t = MsgBox(Msg, vbExclamation + vbYesNo + vbDefaultButton2, "Confirm DELETE Database")
        If t <> vbYes Then
            Result = "Aborted By User"
            GoTo EndSub
        End If
    End If
    GDSMsg.Caption = "Deleting Database"
    GDSMsg.CommandClose.Visible = False
    GDSMsg.Show
    GDSMsg.WindowState = NORMAL
    GDSMsg.MsgText.Visible = True
    GDSMsg.MsgText = ""
    GDSMsg.MsgText = GDSMsg.MsgText & "Please wait while I delete the Database and Reinitialize the System.  This will take a few seconds" & CrLf
'    DoEvents
    
    ' well, let's delete it
    ' which one is it?
'    Screen.MousePointer = NORMAL
    ClosedDBGadgetPTR = TempDBGadgetsPTR
    OpenDB(TempDBGadgetsPTR).Close
    LocalError = ""
    ' now erase file
    Kill DBPathAndName
    If LocalError <> "" Then
        If PromptUser Then
            MsgBox LocalError, , UCase(App.EXEName) & " Debug Message"
        End If
        Result = LocalError
    Else
        Result = OK
    End If
    If FileExists(LDBFile) Then
        Kill LDBFile
    End If
    GDSMsg.Caption = "Reinitializing System"
    LParam.Name = "Reset"
    InitVGB LParam
'    GDSRegistry.ListIndex = GDSRegistry.ListIndex - 1
    Unload GDSMsg
'    If PromptUser Then
'        MsgBox "File Deleted, System Reinitialized", vbInformation, "Delete Complete"
'    End If
    
    GoTo EndSub
LocalError:
    LocalError = Error
    Resume Next
EndSub:
    On Error GoTo 0
'    Screen.MousePointer = NORMAL
    GODDeleteDatabase = Result
End Function

Friend Function OpenJetDataBase(DBGadgetToUse As Gadget) As Gadget
    ' open a db based on the dbgadget passed
    Dim t, Msg As String, Msg2 As String, Cntr1 As Integer, CNTR2 As Integer, Cntr3 As Integer
    Dim RREsults As Gadget, MResults As Gadget
    Dim StartDBGPTR As Integer
    Dim starttime As Single
    Dim OpenThisDB As String
    starttime = Timer
    Dim DBProp As String, AppPath As String
    Dim LocDBGadget As Gadget
    Dim DBPathAndName As String
    Dim ThisDBName As String
    Dim CurrOpenDBPTR As Integer
    Dim ForceOpenDBPTR As Integer
    Dim CorrectDBGPTR As Integer
    Dim WriteAppDBCntr As Integer
    Dim Result As String
    Dim ResultsGadget As Gadget
    Dim LocalError As String
    StartDBGPTR = DBGadgetsPTR
    On Error GoTo LocalError
'    DoEvents
    Result = OK
    ' work with local copy of dbgadget
    LocDBGadget = DBGadgetToUse

    SetProperty Trace, NextID("trace") & "OpenJetDataBase", DBGadgetToUse.Name
    ' this allows us to open a given database in a forced array index
    Msg = ReadProperty(LocDBGadget, "Force OpenDBPTR")
    If Msg = NotFound Then
        ForceOpenDBPTR = -1
    Else
        ForceOpenDBPTR = Val(Msg)
    End If
    ThisDBName = ReadProperty(LocDBGadget, "DB Name")
    If ThisDBName = NotFound Then
        If Not ExecutingSchedule Then
            FloatMsgBox "DB Name Not Found", UCase(App.EXEName) & " Debug Message"
        End If
    End If
    DBPathAndName = ReadProperty(LocDBGadget, "Path")
    If Right(DBPathAndName, 1) <> "\" Then
        DBPathAndName = DBPathAndName & "\"
    End If
    DBPathAndName = DBPathAndName & ThisDBName
    DBPathAndName = UCase(DBPathAndName)
    ' set the dbgadgetsptr to this dbgadget
    For DBGadgetsPTR = 0 To DBGadgetsCNTR
        If DBGadgets(DBGadgetsPTR).Name = DBGadgetToUse.Name Then
            CorrectDBGPTR = DBGadgetsPTR
            Exit For
        End If
    Next
    If DBGadgetsPTR > DBGadgetsCNTR Then
        ' severe error if this dbgadget isn't found
        FloatMsgBox " Error: " & DBGadgetToUse.Name & " Not found in DB Definitions", UCase(App.EXEName) & " Debug Message"
    End If
    OpenThisDB = "Open This DB"
    If ForceOpenDBPTR < 0 Then
        For Cntr1 = 0 To OpenDBCNTR
            LocalError = ""
            If UCase(OpenDB(Cntr1).Name) = UCase(DBPathAndName) Then
                ' this db is already open
                If LocalError = "" Then
                    OpenThisDB = "Do Not Open This DB"
                    Exit For
                End If
            End If
        Next Cntr1
    Else
'        DBSwitch 1
    End If
    LocalError = ""
    ' the db is not open, let's see if it is flagged to open in this app
    ' autoopen in dbgadgets doesn't override appdbgadget setting
    For Cntr1 = 1 To AppDBGadgetsCNTR
        WriteAppDBCntr = 0
        ' check name to see if this is it
        If ReadProperty(AppDBGadgets(Cntr1), "DB Name") = ThisDBName Then ' AppDBGadgets(Cntr1).Name = Msg Then
            ' this is the correct appdbgadget, should we open it?
            Msg2 = ReadProperty(AppDBGadgets(Cntr1), "Open in this App?")
            Select Case True
                Case (UCase(ThisDBName) = "RWS.RWS" And OpenThisDB = "Open This DB") Or (ForceOpenDBPTR > 0)
                    Exit For
                Case ForceOpenDBPTR > 0
                    ' this makes us open it temporarily
                    
'                Case ReadProperty(LocDBGadget, "AutoOpen") And Msg = "Open This DB"
'                    ' don't do anything, let it open file
'                    Exit For
                Case Msg2 = "False"
                    ' don't open this file for this application
                    OpenThisDB = "Do Not Open"
                    CorrectDBGPTR = 1
                    ' we need to create an opendb array object as to maintain the
                    ' 1 to 1 relationship of open db's to dbgadgets
                    OpenDBCNTR = OpenDBCNTR + 1
                    ReDim Preserve OpenDB(OpenDBCNTR)
                    Exit For
                Case (Msg2 = NotFound) And (OpenThisDB = "Open This DB")
                    ' this is an old database.  flag hasn't been updated yet
                    ' and it is not already open
                    ' ask user if they want to open this one every time
                        ' flag it thus
                        CorrectDBGPTR = 1
                        t = SetProperty(AppDBGadgets(Cntr1), "Open in this App?", "True")
                        ' we need to create an opendb array object as to maintain the
                        ' 1 to 1 relationship of open db's to dbgadgets
                        OpenDBCNTR = OpenDBCNTR + 1
                        ReDim Preserve OpenDB(OpenDBCNTR)
                        WriteAppDBCntr = Cntr1
                    Exit For
            End Select
        End If
    Next Cntr1
    ' /////////////////////////////////////////////////////
    ' do the actual open
    If (OpenThisDB = "Open This DB") Then
        Msg = ReadProperty(LocDBGadget, "Path")
        JetDatabasePath = Msg
        If Right(JetDatabasePath, 1) <> "\" Then
            JetDatabasePath = JetDatabasePath & "\"
        End If
        If (CurDir <> JetDatabasePath) And _
           (CurDir <> Left(JetDatabasePath, Len(JetDatabasePath) - 1)) Then
            ChDrive Left(JetDatabasePath, 1)
            ChDir Right(JetDatabasePath, Len(JetDatabasePath) - 2)
        End If
        CurrentObject = LocDBGadget
        JetDatabaseName = JetDatabasePath & ThisDBName
        ' open the file
        LocalError = ""
        DBEngine.IniPath = App.Path
        DBEngine.DefaultUser = ReadProperty(CurrentObject, "DU")
        DBEngine.DefaultPassword = ReadProperty(CurrentObject, "DP")
        Set JetDatabase = GadgetWorkspace.OpenDatabase(JetDatabaseName)
        If LocalError <> "" Then
            ' got an error
            ResultsGadget.Name = "Error:" & LocalError
            LocalError = ""
            GoTo EndSub
        End If
        If ForceOpenDBPTR < 0 Then
            OpenDBCNTR = OpenDBCNTR + 1
            OpenDBPTR = OpenDBCNTR
            ReDim Preserve OpenDB(OpenDBPTR)
        Else
            OpenDBPTR = ForceOpenDBPTR
        End If
        Set OpenDB(OpenDBPTR) = JetDatabase
        CurrOpenDBPTR = OpenDBPTR
        ' now open all the recordsets
        For CNTR2 = 0 To AppRSGadgetsCNTR
            OpenDBPTR = CurrOpenDBPTR
            DBGadgetsPTR = CorrectDBGPTR
            If CurrOpenDBPTR <> OpenDBPTR Then
                MsgBox "Open DBPTR Changed", , UCase(App.EXEName) & " Debug Message"
            End If
            If CorrectDBGPTR <> DBGadgetsPTR Then
                MsgBox "DBG Changed", , UCase(App.EXEName) & " Debug Message"
            End If
            If ReadProperty(AppRSGadgets(CNTR2), "DB Name") = ThisDBName Then
                t = ReadProperty(AppRSGadgets(CNTR2), "RS Index")
                Select Case True
                    Case ReadProperty(AppRSGadgets(CNTR2), "RS Source") = "Objects"
                        If t = "?" Or (ForceOpenDBPTR >= 0) Then
                            Set ObjectsRS = OpenDB(OpenDBPTR).OpenRecordset("Objects", dbOpenTable)
                            ObjectsRS.MoveFirst
'                            MsgBox ObjectsRS.RecordCount
                            ObjectsRS.LockEdits = False
                            If ForceOpenDBPTR < 0 Then
                                ' need to add this one
                                OpenRSCNTR = OpenRSCNTR + 1
                                OpenRSPTR = OpenRSCNTR
                                ReDim Preserve OpenRS(OpenRSCNTR)
                                Set OpenRS(OpenRSPTR) = ObjectsRS
'                                ObjectsRS.MoveFirst
                                t = SetProperty(AppRSGadgets(CNTR2), "RS Index", CStr(OpenRSCNTR))
'                                t = WriteGDSGadget(AppRSGadgets(Cntr2).ObjectID, AppRSGadgets(Cntr2))
                            Else
                                ' force situation (force open in given index)
                                ' need to find the correct apprsgadget for this record set
                                ' it was created upon startup
                                Msg = UCase(App.EXEName) & "-" & DBGadgetToUse.Name & "-" & "Objects"
                                For Cntr3 = 0 To AppRSGadgetsCNTR
                                    If AppRSGadgets(Cntr3).Name = Msg Then
                                        Exit For
                                    End If
                                Next Cntr3
                                If Cntr3 > OpenRSCNTR Then
                                    OpenRSCNTR = OpenRSCNTR + 1
                                    OpenRSPTR = OpenRSCNTR
                                    ReDim Preserve OpenRS(OpenRSCNTR)
                                Else
                                    OpenRSPTR = Cntr3
                                End If
                                Set OpenRS(OpenRSPTR) = ObjectsRS
'                                ObjectsRS.MoveFirst
                                t = SetProperty(AppRSGadgets(CNTR2), "RS Index", CStr(OpenRSPTR))
'                                t = WriteGDSGadget(AppRSGadgets(Cntr2).ObjectID, AppRSGadgets(Cntr2))
                            End If
                            
'                            ShowObject Dematerialize(AppRSGadgets(Cntr2)), "m"
                        Else
                            Set ObjectsRS = OpenRS(Val(t))
                            ObjectsRS.MoveFirst
                        End If
'                        MsgBox ObjectsRS.RecordCount
                    Case ReadProperty(AppRSGadgets(CNTR2), "RS Source") = "Props"
                        If t = "?" Or (ForceOpenDBPTR >= 0) Then
                            Set PropsRS = OpenDB(OpenDBPTR).OpenRecordset("Props", dbOpenTable)
                            PropsRS.MoveFirst
                            PropsRS.LockEdits = False
                            If ForceOpenDBPTR < 0 Then
                                ' need to add this one
                                OpenRSCNTR = OpenRSCNTR + 1
                                OpenRSPTR = OpenRSCNTR
                                ReDim Preserve OpenRS(OpenRSCNTR)
                                Set OpenRS(OpenRSPTR) = PropsRS
                                PropsRS.MoveFirst
                                t = SetProperty(AppRSGadgets(CNTR2), "RS Index", CStr(OpenRSCNTR))
'                                t = WriteGDSGadget(AppRSGadgets(Cntr2).ObjectID, AppRSGadgets(Cntr2))
                            Else
                                ' force situation (force open in given index)
                                ' need to find the correct apprsgadget for this record set
                                ' it was created upon startup
                                Msg = UCase(App.EXEName) & "-" & DBGadgetToUse.Name & "-" & "Props"
                                For Cntr3 = 0 To AppRSGadgetsCNTR
                                    If AppRSGadgets(Cntr3).Name = Msg Then
                                        
                                        Exit For
                                    End If
                                Next Cntr3
                                If Cntr3 > OpenRSCNTR Then
                                    OpenRSCNTR = OpenRSCNTR + 1
                                    OpenRSPTR = OpenRSCNTR
                                    ReDim Preserve OpenRS(OpenRSCNTR)
                                Else
                                    OpenRSPTR = Cntr3
                                End If
'                                OpenRSPTR = Val(ReadProperty(AppRSGadgets(Cntr2), "RS Index"))
                                Set OpenRS(OpenRSPTR) = PropsRS
                                PropsRS.MoveFirst
                                t = SetProperty(AppRSGadgets(CNTR2), "RS Index", CStr(OpenRSPTR))
'                                t = WriteGDSGadget(AppRSGadgets(Cntr2).ObjectID, AppRSGadgets(Cntr2))
                            End If
                            
                        Else
                            Set PropsRS = OpenRS(Val(t))
                            PropsRS.MoveFirst
                        End If
                    Case ReadProperty(AppRSGadgets(CNTR2), "RS Source") = "Methods"
                        If t = "?" Or (ForceOpenDBPTR >= 0) Then
                            Set MethodsRS = OpenDB(OpenDBPTR).OpenRecordset("Methods", dbOpenTable)
'                            MethodsRS.MoveFirst
                            MethodsRS.LockEdits = False
                            If ForceOpenDBPTR < 0 Then
                                ' need to add this one
                                OpenRSCNTR = OpenRSCNTR + 1
                                OpenRSPTR = OpenRSCNTR
                                ReDim Preserve OpenRS(OpenRSCNTR)
                                Set OpenRS(OpenRSPTR) = MethodsRS
'                                MethodsRS.MoveFirst
                                t = SetProperty(AppRSGadgets(CNTR2), "RS Index", CStr(OpenRSCNTR))
'                                t = WriteGDSGadget(AppRSGadgets(Cntr2).ObjectID, AppRSGadgets(Cntr2))
                            Else
                                ' force situation (force open in given index)
                                ' need to find the correct apprsgadget for this record set
                                ' it was created upon startup
                                Msg = UCase(App.EXEName) & "-" & DBGadgetToUse.Name & "-" & "Methods"
                                For Cntr3 = 0 To AppRSGadgetsCNTR
                                    If AppRSGadgets(Cntr3).Name = Msg Then
                                        
                                        Exit For
                                    End If
                                Next Cntr3
                                If Cntr3 > OpenRSCNTR Then
                                    OpenRSCNTR = OpenRSCNTR + 1
                                    OpenRSPTR = OpenRSCNTR
                                    ReDim Preserve OpenRS(OpenRSCNTR)
                                Else
                                    OpenRSPTR = Cntr3
                                End If
                                
'                                OpenRSPTR = Val(ReadProperty(AppRSGadgets(Cntr2), "RS Index"))
                                Set OpenRS(OpenRSPTR) = MethodsRS
'                                MethodsRS.MoveFirst
                                t = SetProperty(AppRSGadgets(CNTR2), "RS Index", CStr(OpenRSPTR))
'                                t = WriteGDSGadget(AppRSGadgets(Cntr2).ObjectID, AppRSGadgets(Cntr2))
                            End If
                            
 '                           ShowObject Dematerialize(AppRSGadgets(Cntr2)), "m"
'                            If t <> OK Then
'                                If Not ExecutingSchedule Then
'                                    MsgBox t, , "Open DB"
'                                End If
'                            End If
                        Else
                            Set MethodsRS = OpenRS(Val(t))
'                            MethodsRS.MoveFirst
                        End If
                End Select
            End If
        Next CNTR2
        ' //////////////////////////////////////////////////////////////////////////
'removed 5/18/00        If WriteAppDBCntr > 0 Then
'
'            MResults = Memorize(AppDBGadgets(WriteAppDBCntr), "in " & VGBDatabaseNameAndPath)
'            'Msg = WriteGDSGadget(AppDBGadgets(WriteAppDBCntr).ObjectID, AppDBGadgets(WriteAppDBCntr))
'        End If
'        DBSwitch 0
'        For Cntr2 = 0 To AppRSGadgetsCNTR
'            LocDBGadget = BlankObject
'            t = ReadGadgetByName(AppRSGadgets(Cntr2).Name, LocDBGadget)
'            If t = OK Then
'                AppRSGadgets(Cntr2).ObjectID = LocDBGadget.ObjectID
'            End If
'            MResults = Memorize(AppRSGadgets(Cntr2), "in " & VGBDatabaseNameAndPath)
'            't = WriteGDSGadget(AppRSGadgets(Cntr2).ObjectID, AppRSGadgets(Cntr2))
'        Next
    End If
    GoTo EndSub
LocalError:
    LocalError = Error
    SetProperty Trace, NextID("trace") & "Open DB Error", "Error: " & DBGadgetToUse.Name & "/" & LocalError
    SetProperty VGBErrors, NextID("error") & "Open DB Error", "Error: " & DBGadgetToUse.Name & "/" & LocalError
    If Not ExecutingSchedule And LocalError <> "Object variable or With block variable not set" Then
'        MsgBox "Open DB Error: " & LocalError, , ucase(App.EXEName) & " Debug Message"
    End If
    Resume Next
EndSub:
    DBSwitch CorrectDBGPTR
    Msg = "DB Open Time: " & Timer - starttime & CrLf
    GDSFreelocks
    If LocalError <> "" Then
        Result = LocalError
    End If
    On Error GoTo 0
    OpenJetDataBase = ResultsGadget
'    DoEvents
'    MsgBox Msg
End Function

Friend Function GODAddObject(AddContainer As String, _
                             AddObjectType As String, _
                             AddName As String, _
                             AddMode As String) As Long
    Dim t, Msg As String, Crit As String, AddIt As Boolean, Cntr1 As Integer
    Dim ObjectWasAdded As Boolean, AddedObjectID As Long
    Dim PropType As Integer, Property As String, PropertyValue As String, PropSource As String
    Dim UserResponse As String, ManualAdd As Boolean
    Dim LocalError As String
    LocalError = ""
    On Error GoTo LocalError
    ManualAdd = False
    AddIt = UCase(AddMode) = "UNCONDITIONAL"
    If UCase(AddName) = "ASK FOR" Or _
       UCase(AddMode) = "ASK FOR" Then
        ManualAdd = True
        Msg = "Enter a Name for the New Object." & CrLf
        Msg = Msg & "Or" & CrLf
        Msg = Msg & "Enter 'CLONE' to duplicate: " & AddName & CrLf
        UserResponse = InputBox(Msg, "Manual Object Add")
        Select Case True
            Case UserResponse = ""
                AddedObjectID = -9999
                GoTo EndGOAO
            Case UCase(UserResponse) = "CLONE"
                MsgBox "Fix This"
                Msg = "Enter a New Name for the cloned object:"
'                UserResponse = InputBox(Msg, "Manual Object Add", Heaven16.ObjectList)
                If UserResponse = "" Then
                    AddedObjectID = -9999
                    GoTo EndGOAO
                End If
                AddName = UserResponse
                ' look up name and write it as objectid 0
'                AddedObjectID = GODCloneObject(Currentform.Data_Objects.Recordset!ObjectID, _
                                               AddName)
                GoTo EndGOAO
        End Select
        AddName = UserResponse
        If AddObjectType = "" Then
            AddObjectType = InputBox("Enter an Object Type:", "Manual Object Add")
        End If
    End If
    If AddContainer = "" Then
        AddContainer = "User"
    End If
    If AddObjectType = "" Then
        AddObjectType = "User"
    End If
    ObjectsRS.Index = "Name"
    ObjectsRS.Seek "=", AddName
    AddIt = (ObjectsRS.NoMatch = True) Or AddIt
    If UCase(AddMode) = "RETAIN" And ObjectsRS.NoMatch = False Then
        ' need to see if this object is exactly like the one sent
        AddIt = False
        Do While ObjectsRS!Name = AddName
            If ObjectsRS!Container <> AddContainer Or _
               ObjectsRS!Type <> AddObjectType Then
                AddIt = True
            End If
            ObjectsRS.MoveNext
            If ObjectsRS.EOF Then
                Exit Do
            End If
        Loop
    End If
    GadgetWorkspace.BeginTrans
    Select Case True
        Case AddIt = True
            ObjectsRS.AddNew
            ObjectWasAdded = True
        Case AddIt = False
            If ObjectsRS!Name <> AddName Then
                ObjectsRS.Seek "=", AddName
                If ObjectsRS.NoMatch Then
                    MsgBox "ERROR in object add function, can't find the original object", , "GDS Error"
                    AddedObjectID = -99
                    GadgetWorkspace.CommitTrans
                    GoTo EndGOAO:
                End If
            End If
            ObjectsRS.Edit
            ObjectWasAdded = False
    End Select
    ObjectsRS![GAppName] = UCase(App.EXEName)
    ObjectsRS![Container] = AddContainer
    ObjectsRS![Type] = AddObjectType
    ObjectsRS![Name] = AddName
    LocalError = ""
    ObjectsRS.Update
    If LocalError <> "" Then
        Cntr1 = 0
        Do While Cntr1 <= 50
            GDSFreelocks
            LocalError = ""
            WasteTime 0.1
            ObjectsRS.Update
            If LocalError = "" Then
                Exit Do
            End If
            Cntr1 = Cntr1 + 1
        Loop
    End If
    GadgetWorkspace.CommitTrans
    If InStr(LocalError, "LOCKED") > 0 Then
        Msg = "Add Object Record Locked" & CrLf
        Msg = Msg & LocalError
        MsgBox Msg, , UCase(App.EXEName) & " Debug Error"
    End If
    ObjectsRS.Bookmark = ObjectsRS.LastModified
    AddedObjectID = ObjectsRS![ObjectID]
    GoTo EndGOAO:
LocalError:
    LocalError = UCase(Error)
    Resume Next
EndGOAO:
    LocalError = ""
    Do While LocalError = ""
        GadgetWorkspace.CommitTrans
    Loop
    GODAddObject = AddedObjectID
    GDSFreelocks
    On Error GoTo 0
End Function
Friend Function GODAddObjectFromDNA(ByVal ObjectToUseID As Long, _
                                    ByVal Objectparent As String, _
                                    ByVal PromptUser As Boolean, _
                                    ByVal X As Single, _
                                    ByVal Y As Single) As String
    ' this routine will generically add any new object given the object and DNA
    ' it will also add all DNA objects (as children) listed in the DNA object
    
' There was a time when I felt like cryin'
' Felt like cryin', cryin' the blues
' All because of a lot of women like you

    Dim t, Msg As String, Prompt As String, Result As String
    Dim px As Integer, py As Integer, ObjectNameExists As Boolean
    Dim ObjectAddedThisPass As Gadget, AddedObjectID As Long
    Dim AddContainer As String
    Dim AddObjectType As String
    Dim AddName As String, CheckName As String
    Dim AddMode As String
    Dim PropType As Integer
    Dim Property As String
    Dim PropertyValue As String
    Dim PropSource As String
    Dim AddPropType As Integer
    Dim AddProperty As String
    Dim AddPropertyValue As String
    Dim AddPropSource As String
    Dim DNA As Gadget, DNAName As String
    Dim ThisLevel As Integer
    On Error GoTo 0
    Result = "OK"
    DNAName = GODReadProperty(ObjectToUseID, "DNA")
    ' read the DNA object to get the parameters for this add
    ' get the name of the DNA object
    t = ReadGadgetByName(DNAName, DNA)
    If t <> "OK" Then
        MsgBox t, , UCase(App.EXEName) & " Debug Message"
        GoTo EndGAOFT:
    End If
    ' get the add level (nodes only)
    ThisLevel = Val(GODReadProperty(DNA.ObjectID, "Add Level"))
    If ThisLevel = 0 Then ThisLevel = 1
    ' get the prompt for adding
    Prompt = GODReadProperty(DNA.ObjectID, "Add Prompt")
    ' set the parent
    Select Case True
        Case InStr(UCase(Prompt), "ERROR") > 0 _
             And InStr(UCase(Prompt), "NOT FOUND") > 0
            MsgBox "Cannot Add This Object Type", vbOKOnly, "FYI"
            GoTo EndGAOFT
        Case Objectparent <> "?"
        Case ThisLevel > 1
            Objectparent = GODReadProperty(ObjectToUseID, "Parent")
        Case ThisLevel = 1
            Objectparent = "None"
    End Select
    If InStr(UCase(Objectparent), "TIMES") > 0 Then
        MsgBox Objectparent, , UCase(App.EXEName) & " Debug Message"
    End If
    If InStr(UCase(Objectparent), "ERROR") > 0 Then
        Objectparent = "None"
    End If
    If Objectparent <> "None" Then
        t = ReadGadgetByID(Val(Objectparent))
        Prompt = Prompt & " for: " & CrLf & ReadObjectBuffer.Name & "?"
    Else
        Prompt = Prompt & "?"
    End If
    If PromptUser = True Then
        t = MsgBox(Prompt, vbOKCancel, "Confirm Add Object")
    Else
        t = vbOK
    End If
    If t = vbCancel Then
        Result = "Cancelled"
        GoTo EndGAOFT
    End If
    ' they want to add
    'add the object
    AddContainer = GODReadProperty(DNA.ObjectID, "Container")
    AddObjectType = GODReadProperty(DNA.ObjectID, "ObjectType")
    AddName = GODReadProperty(DNA.ObjectID, "Default Name")
    If InStr(UCase(AddName), "ERROR") > 0 Then
        MsgBox "Name Error:" & AddName
        GoTo EndGAOFT:
    End If
    py = 0
    CheckName = AddName
    ' get rid of ambiguous object names
'    Do
'        ObjectNameExists = False
'        Crit = "Name='" & Checkname & "'"
'        Screen.ActiveForm.Data_Objects.Recordset.FindFirst Crit
'        If Screen.ActiveForm.Data_Objects.Recordset.NoMatch = False Then
'            ObjectNameExists = True
'        End If
'        If ObjectNameExists = False Then
'            AddName = Checkname
'            Exit Do
'        Else
'            py = py + 1
'            Checkname = ""
'            Checkname = AddName & " #" & Str(py)
'        End If
'    Loop Until True = False
'    MsgBox AddName
    AddMode = "Unconditional"
    AddedObjectID = GODAddObject(AddContainer, _
                    AddObjectType, _
                    AddName, _
                    AddMode)
    ' update recordset
'    Screen.ActiveForm.Data_Objects.Recordset.Requery
    ' change the level to the correct value
    t = ReadGadgetByID(AddedObjectID)
    ' use a temporary, local gadget to hold this new object
    ObjectAddedThisPass = ReadObjectBuffer
    ObjectAddedThisPass.Level = ThisLevel
    t = WriteMemGadget(ObjectAddedThisPass.ObjectID, ObjectAddedThisPass)
    ' Add all Props
    Dim AddNow As Boolean
    Result = ObjectAddedThisPass.ObjectID
    CurrentObject = ReadObjectBuffer
    For px = 1 To DNA.TotalProperties
        AddNow = False
        Select Case True
            Case UCase(DNA.Propity(px)) = "CHILD"
                ' this property is a child dna, need to add it
                Dim NewObject As Long
                NewObject = Val(DNA.ValueAlpha(px))
                
                t = GODAddObjectFromDNA(NewObject, _
                                        AllTrim(Str(AddedObjectID)), _
                                        False, X, Y)
                ' need to add the reference to this object as property
                ' this depends on which name was selected by add from dna
                ' function GODAddObjectFromDNA returns added object's objectid
'                AddProperty = "Child"
'                AddPropertyValue = AllTrim(Str(t))
'                AddPropSource = "User"
'                AddPropType = 0
'                t = GODAddOneProperty(AddedObjectID, _
                                      AddPropType, _
                                      AddProperty, _
                                      AddPropertyValue, _
                                      AddPropSource)
                                        
            Case DNA.PropType(px) = 0 'system, don't add to new object
            Case DNA.PropType(px) = 1 ' user
                AddPropType = 1
                AddNow = True
            Case DNA.PropType(px) = 2 And UCase(DNA.ValueAlpha(px)) <> "CHILD" ' copy as system
                AddNow = True
                AddPropType = 0
            Case DNA.PropType(px) = 3 ' copy as user
                AddNow = True
                AddPropType = 1
        End Select
        If AddNow = True Then
            AddProperty = DNA.Propity(px)
            AddPropertyValue = DNA.ValueAlpha(px)
            AddPropSource = "User"
            t = GODAddOneProperty(AddedObjectID, _
                                  AddPropType, _
                                  AddProperty, _
                                  AddPropertyValue, _
                                  AddPropSource)
        End If
    Next
    ' .selecteditem.parent
    AddPropType = 0
    AddProperty = "Parent"
    If ObjectAddedThisPass.Level > 1 Then
        AddPropertyValue = Objectparent
    Else
        AddPropertyValue = "None"
    End If
    AddPropSource = "User"
    t = GODAddOneProperty(AddedObjectID, _
                          AddPropType, _
                          AddProperty, _
                          AddPropertyValue, _
                          AddPropSource)
    If (AddPropertyValue = Objectparent) And Objectparent <> "None" Then
        ' need to add this object as child to its parent
        AddPropType = 0
        AddProperty = "Child"
        AddPropertyValue = CStr(AddedObjectID)
        AddPropSource = "User"
        t = GODAddOneProperty(CLng(Val(Objectparent)), _
                              AddPropType, _
                              AddProperty, _
                              AddPropertyValue, _
                              AddPropSource)
    End If
'    Screen.ActiveForm.Data_Objects.Recordset.Requery
'    Screen.ActiveForm.Data_ALLProperties.Recordset.Requery
    t = ReadGadgetByID(AddedObjectID)
    CurrentObject = ReadObjectBuffer
EndGAOFT:
    GODAddObjectFromDNA = Result
    GDSFreelocks
End Function
Friend Function DeleteGadget(ObjectToDeleteID As Long) As String
    ' this will delete one object and all Props and methods
    ' the caller must handle relationships, dependencies and links
    Dim t, Result As String, SQLCmd As String
    Dim starttime As Single
    starttime = Timer
    Dim DelCntr As Long
    Dim ContainerToDelete As String
    Dim LocalError As String
    Dim TempRS As Recordset
    Set TempRS = OpenDB(OpenDBPTR).OpenRecordset("Objects", dbOpenTable)
    LocalError = ""
    On Error GoTo LocalError
    ObjectsRS.Index = "PrimaryKey"
    ObjectsRS.Seek "=", ObjectToDeleteID
    If ObjectsRS.NoMatch = True Then
        Result = NotFound
        GoTo EndSub
    End If
    ObjectsRS.Delete
    Result = OK
GoTo EndSub




'    Do While ObjectsRS.NoMatch = False
'        LocalError = ""
'        ObjectsRS.Delete
'        If LocalError <> "" Then
''            MsgBox "Delete failed: " & t, , ucase(App.EXEName) & " Debug Message"
'        End If
'        DelCntr = DelCntr + 1
'        If DelCntr Mod 20 = 0 Then
''            DoEvents
'        End If
'        TempRS.ObjectsRS
'        If ObjectsRS.EOF Then Exit Do
'        If ObjectsRS!ObjectID <> ObjectsRS Then Exit Do
'    Loop
    
    
    TempRS.Index = "Container"
    ContainerToDelete = CStr(ObjectToDeleteID)
    TempRS.Seek "=", ContainerToDelete
    Do While TempRS.NoMatch = False
        LocalError = ""
        TempRS.Delete
        If LocalError <> "" Then
'            MsgBox "Delete failed: " & t, , ucase(App.EXEName) & " Debug Message"
        End If
        DelCntr = DelCntr + 1
        If DelCntr Mod 10 = 0 Then
'            DoEvents
        End If
        TempRS.MoveNext
        If TempRS.EOF Then Exit Do
        If TempRS!Container <> ContainerToDelete Then Exit Do
    Loop
    PropsRS.Index = "ObjectID"
    ContainerToDelete = CStr(ObjectToDeleteID)
    PropsRS.Seek "=", ObjectToDeleteID
    If PropsRS.NoMatch = False Then
        If Not ExecutingSchedule Then
            MsgBox "Delete Failed to remove Properties", , UCase(App.EXEName) & " Debug Message"
        End If
    End If
    If LocalError = "" Then
        Result = OK
    Else
        Result = LocalError
    End If
'
    GoTo EndSub
    Result = "OK"
    SQLCmd = ""
    SQLCmd = SQLCmd & "DELETE DISTINCTROW Objects.*, Objects.ObjectID "
    SQLCmd = SQLCmd & "From Objects "
    SQLCmd = SQLCmd & "WHERE ((Objects.ObjectID=" & ObjectToDeleteID & "));"
'    MsgBox SQLCmd
    OpenDB(OpenDBPTR).Execute SQLCmd
    SQLCmd = ""
    SQLCmd = SQLCmd & "DELETE DISTINCTROW Props.ObjectID, "
    SQLCmd = SQLCmd & "Props.Property, "
    SQLCmd = SQLCmd & "Props.ValueAlpha "
    SQLCmd = SQLCmd & "From Props "
    SQLCmd = SQLCmd & "WHERE Props.ObjectID=" & ObjectToDeleteID & ";"
'    MsgBox SQLCmd
    OpenDB(OpenDBPTR).Execute SQLCmd
    
    ' now delete all references to this objects as child or parent
    Dim StringID
    StringID = AllTrim(Str(ObjectToDeleteID))
    SQLCmd = ""
    SQLCmd = SQLCmd & "DELETE DISTINCTROW Props.ObjectID, "
    SQLCmd = SQLCmd & "Props.Property, "
    SQLCmd = SQLCmd & "Props.ValueAlpha "
    SQLCmd = SQLCmd & "From Props "
    SQLCmd = SQLCmd & "WHERE (Props.property='Parent' or "
    SQLCmd = SQLCmd & "Props.property='Child') and Props.valuealpha='" & StringID & "';"
'    MsgBox SQLCmd
    OpenDB(OpenDBPTR).Execute SQLCmd
    
    SQLCmd = ""
    SQLCmd = SQLCmd & "Delete DISTINCTROW Methods.ObjectID "
    SQLCmd = SQLCmd & "From Methods "
    SQLCmd = SQLCmd & "WHERE ObjectID=" & ObjectToDeleteID & ";"
    OpenDB(OpenDBPTR).Execute SQLCmd
    
    ' need to delete all objects that have this object as their container
    SQLCmd = ""
    SQLCmd = SQLCmd & "DELETE DISTINCTROW Objects.*, Objects.ObjectID "
    SQLCmd = SQLCmd & "From Objects "
    SQLCmd = SQLCmd & "WHERE ((Objects.Container='" & ObjectToDeleteID & "'));"
    OpenDB(OpenDBPTR).Execute SQLCmd
'    MsgBox SQLCmd

    GoTo EndSub:
LocalError:
    LocalError = Error$
    Result = LocalError
    
    SetProperty Trace, NextID("trace") & "DeleteGadget Trapped Error", LocalError
    SetProperty VGBErrors, NextID("error") & "DeleteGadget Trapped Error", LocalError
    If Not ExecutingSchedule Then
        MsgBox LocalError, , UCase(App.EXEName) & " Debug Message"
    End If
    Resume Next
EndSub:
    DeleteGadget = Result
    GDSFreelocks
    If Not ExecutingSchedule Then
'        MsgBox "Deleted: " & DelCntr & CrLf & Timer - starttime
    End If
End Function

Friend Function GODAddOneProperty(ByVal AddObjectID As Long, _
                                  ByVal AddPropType As Integer, _
                                  ByVal AddProperty As String, _
                                  ByVal AddPropertyValue As String, _
                                  ByVal AddPropSource As String)
    ' this guy will change a property if it exists or, add it if it doesn't
    ' there is a better way by adding properties to a memory object and using WriteMemGadget
    Dim Crit As String, AddThisProperty As Boolean, EditThisProperty As Boolean
    Dim Cntr1 As Integer
    Dim PropsStartRec As String
    Dim ResetProps As Boolean
    Dim LocalError As String
    LocalError = ""
    On Error GoTo LocalError
    ' read the one to add
    ' new way
    AddThisProperty = True
    '///////////////////
    ' REMOVE THIS MAYBE
'    PropsRS.Index = "ObjectID"
'    PropsRS.Seek "=", AddObjectID
'    Do While PropsRS!ObjectID = AddObjectID
'        If PropsRS!Property = AddProperty Then
'            AddThisProperty = False
'        End If
'        PropsRS.MoveNext
'        If PropsRS.EOF Then Exit Do
'    Loop
    '/////////////////////////
    GadgetWorkspace.BeginTrans
    Select Case True
        Case AddThisProperty = True
            PropsRS.AddNew
        Case AddThisProperty = False
            ' this property does exist, need to edit
            PropsRS.Edit
        Case Else
            MsgBox "Property Add is Not in Add or Edit Mode", , UCase(App.EXEName) & " Debug Message"
    End Select
    PropsRS![ObjectID] = AddObjectID
    PropsRS!Property = AddProperty
    PropsRS!ValueAlpha = AddPropertyValue
    PropsRS!ValueNum = Val(AddPropertyValue)
    PropsRS!PropSource = AddPropSource
    PropsRS!PropType = AddPropType
    ' below added 8/26/98 to fix locking problems
    LocalError = ""
    PropsRS.Update
    If LocalError <> "" Then
        Cntr1 = 0
        Do While Cntr1 <= 10
            LocalError = ""
            WasteTime 0.1
            PropsRS.Update
            If LocalError = "" Then
                Exit Do
            End If
            Cntr1 = Cntr1 + 1
        Loop
    End If
    If InStr(LocalError, "LOCKED") > 0 Then
        MsgBox "Add One Property: Record Locked"
    End If
    GadgetWorkspace.CommitTrans
    PropsRS.Bookmark = PropsRS.LastModified
    GODAddOneProperty = PropsRS!PropertyID
    GoTo EndSub
LocalError:
    LocalError = Error
    Resume Next
EndSub:
    On Error GoTo 0
    GDSFreelocks
End Function
Friend Function GODChangePropertyByID(ChangeObjectID As Long, _
                                      SetProperty As String, _
                                      ChangePropertyValue As String) As String
    ' a new way to change a property, also kind of outdated
    Dim t, X As Long, Results As String, Cntr1 As Integer
    Dim starttime As Single, stoptime As Single
    Dim LocalError As String
    LocalError = ""
    On Error GoTo LocalError
    
    starttime = Timer
    Results = "OK"
    PropsRS.Index = "Objectid"
    PropsRS.Seek "=", ChangeObjectID
    If PropsRS.NoMatch Then
        Results = "ERROR: OBJECT NOT FOUND"
        GoTo EndSub:
    End If
    GadgetWorkspace.BeginTrans
    Do While PropsRS.EOF = False
        If PropsRS!Property = SetProperty And _
           PropsRS!ObjectID = ChangeObjectID Then
            PropsRS.Edit
            PropsRS!ValueAlpha = ChangePropertyValue
            PropsRS!ValueNum = Val(ChangePropertyValue)
            LocalError = ""
            PropsRS.Update
            If LocalError <> "" Then
                Cntr1 = 0
                Do While Cntr1 <= 30
                    LocalError = ""
                    WasteTime 0.1
                    PropsRS.Update
                    If LocalError = "" Then
                        Exit Do
                    End If
                    Cntr1 = Cntr1 + 1
                Loop
            End If
            Results = OK
            Exit Do
        End If
        If InStr(LocalError, "LOCKED") > 0 Then
            MsgBox "Change Property by ID: Record Locked"
        End If
        PropsRS.MoveNext
        If PropsRS.EOF Then
            Exit Do
        End If
        If PropsRS.EOF Or PropsRS!ObjectID <> ChangeObjectID Then
            Results = "ERROR: PROPERTY NOT FOUND"
            Exit Do
        End If
    Loop
    GadgetWorkspace.CommitTrans
    GoTo EndSub
LocalError:
    LocalError = Error
    Resume Next
EndSub:
    On Error GoTo 0
    GODChangePropertyByID = Results
    GDSFreelocks
End Function
Friend Function GODChangePropertyName(ChangeObject As Gadget, _
                                      OldPropertyName As String, _
                                      NewPropertyName As String) As String
    ' sometimes we need to change a property name
    Dim t, Msg As String, Cntr1 As Integer
    Dim Results As String
    Dim LocalError As String
    On Error GoTo LocalError
    PropsRS.Index = "ObjectId"
    PropsRS.Seek "=", ChangeObject.ObjectID
    Results = OldPropertyName & ": " & NotFound
    If PropsRS.NoMatch Then
        Results = "Error: " & OldPropertyName & " not found for object: " & ChangeObject.Name
        If Not ExecutingSchedule Then
            MsgBox Results, , "Error in Change Property Name"
        End If
        GoTo EndSub
    End If
    GadgetWorkspace.BeginTrans
    Do While PropsRS.NoMatch = False
        If UCase(PropsRS!Property) = UCase(OldPropertyName) Then
            PropsRS.Edit
            PropsRS!Property = NewPropertyName
            PropsRS.Update
            If LocalError <> "" Then
                Cntr1 = 0
                Do While Cntr1 <= 20
                    LocalError = ""
                    WasteTime 0.1
                    PropsRS.Update
                    If LocalError = "" Then
                        Results = OK
                        Exit Do
                    End If
                    Cntr1 = Cntr1 + 1
                Loop
            End If
            If LocalError = "" Then
                Results = OK
            Else
                Results = LocalError
            End If
            Exit Do
        End If
        PropsRS.MoveNext
        If PropsRS.EOF Then Exit Do
        If PropsRS!ObjectID <> ChangeObject.ObjectID Then Exit Do
    Loop
    GadgetWorkspace.CommitTrans
    GoTo EndSub
LocalError:
    LocalError = Error
    Resume Next
EndSub:
    On Error GoTo 0
    GDSFreelocks
    GODChangePropertyName = Results
End Function
Friend Function DeleteProperty(ChangeObject As Gadget, PropertyName As String) As String
    ' removes a property from disk AND memory object
    Dim t, Msg As String, Cntr1 As Integer
    Dim Results As String
    Dim LocalError As String
    On Error GoTo LocalError
    PropsRS.Index = "ObjectId"
    PropsRS.Seek "=", ChangeObject.ObjectID
    If PropsRS.NoMatch Then
        Results = "Error: " & PropertyName & " not found for object: " & ChangeObject.Name
        If Not ExecutingSchedule Then
            MsgBox Results, , "Error in Delete Property"
        End If
        GoTo EndSub
    End If
    Do While PropsRS.NoMatch = False
        If UCase(PropsRS!Property) = UCase(PropertyName) Then
            PropsRS.Delete
            If LocalError <> "" Then
                Cntr1 = 0
                Do While Cntr1 <= 20
                    LocalError = ""
                    WasteTime 0.1
                    PropsRS.Delete
                    If LocalError = "" Then
                        Exit Do
                    End If
                    Cntr1 = Cntr1 + 1
                Loop
            End If
            If LocalError = "" Then
                Results = OK
            Else
                Results = LocalError
            End If
            Exit Do
        End If
        PropsRS.MoveNext
        If PropsRS.EOF Then Exit Do
        If PropsRS!ObjectID <> ChangeObject.ObjectID Then Exit Do
    Loop
    
    GoTo EndSub
LocalError:
    LocalError = Error
    Resume Next
EndSub:
    On Error GoTo 0
    GDSFreelocks
    DeleteProperty = Results
End Function

Friend Function SetProperty(ChangeObject As Gadget, _
                            ChangePropertyName As String, _
                            ChangePropertyValue As String) As String

    ' this will change a property for the given object
    ' only changes memory value, not disk.
    
    ' make this hit gadgetor for properties if fail local
    ' need to seet up the bufferring in gadgetor so the satellites can
    ' pre-request memory to be filled and recalled at will
    Dim t, X As Long, Results As String, PropNDX As Integer, Cntr1 As Long
    Dim starttime As Single, stoptime As Single
    Dim TotalSame As Integer
    Dim LocalError As String
    If Suicide Then
        On Error Resume Next
    Else
        On Error GoTo LocalError
    End If
    starttime = Timer
    Results = "Error"
    ' this causes change in existing ones other than "is"
    For X = 1 To ChangeObject.TotalProperties
        Select Case True
            Case UCase(ChangePropertyName) = "IS"
            
'            Case (UCase(ChangeObject.Propity(X)) = UCase(ChangePropertyName)) And _
                 (UCase(ChangeObject.ValueAlpha(X)) <> UCase(ChangePropertyValue)) And _
                 (UCase(ChangePropertyName) = "IS")
                 ' need to see if any other "is" has same value
                 For Cntr1 = 1 To ChangeObject.TotalProperties
                    If (UCase(ChangeObject.Propity(Cntr1)) = UCase(ChangePropertyName)) And _
                       (UCase(ChangeObject.ValueAlpha(Cntr1)) = UCase(ChangePropertyValue)) And _
                       (UCase(ChangePropertyName) = "IS") Then
                        X = Cntr1
                        PropNDX = X
                        ChangeObject.ValueAlpha(X) = ChangePropertyValue
                        ChangeObject.ValueNum(X) = Val(ChangePropertyValue)
                        Results = "OK"
                       Exit For
                    End If
                 Next
                 If Cntr1 > ChangeObject.TotalProperties Then
                    Results = "Error"
                 End If
                Exit For
            Case (UCase(ChangeObject.Propity(X)) = UCase(ChangePropertyName))
                PropNDX = X
                ChangeObject.ValueAlpha(X) = ChangePropertyValue
                ChangeObject.ValueNum(X) = Val(ChangePropertyValue)
                Results = "OK"
                Exit For
        End Select
    Next
    If Results = "Error" Then
        ' didn't find old one, create one
        ChangeObject.TotalProperties = ChangeObject.TotalProperties + 1
        X = ChangeObject.TotalProperties
        ReDim Preserve ChangeObject.Propity(X)
        ChangeObject.Propity(X) = ChangePropertyName
        
        ReDim Preserve ChangeObject.Caption(X)
        ChangeObject.Caption(X) = "None"
        
        ReDim Preserve ChangeObject.ValueAlpha(X)
        ChangeObject.ValueAlpha(X) = ChangePropertyValue
        
        ReDim Preserve ChangeObject.ValueNum(X)
        ChangeObject.ValueNum(X) = Val(ChangePropertyValue)
        
        ReDim Preserve ChangeObject.PropSource(X)
        ChangeObject.PropSource(X) = "None"
        
        ReDim Preserve ChangeObject.PropType(X)
        ChangeObject.PropType(X) = 99
        Results = "OK"
        GoTo EndGOCP
    End If
    GoTo EndGOCP
LocalError:
    LocalError = Error
'    FloatMsgBox "Set Property Error: " & LocalError, "Error: " & ChangeObject.Name & "/" & ChangePropertyName & "/" & ChangePropertyValue
    SetProperty Trace, NextID("trace") & "Set Property Error", "Error: " & LocalError & ChangeObject.Name & "/" & ChangePropertyName & "/" & ChangePropertyValue
    SetProperty VGBErrors, NextID("error") & "Set Property Error", "Error: " & LocalError & ChangeObject.Name & "/" & ChangePropertyName & "/" & ChangePropertyValue
    Resume Next
EndGOCP:
    SetProperty = Results
    stoptime = Timer
    t = ChangePropertyName & " changed to: " & ChangePropertyValue & CrLf
    On Error GoTo 0
'    MsgBox t & " Time to change Memory Property=" & stoptime - starttime & CrLf & Results
    If (stoptime - starttime) > 10 Then
        FloatMsgBox " Time to change Memory Property=" & stoptime - starttime, UCase(App.EXEName) & " Debug Error Too Long to change"
'        MsgBox t & " Time to change Memory Property=" & stoptime - starttime & CrLf & Results
    End If
End Function
Friend Function SetPropertyType(ChangeObject As Gadget, _
                               SetProperty As String, _
                               ChangePropertyType As Integer) As String
    ' this will change preperty type to new value memory only
    ' the property type affects how a property is used
    Dim t, X As Long, Results As String
    Dim starttime As Single, stoptime As Single
    Dim TotalSame As Integer
    For X = 1 To ChangeObject.TotalProperties
        If UCase(ChangeObject.Propity(X)) = UCase(SetProperty) Then
            ChangeObject.PropType(X) = ChangePropertyType
            Exit For
        End If
    Next
    GDSFreelocks
End Function

'Friend Function GODChangeMemoryProperty(ChangeObject As Gadget, _
'                                        SetProperty As String, _
'                                        ChangePropertyValue As String) As String
'    ' this will change a property for the given object
'    ' only changes memory value, not disk.
'    Dim t, x As Long, Results As String, PropNDX As Integer
'    Dim starttime As Single, stoptime As Single
'    Dim TotalSame As Integer
'    starttime = Timer
'    Results = "Error"
'    ' check for ambiguous property names
'    TotalSame = 0
'    For x = 1 To ChangeObject.TotalProperties
'        If UCase(ChangeObject.Propity(x)) = UCase(SetProperty) Then
'            TotalSame = TotalSame + 1
'        End If
'    Next
'    If TotalSame > 1 Then
'        Results = "ERROR! Property " & SetProperty & " found " & TotalSame & " Times"
'        '//////////////////
'        'REMOVE THIS
''        MsgBox "Error in Change Memory Property: " & Results
'        ' REMOVE THIS
'        ' /////////////////
'
'        GoTo EndGOCP
'    End If
'    For x = 1 To ChangeObject.TotalProperties
'        If UCase(ChangeObject.Propity(x)) = UCase(SetProperty) Then
'            PropNDX = x
'            ChangeObject.ValueAlpha(x) = ChangePropertyValue
'            ChangeObject.ValueNum(x) = Val(ChangePropertyValue)
'            Results = "OK"
'            Exit For
'        End If
'    Next
'
'        '//////////////////
'        'REMOVE THIS
'    For x = 1 To ChangeObject.TotalProperties
'        If UCase(ChangeObject.Propity(x)) = UCase(SetProperty) Then
'            TotalSame = TotalSame + 1
'        End If
'    Next
'    TotalSame = 0
'    If TotalSame > 1 Then
'        Results = "ERROR! Property " & SetProperty & " found " & TotalSame & " Times"
'        '//////////////////
'        'REMOVE THIS
'        MsgBox "Error in Change Memory Property: " & Results
'        ' REMOVE THIS
'        ' /////////////////
'
'        GoTo EndGOCP
'    End If
'        '//////////////////
'        'REMOVE THIS
'
'
'
'    If InStr(UCase(Results), "ERROR") Then
'        Results = Results & ": Property: " & SetProperty & " not found for: " & ChangeObject.Name
'        GoTo EndGOCP
'    End If
'
'EndGOCP:
'    GODChangeMemoryProperty = Results
'    GDSFreelocks
'    stoptime = Timer
'    t = SetProperty & " changed to: " & ChangePropertyValue & CrLf
''    MsgBox t & " Time to change Memory Property=" & stoptime - starttime & CrLf & Results
'End Function
Friend Function TransportGadgetsOLD(Param As Gadget) As Gadget
    ' this routine will copy and/or move gadget object(s) from one database to another
    ' the Param Object contains all the stuff needed
    Dim starttime As Single, stoptime As Single
    starttime = Timer
    Dim t, Msg As String, Msg2 As String, Cntr1 As Integer, CNTR2 As Integer
    Dim SourcesRead As Integer, ContainersRead As Integer, LinksRead As Integer
    Dim SourcesWrote As Integer, ContainersWrote As Integer, LinksWrote As Integer
    Dim AddedLinkedToCNTR As Integer, FoundLinkedToCNTR As Integer
    Dim DoEventCNTR As Integer
    Dim TempGadget As Gadget
    Dim SourceDBGadgetPTR As Integer
    Dim DestDBGadgetPTR As Integer
    Dim ContainerToMove As String
    Dim LinkProp As String, LinkType As String, Relink As Boolean
    Dim TransportMode As String
    Dim ResultsGadget As Gadget
    Dim Compare As Boolean
    Dim CurrContainedObject As Gadget
    Dim SourceGadget As Gadget, SourceGadgetPTR As Integer, SourceGadgetCNTR As Integer
    Dim SourceExisted As Boolean
    Dim ContainedObjects() As Gadget, ContainedObjectsPTR As Integer, ContainedObjectsCNTR As Integer
    Dim LinkedToObjects() As Gadget, LinkedToObjectsPTR As Integer, LinkedToObjectsCNTR As Integer
    Dim DestGadget As Gadget
    Dim OldColName As String
    Dim NewColName As String
    Dim ExcludeTypes() As String, ExcludeTypesCNTR As Integer
    Dim ThisRS As Recordset
    ' begin a resultsgadget
    ResultsGadget = BlankObject
    ResultsGadget.Name = "Results of Object Transporter"
    ResultsGadget.Type = "Function Status"
    ResultsGadget.Container = "Results"
    t = SetProperty(ResultsGadget, "Status", "Started")
    t = SetProperty(ResultsGadget, "StartTimer", CStr(starttime))
    Compare = UCase(ReadProperty(Param, "Compare")) = "TRUE"
    ' load excluded types
    For Cntr1 = 1 To 1000
        If DoEventCNTR Mod 15 = 0 Then
            DoEventCNTR = 0
'            DoEvents
        Else
            DoEventCNTR = DoEventCNTR + 1
        End If
        Msg = "Exclude Type" & CStr(Cntr1)
        Msg2 = UCase(ReadProperty(Param, Msg))
        If Msg2 <> NotFound Then
            ExcludeTypesCNTR = ExcludeTypesCNTR + 1
            ReDim Preserve ExcludeTypes(ExcludeTypesCNTR)
            ExcludeTypes(ExcludeTypesCNTR) = UCase(Msg2)
        Else
            Exit For
        End If
    Next
    ' set up source/destination variables
    ' see if there is a link property (a prperty that points to another object)
    LinkProp = ReadProperty(Param, "Take Link Property")
    If LinkProp = NotFound Then
        LinkProp = "None"
    End If
    LinkType = ReadProperty(Param, "Take Link Type")
    Relink = (ReadProperty(Param, "Relink") = "True")
    Msg = ReadProperty(Param, "Source Database")
    SourceDBGadgetPTR = DBFindIndex(Msg)
    Msg = ReadProperty(Param, "Destination Database")
    DestDBGadgetPTR = DBFindIndex(Msg)
    SourceGadgetCNTR = Val(ReadProperty(Param, "Total Source Objects"))
'Read ////////////////////////////////////////////////////////////////////////////////////////////
    ' read source, links and linked to objects
    For SourceGadgetPTR = 1 To SourceGadgetCNTR
        SourcesRead = SourcesRead + 1
        ' switch to source db
        Msg = DBSwitch(SourceDBGadgetPTR)
        If Msg <> OK Then
            MsgBox Msg, , UCase(App.EXEName) & " Debug Message"
            t = SetProperty(ResultsGadget, "Error", Msg)
            GoTo NextSourceGadget
        End If
        ' check to see if there is a seal of approval to  check
        Msg = ReadProperty(Param, "Verification Object") '= "Seal of Approval"
        TempGadget = BlankObject
        If Msg <> NotFound Then
            t = ReadGadgetByName(Msg, TempGadget)
            If t <> OK Then
                Msg2 = "Failed to find: " & Msg
                MsgBox Msg2, vbExclamation, "Error: DB Verify Failure"
                t = SetProperty(ResultsGadget, "Error", "DB Verify Failure")
                GoTo EndSub
            End If
        End If
        Msg = ReadProperty(Param, "Source Object" & CStr(SourceGadgetPTR))
        t = ReadGadgetByID(Val(Msg))
        If t <> OK Then
            ' could not find this object
            GoTo NextSourceGadget
        End If
        SourceGadget = ReadObjectBuffer
        ' place the oid of original in tag of SourceGadget to use later
        SourceGadget.Tag = SourceGadget.ObjectID
        ContainedObjectsCNTR = 0
        ReDim Preserve ContainedObjects(ContainedObjectsCNTR)
        LinkedToObjectsCNTR = 0
        ReDim Preserve LinkedToObjects(LinkedToObjectsCNTR)
        Set ThisRS = OpenDB(OpenDBPTR).OpenRecordset("Objects", dbOpenTable) ', dbForwardOnly)
        ' need to fix up the links in the contained objects
        ThisRS.Index = "Container"
        ThisRS.Seek "=", SourceGadget.Tag
        Do While ThisRS.NoMatch = False
'            DoEvents
            If ThisRS!Name = SourceGadget.Name Then
                GoTo NextRecord:
            End If
            t = ReadGadgetByID(ThisRS!ObjectID)
            CurrContainedObject = ReadObjectBuffer
            If t <> OK Then
                MsgBox "Error Reading Contained Object: " & t, , UCase(App.EXEName) & " Debug Message"
                GoTo NextSourceGadget
            End If
            Msg = "Include"
            For Cntr1 = 1 To ExcludeTypesCNTR
                If UCase(CurrContainedObject.Type) = ExcludeTypes(Cntr1) Then
                    Msg = "Exclude"
                    Exit For
                End If
            Next
            If Msg = "Exclude" Then
                GoTo NextRecord
            End If
            ContainersRead = ContainersRead + 1
            ContainedObjectsCNTR = ContainedObjectsCNTR + 1
            ReDim Preserve ContainedObjects(ContainedObjectsCNTR)
            ContainedObjects(ContainedObjectsCNTR) = CurrContainedObject
            ContainedObjects(ContainedObjectsCNTR).ObjectID = 0
            ContainedObjects(ContainedObjectsCNTR).Tag = CurrContainedObject.ObjectID
            CurrContainedObject.ObjectID = 0 ' we're defaulting to a write, right?
            If LinkProp <> "None" Then
                t = ReadProperty(ContainedObjects(ContainedObjectsCNTR), LinkProp)
                If (t <> NotFound) And t <> "None" Then
                    ' there is a linked property
                    t = ReadGadgetByID(Val(t))
                    If t <> OK Then
                        MsgBox "Error Reading Linked Object: " & t, , UCase(App.EXEName) & " Debug Message"
                    Else
                        LinksRead = LinksRead + 1
                        LinkedToObjectsCNTR = LinkedToObjectsCNTR + 1
                        ReDim Preserve LinkedToObjects(LinkedToObjectsCNTR)
                        LinkedToObjects(LinkedToObjectsCNTR) = ReadObjectBuffer
                        LinkedToObjects(LinkedToObjectsCNTR).ObjectID = 0
                        LinkedToObjects(LinkedToObjectsCNTR).Tag = ReadObjectBuffer.ObjectID
                    End If
                End If
            End If
NextRecord:
            ThisRS.MoveNext
            If ThisRS.EOF Then Exit Do
            If ThisRS!Container <> SourceGadget.Tag Then Exit Do
        Loop
        t = SetProperty(ResultsGadget, "Read Timer", CStr(Timer))
        t = SetProperty(ResultsGadget, "Read Time", CStr(Timer - starttime))
'Read  ////////////////////////////////////////////////////////////////////////////////////////////
'Write ////////////////////////////////////////////////////////////////////////////////////////////
        ' now we spit them into the dest db
        ' activate dest db
        Msg = DBSwitch(DestDBGadgetPTR)
        If Msg <> OK Then
            MsgBox Msg, , UCase(App.EXEName) & " Debug Message"
            t = SetProperty(ResultsGadget, "Error", Msg)
            GoTo NextSourceGadget
        End If
        ' does source object exist?
        DestGadget = BlankObject
        t = ReadGadgetByName(SourceGadget.Name, DestGadget)
        If (t = OK) And (DestGadget.Type <> SourceGadget.Type) Then
            ' seems to be a goof
            MsgBox "Strange Error in Transport Objects Routine: Read OK but Objects Not Same Type", , UCase(App.EXEName) & " Debug Message"
            GoTo NextSourceGadget
        End If
        If t = OK Then
            ' destination contains object with same name
            SourceGadget.ObjectID = DestGadget.ObjectID
            SourceExisted = True
        Else
            ' totally new,  dude
            SourceGadget.ObjectID = 0
            SourceExisted = False
        End If
        ' write the source object to the destination db
        SourcesWrote = SourcesWrote + 1
        t = WriteMemGadget(SourceGadget.ObjectID, SourceGadget)
        ' reflect new container (oid that was assigned as it was written to disk)
        SourceGadget.Container = CStr(SourceGadget.ObjectID)
        ' need to write again
        t = WriteMemGadget(SourceGadget.ObjectID, SourceGadget)
        ' save the contained objects
        For ContainedObjectsPTR = 1 To ContainedObjectsCNTR
            Msg = NotFound
            If SourceExisted = True Then
                ' don't do anything
                Exit For
            End If
            ' note: this was hard coded and needs fixed
            ContainedObjects(ContainedObjectsPTR).Container = CStr(SourceGadget.ObjectID)
            If ContainedObjects(ContainedObjectsPTR).Type = "Report Column" Then
                OldColName = ContainedObjects(ContainedObjectsPTR).Name
                t = Right(OldColName, Len(OldColName) - InStr(OldColName, ":"))
                NewColName = CStr(SourceGadget.ObjectID) & "-COL:" & t
                ContainedObjects(ContainedObjectsPTR).Name = NewColName
                t = ReadGadgetByName(NewColName, TempGadget)
                If t = OK Then
                    ContainedObjects(ContainedObjectsPTR).ObjectID = TempGadget.ObjectID
                    Msg = "Found"
                Else
                    ContainedObjects(ContainedObjectsPTR).ObjectID = 0
                End If
            End If
            Msg = (ReadProperty(ContainedObjects(ContainedObjectsPTR), LinkProp))
            If Msg <> NotFound Then
                For LinkedToObjectsPTR = 1 To LinkedToObjectsCNTR
                    If Msg = LinkedToObjects(LinkedToObjectsPTR).Tag Then
                        ' need to see if this object already exists in dest db
                        ' Read each linked to object into a temp gadget
                        TempGadget = BlankObject
                        TempGadget.Name = "Object Read Parameter"
                        t = SetProperty(TempGadget, "Container", LinkedToObjects(LinkedToObjectsPTR).Container)
                        t = SetProperty(TempGadget, "Type", LinkedToObjects(LinkedToObjectsPTR).Type)
                        t = ReadGadgetByName(LinkedToObjects(LinkedToObjectsPTR).Name, TempGadget)
                        If t = OK Then
                            ' this is an old one, already in the dest db
                            FoundLinkedToCNTR = FoundLinkedToCNTR + 1
                            LinkedToObjects(LinkedToObjectsPTR).ObjectID = TempGadget.ObjectID
                        Else
                            ' brand new linked-to object
                            AddedLinkedToCNTR = AddedLinkedToCNTR + 1
                            LinkedToObjects(LinkedToObjectsPTR).ObjectID = 0
                            LinksWrote = LinksWrote + 1
                            t = WriteMemGadget(LinkedToObjects(LinkedToObjectsPTR).ObjectID, LinkedToObjects(LinkedToObjectsPTR))
                        End If
                        Msg = CStr(LinkedToObjects(LinkedToObjectsPTR).ObjectID)
                        t = SetProperty(ContainedObjects(ContainedObjectsPTR), LinkProp, Msg)
                        Exit For
                    End If
                Next
            End If
            t = WriteMemGadget(ContainedObjects(ContainedObjectsPTR).ObjectID, ContainedObjects(ContainedObjectsPTR))
            ContainersWrote = ContainersWrote + 1
'            DoEvents
        Next ContainedObjectsPTR
        ' fixup the links
        ' skip thru linked to array
        For LinkedToObjectsPTR = 1 To LinkedToObjectsCNTR
            If SourceExisted = True Then
                ' don't do anything
                Exit For
            End If
            ' need to see if this object already exists in dest db
            ' Read each linked to object into a temp gadget
            TempGadget = BlankObject
            TempGadget.Name = "Object Read Parameter"
            t = SetProperty(TempGadget, "Container", LinkedToObjects(LinkedToObjectsPTR).Container)
            t = SetProperty(TempGadget, "Type", LinkedToObjects(LinkedToObjectsPTR).Type)
            t = ReadGadgetByName(LinkedToObjects(LinkedToObjectsPTR).Name, TempGadget)
            If t = OK Then
                ' this is an old one, already in the dest db
                FoundLinkedToCNTR = FoundLinkedToCNTR + 1
                LinkedToObjects(LinkedToObjectsPTR).ObjectID = TempGadget.ObjectID
            Else
                ' brand new linked-to object
                AddedLinkedToCNTR = AddedLinkedToCNTR + 1
                LinkedToObjects(LinkedToObjectsPTR).ObjectID = 0
                LinksWrote = LinksWrote + 1
                t = WriteMemGadget(LinkedToObjects(LinkedToObjectsPTR).ObjectID, LinkedToObjects(LinkedToObjectsPTR))
            End If
            ' find and change all objects with this linked to object as link's link value to reflect
            ' the new linkid.
            ' Give me ambiguity or, give me something else.
'            For ContainedObjectsPTR = 1 To ContainedObjectsCNTR
'                Msg = (ReadProperty(ContainedObjects(ContainedObjectsPTR), LinkProp))
'                If Msg = LinkedToObjects(LinkedToObjectsPTR).Tag Then
'                    'LinkedToObjectsPTR
'                    Msg = CStr(LinkedToObjects(LinkedToObjectsPTR).ObjectID)
'                    t = SetProperty(ContainedObjects(ContainedObjectsPTR), LinkProp, Msg)
'                    ' write the co
'                    t = WriteGadget(ContainedObjects(ContainedObjectsPTR).ObjectID, ContainedObjects(ContainedObjectsPTR))
'                    DoEvents
'                End If
'                DoEvents
'            Next ContainedObjectsPTR
        Next LinkedToObjectsPTR
        ' here we have established the new master object, all contained obects and linked-to properties
        ' for this source
        DoEvents
'        MsgBox Timer - starttime
NextSourceGadget:
        t = SetProperty(ResultsGadget, "Write Timer", CStr(Timer))
'        If Compare = True Then
'            TempGadget = BlankObject
'            TempGadget.Name = SourceGadget.Name
'            Msg = ReadProperty(Param, "Show")
'            If Msg = "True" Then
'                t = SetProperty(TempGadget, "Show", "True")
'            Else
'                t = SetProperty(TempGadget, "Show", "False")
'            End If
'            Msg = UCase(ReadProperty(Param, "Output File Name"))
'            If Msg = NotFound Then
'                Msg = AddBackSlash(CurDir)
'                t = SetProperty(TempGadget, "Output File Name", Msg & "TRANSPRT.LOG")
'            Else
'                t = SetProperty(TempGadget, "Output File Name", Msg)
'            End If
'            t = SetProperty(TempGadget, "Report OID1", SourceGadget.Tag)
'            t = SetProperty(TempGadget, "DB PTR1", CStr(SourceDBGadgetPTR))
'            t = SetProperty(TempGadget, "Report OID2", CStr(SourceGadget.ObjectID))
'            t = SetProperty(TempGadget, "DB PTR2", CStr(DestDBGadgetPTR))
'            Msg = ReadProperty(Param, "Log Errors Only")
'            t = SetProperty(TempGadget, "Log Errors Only", Msg)
'            TempGadget = PrintReportComparison(TempGadget)
'        End If
        t = SetProperty(ResultsGadget, "Compare Timer", CStr(Timer))
        If AbortRead Then GoTo EndSub
    Next SourceGadgetPTR
        Compare = False
        If AbortRead Then GoTo EndSub
        If True = False Then
            ' let's see the results
            t = SetProperty(ResultsGadget, "Source Object Name", SourceGadget.Name)
            DBSwitch SourceDBGadgetPTR
            TempGadget = BlankObject
            TempGadget.Name = "Compare Results"
            TempGadget.Container = "Compare Results"
            t = ReadGadgetByID(Val(ContainedObjects(ContainedObjectsPTR).Tag))
            TempGadget = ReadObjectBuffer
            Msg = (ReadProperty(TempGadget, LinkProp))
            t = SetProperty(ResultsGadget, "DB1 Database", OpenDB(SourceDBGadgetPTR).Name)
            t = SetProperty(ResultsGadget, "DB1 Object (disk value) Name", TempGadget.Name & " (" & TempGadget.ObjectID & ")")
            t = SetProperty(ResultsGadget, "DB1 Link To OID", Msg)
            t = SetProperty(ResultsGadget, "DB1 Link Results", "Started")
            t = SetProperty(ResultsGadget, "DB1 Link Results", Msg)
            If Msg <> NotFound And Msg <> "None" Then
                t = ReadGadgetByID(Val(Msg))
                If t <> OK Then
                    t = SetProperty(ResultsGadget, "DB1 Link Results", Msg & " " & NotFound)
                    MsgBox "Link ID: " & Msg, " NOT FOUND"
                Else
'                    Msg = "Object: " & tempgadget.Name & " Linked to: (" & Msg & ") " & ReadObjectBuffer.Name
                    Msg = "Object: " & TempGadget.Name & " Linked to: " & ReadObjectBuffer.Name
                    
                    t = SetProperty(ResultsGadget, "DB1 Link Results", Msg)
                End If
            End If
            t = SetProperty(ResultsGadget, "DB2 Link Results", " Started")
            t = SetProperty(ResultsGadget, "DB2 Database", "")
            t = SetProperty(ResultsGadget, "DB2 Object (disk value) Name", "")
            t = SetProperty(ResultsGadget, "DB2 Link To OID", "")
            
'             ShowObject Dematerialize(ResultsGadget), "m"
            DBSwitch DestDBGadgetPTR
            TempGadget = BlankObject
            TempGadget.Name = "Compare Results"
            TempGadget.Container = "Compare Results"
            t = SetProperty(TempGadget, "Container", ContainedObjects(ContainedObjectsPTR).Container)
            t = SetProperty(TempGadget, "Type", ContainedObjects(ContainedObjectsPTR).Type)
            t = ReadGadgetByName(ContainedObjects(ContainedObjectsPTR).Name, TempGadget)
            If t <> OK Then
                MsgBox "Read Container Function Failed"
            End If
            Msg = (ReadProperty(TempGadget, LinkProp))
            t = SetProperty(ResultsGadget, "DB2 Database", OpenDB(DestDBGadgetPTR).Name)
            t = SetProperty(ResultsGadget, "DB2 Object (disk value) Name", TempGadget.Name & " (" & TempGadget.ObjectID & ")")
            t = SetProperty(ResultsGadget, "DB2 Link To OID", Msg)
            t = SetProperty(ResultsGadget, "DB2 Link Results", Msg)
            If Msg <> NotFound And Msg <> "None" Then
                t = ReadGadgetByID(Val(Msg))
                If t <> OK Then
                    t = SetProperty(ResultsGadget, "DB2 Link Results", Msg & " " & NotFound)
                    MsgBox "Link ID: " & Msg, " NOT FOUND"
                Else
'                    Msg = "Object: " & tempgadget.Name & " Linked to: (" & Msg & ") " & ReadObjectBuffer.Name
                    Msg = "Object: " & TempGadget.Name & " Linked to: " & ReadObjectBuffer.Name
                    t = SetProperty(ResultsGadget, "DB2 Link Results", Msg)
                End If
            End If
            If ReadProperty(ResultsGadget, "DB1 Link Results") <> ReadProperty(ResultsGadget, "DB2 Link Results") Then
                ShowGadget ResultsGadget
            End If
        End If
    t = SetProperty(ResultsGadget, "Status", "Done")
EndSub:
    DBSwitch 1
    stoptime = Timer
    t = SetProperty(ResultsGadget, "StopTimer", CStr(stoptime))
    t = SetProperty(ResultsGadget, "Total Time", CStr(stoptime - starttime))
'    MsgBox stoptime - starttime
    TransportGadgetsOLD = ResultsGadget
    AbortRead = False
    On Error GoTo 0
End Function

Friend Function TransportGadgets(Task As Gadget, Param As Gadget) As Gadget
    ' this routine will copy and/or move gadget object(s) from one database to another
    ' the Param Object contains all the stuff needed
    ' Source
    '   (DB) Database - speaks for itself
    '       Must already exist
    '       Provide Path and Name
    '   (MEM) Memory - any system gadget array (app, db, appdb, task etc)
    '   (DDE) Transfer - maybe not, we'll see
    ' Dest
    '   (DB) Database
    '       Must already exist
    '       Provide Path and Name
    '       MemGadget(x,y) Gadget Buffer (will allow caching objects for upped speed)
    '   (DDE) OPAG via dde
    '       Provide Index of output dde variable
    '   (MEM)
    '   (DEL) Oblivion (delete only)
    ' XPT Option
    '   (C) Copy
    '   (M) Move
    '   (D) Delete
    ' Data Options
    '   (Type) include only given type
    '   (Container) ditto container
    '   (Exclude1....ExcludeX)
    '   PropName1...PropNameX
    '   PropValue1..PropValueX
    '   Send (Name, Property, Gadget)
    '   Send Prop
'    Dim LocalRS() As Recordset, LocalRSCNTR As Integer
'    Dim LocalRSPTR As Integer
'    Dim starttime As Single, stoptime As Single
'    Dim starttime2 As Single, stoptime2 As Single
'    starttime = Timer
'    Dim t, Msg As String, Msg2 As String, Cntr1 As Integer, Cntr2 As Integer
'    Dim PropName As String, PropValue As String
'    Dim ReturnDDEIndex As Integer
'    Dim TypeToSend As String
'    Dim ContainerToSend As String
'    Dim DBIndex As String, DBIndexValue As String
'    Dim QueReqTemplate As Gadget
'    Dim QueRequest As Gadget
'    Dim QueParam As Gadget
'    Dim DoEventCNTR As Integer
'    Dim TempGadget As Gadget
'    Dim StartDBGadgetPTR As Integer
'    Dim SourceDBGadgetPTR As Integer
'    Dim DestDBGadgetPTR As Integer
'    Dim TransportMode As String
'    Dim ResultsGadget As Gadget
'    Dim FilterGadget As Gadget
'    Dim SourceGadget As Gadget, SourceGadgetPTR As Integer, SourceGadgetCNTR As Integer
'    Dim SourceName As String
'    Dim SourceType As String
'    Dim DestinationType As String
'    Dim SourceExisted As Boolean
'    Dim SaveGadget As Boolean
'    Dim DestGadget As Gadget
'    Dim ExcludeTypes() As String, ExcludeTypesCNTR As Integer
'    Dim LocalError As String
'    StartDBGadgetPTR = DBGadgetsPTR
'    ' begin a resultsgadget
'    ResultsGadget = BlankObject
'    ResultsGadget.Name = "Transport Results"
'    ResultsGadget.Type = "Function Status"
'    ResultsGadget.Container = "TransportGadgets"
'    t = SetProperty(ResultsGadget, "Status", "Started")
'    t = SetProperty(ResultsGadget, "Time: TransportGadgets Start", CStr(starttime))
'    ReturnDDEIndex = Val(ReadProperty(Param, "DDERetIndex"))
'    RequestPUDisabled(ReturnDDEIndex) = True
'    ' this is a loop to perform the following in sequece
'    '   1) read from source
'    '   2) output to dest
'    ' set source gadget
'    ' where are the objects coming from?
'    SourceType = UCase(ReadProperty(Param, "Source Type"))
'    DestinationType = UCase(ReadProperty(Param, "Destination Type"))
'    ' set indexes
'    DBIndex = ReadProperty(Param, "DBIndex")
'    DBIndexValue = ReadProperty(Param, "DBIndexValue")
'    ' set Que stuff
'    QueReqTemplate = Task
'    QueReqTemplate.Name = "SendTo"
'    QueReqTemplate.Type = "Task"
'    QueReqTemplate.Container = "TransportGadgets"
'    QueReqTemplate.Tag = Param.Tag
'    t = SetProperty(QueReqTemplate, "Source", "MEM") ' this is the number sent
'    t = SetProperty(QueReqTemplate, "#", CStr(0)) ' this is the number sent
'    t = SetProperty(QueReqTemplate, "Time: TXG Start", CStr(Timer))
'    t = SetProperty(QueReqTemplate, "DDEIndex", CStr(ReturnDDEIndex))
'    t = SetProperty(QueReqTemplate, "Send Name", "Transport Result")
'    t = SetProperty(QueReqTemplate, "Send Type", "Result")
'    QueParam = BlankObject
'    ' make a filter gadget
'    FilterGadget = Param
'    SetProperty FilterGadget, DBIndex, DBIndexValue
'
'    Select Case True
'        Case SourceType = "DB"
'            ' coming from database
'            ' find source db ptr
'            SourceName = ReadProperty(Param, "Source Name")
'            SourceDBGadgetPTR = DBFindIndex(SourceName)
''            If Val(SourceDBGadgetPTR) = 0 Then
''                ' didn't find database, can't do
''                GoTo EndSub
''            End If
'            ' set up the recordset to use
'            ' create/use the dde one, if that's where we are
'            If ReturnDDEIndex > 0 Then
'                LocalRSPTR = ReturnDDEIndex
'                If LocalRSPTR > LocalRSCNTR Then
'                    LocalRSCNTR = LocalRSCNTR + 1
'                    ReDim Preserve LocalRS(LocalRSCNTR)
'                    Set LocalRS(LocalRSCNTR) = OpenDB(OpenDBPTR).OpenRecordset("Objects", dbOpenTable)
'                    If LocalError <> "" Then
'                        MsgBox "Error:" & LocalError, , UCase(App.EXEName) & " Debug Message"
'                    End If
'                End If
'            End If
'            LocalRS(LocalRSCNTR).Index = DBIndex
'            LocalRS(LocalRSCNTR).Seek "=", DBIndexValue
'            If LocalRS(LocalRSCNTR).NoMatch = True Then
'                t = SetProperty(ResultsGadget, "Time TXG Stop", CStr(Timer))
'                QueRequest = QueReqTemplate
''                QueRequest.Tag = Now
'                t = SetProperty(QueRequest, "#", CStr(0)) ' this is the number sent
'                t = SetProperty(QueRequest, "Time: TXG Stop", CStr(Timer))
'                t = SetProperty(QueRequest, "DDEIndex", CStr(ReturnDDEIndex))
'                t = SetProperty(QueRequest, "Status", "No Records")
'                QueParam = ResultsGadget
'                Que QueRequest, QueParam
'                GoTo EndSub
'            End If
'        Case SourceType = "MEM"
'            ' work this out later
'    End Select
'    ' big loop
'    Do While True = True
'        DoEvents
''        RequestPU
'        SourceGadget.Name = NotFound
'        ' load from source
'        Select Case True
'            Case SourceType = "DB"
'                ' read and accept/reject as per filter
'                Cntr1 = Cntr1 + 1
'                ' read it
'                DBSwitch SourceDBGadgetPTR
'                SourceGadget = ReadDiskGadgetByID(LocalRS(LocalRSCNTR)!ObjectID)
'
'                DBSwitch StartDBGadgetPTR
'            Case SourceType = "MEM"
'
'                ' work this out later
'        End Select
'        ' here we have a source gadget loaded
'        ' need to filter it to proscribed criteria
'        SaveGadget = True
'        If SourceGadget.Name = NotFound Then
'            SaveGadget = False
'        End If
'        SaveGadget = GadgetFilter(SourceGadget, FilterGadget) 'returns true if gadget is ok
'        DoEvents
'        Select Case True
'            Case DestinationType = "DB"
'                ' write to disk
'                If SaveGadget = True Then
'                    Cntr2 = Cntr2 + 1
'                    DBSwitch DestDBGadgetPTR
'                    TempGadget = BlankObject
'                    SetProperty TempGadget, "Name", SourceGadget.Name
'                    DestGadget = ReadDiskGadgetByName(TempGadget)
'                    If DestGadget.Name = NotFound Then
'                        SourceGadget.ObjectID = 0
'                    Else
'                        If DestGadget.Type = SourceGadget.Type _
'                        And DestGadget.Container = SourceGadget.Container Then
'                            SourceGadget.ObjectID = DestGadget.ObjectID
'                        Else
'                            SourceGadget.ObjectID = 0
'                        End If
'                    End If
'                    t = WriteMemGadget(SourceGadget.ObjectID, SourceGadget)
'                    DBSwitch StartDBGadgetPTR
'                End If
'            Case DestinationType = "MEM" And SaveGadget
'
'            Case DestinationType = "DDE" And SaveGadget
'                DoEvents
''                t = SetProperty(ResultsGadget, "Stop", CStr(Timer))
'                Cntr2 = Cntr2 + 1
'                QueRequest = QueReqTemplate
''                QueRequest.Tag = Now
'                SetProperty QueRequest, "#", CStr(Cntr2) ' this is the number sent
''                SetProperty QueRequest, "Stop", CStr(Timer)
'                SetProperty QueRequest, "DDEIndex", CStr(ReturnDDEIndex)
'                SetProperty QueRequest, "Sending Gadget", SourceGadget.Name
''                t = SetProperty(QueRequest, "Status", "OK")
''                SendResultGadget QueRequest, SourceGadget
'                starttime2 = Timer
''                TPU QueRequest, SourceGadget
'                TPU QueRequest, SourceGadget
'                stoptime2 = Timer
''                MsgBox stoptime2 - starttime2
'        End Select
'        If SourceType = "DB" Then
'                'move one and check for exit
'                Msg2 = "Continue"
'                LocalRS(LocalRSCNTR).MoveNext
'                If LocalRS(LocalRSCNTR).EOF Then
'                    ' out of records
'                    Msg2 = "EOF"
'                End If
'                If DBIndexValue <> "ALL" And (UCase(DBIndex) = "TYPE") Then
'                    If LocalRS(LocalRSCNTR)!Type <> DBIndexValue Then
'                        Msg2 = "No More " & TypeToSend
'                    End If
'                End If
'                If ContainerToSend <> "ALL" And (UCase(DBIndex) = "CONTAINER") Then
'                    If LocalRS(LocalRSCNTR)!Type <> ContainerToSend Then
'                        Msg2 = "No More " & ContainerToSend
'                    End If
'                End If
'                If Msg2 <> "Continue" Then
'                    SetProperty ResultsGadget, "Time: TXG Start", CStr(starttime)
'                    t = SetProperty(ResultsGadget, "Time: TXG Stop", CStr(Timer))
'                    QueRequest = QueReqTemplate
''                    QueRequest.Tag = Now
'                    SetProperty QueRequest, "Total Sent", CStr(Cntr2) ' this is the number sent
'                    SetProperty QueRequest, "Time: TXG Start", CStr(starttime)
'                    SetProperty QueRequest, "Time: TXG Stop", CStr(Timer)
'                    SetProperty QueRequest, "DDEIndex", CStr(ReturnDDEIndex)
'                    SetProperty QueRequest, "Status", Msg2
'                    SetProperty QueRequest, "Send Name", "Transport End"
'                    For Cntr1 = 1 To 10000
'                        PropName = "Set I/O Property Name #" & CStr(Cntr1)
'                        PropValue = ReadProperty(Param, PropName)
'                        If PropValue = NotFound Then
'                            Exit For
'                        End If
'                        SetProperty QueRequest, PropName, PropValue
'                        PropName = "Set I/O Property Value #" & CStr(Cntr1)
'                        PropValue = ReadProperty(Param, PropName)
'                        SetProperty QueRequest, PropName, PropValue
'                    Next
'                    QueParam = ResultsGadget
'                    SetProperty QueParam, "Tag", QueRequest.Tag
'                    TPU QueRequest, QueParam
'                    GoTo EndSub
'                End If
'        End If
'        MainLoop
'    Loop ' big outside loop
'
'    GoTo EndSub
'LocalError:
'    LocalError = Error
''    MsgBox "Error:" & LocalError, , ucase(App.EXEName) & " Debug Message"
'    Resume Next
'EndSub:
'    If DBGadgetsPTR <> StartDBGadgetPTR Then
'        DBSwitch StartDBGadgetPTR
'    End If
'    stoptime = Timer
'    t = SetProperty(ResultsGadget, "Time: TXG StopTimer", CStr(stoptime))
'    t = SetProperty(ResultsGadget, "Time: TXG Total Time", CStr(stoptime - starttime))
''    MsgBox stoptime - starttime
'    TransportGadgets = ResultsGadget
'    AbortRead = False
'    On Error GoTo 0
'    DoEvents
'    RequestPUDisabled(ReturnDDEIndex) = False
End Function

'Friend Function GODPropertyAssigned(PropertyName As String, PropertyValue As String, ResultArray As PropertyObjects) As Long
'    ' check to see if the propery/value combination exists.
'    ' returns the objectid of the found object or 0 if failed
'    Dim t, PropertyObjectID  As Long
'    Dim ndx As Integer
'    PropertyObjectID = 0
'    PropsRS.Index = "Property"
'    PropsRS.Seek "=", PropertyName
'    If PropsRS.NoMatch Then
'        GoTo EndSub
'    End If
'    Do While PropsRS!Property = PropertyName
'        If PropsRS!ValueAlpha = PropertyValue Then
'            PropertyObjectID = PropsRS!ObjectID
'            ndx = ndx + 1
'            ReDim Preserve ResultArray.Propity(ndx)
'            ReDim Preserve ResultArray.AssignedObjectID(ndx)
'            ResultArray.Propity(ndx) = PropertyName
'            ResultArray.AssignedObjectID(ndx) = PropertyObjectID
'        End If
'        PropsRS.MoveNext
'    Loop
'EndSub:
'    GODPropertyAssigned = PropertyObjectID
'    GDSFreelocks
'End Function
Friend Function GODReadProperty(RO As Long, ReadProperty As String)
    ' reads an object from disk object, semi-obsolete, don't use in new apps
    ' use ReadProperty instead
    Dim GORPStart As Single, GORPStop As Single
    Dim t
    Dim ObjectName As String, X As Integer
    Dim TempObject As Gadget
    Dim Result As String
    Dim TotProps As Integer, TotalSame As Integer
    Result = "ERROR: " & RO & ":" & ReadProperty & " NOT Found"
    If CurrentObject.ObjectID <> RO Then
        t = ReadGadgetByID(RO)
        If t <> "OK" Then
            MsgBox "Failed to read property: " & ReadProperty, vbOKOnly
        End If
        TempObject = ReadObjectBuffer
    Else
        TempObject = CurrentObject
    End If
    TotProps = TempObject.TotalProperties
    ' need to check for duplicate property names
    TotalSame = 0
    For X = 1 To TotProps
        If UCase(TempObject.Propity(X)) = UCase(ReadProperty) Then
            TotalSame = TotalSame + 1
        End If
    Next
    If TotalSame > 1 Then
        Result = "ERROR: " & RO & ":" & ReadProperty & " found: " & TotalSame & " Times."
        GoTo EndGORPL:
    End If
    For X = 1 To TotProps
        If UCase(TempObject.Propity(X)) = UCase(ReadProperty) Then
            Result = TempObject.ValueAlpha(X)
            Exit For
        End If
    Next
EndGORPL:
    GODReadProperty = Result
'    GORPStop = Timer
'    MsgBox "Time to read Property: " & ReadProperty & " was " & GORPStop - GORPStart
End Function
Friend Function ReadProperty(MemObject As Gadget, ReadPropertyName As String) As String
    ' reads a property value from a memory objects, returns "NOT FOUND" if  failed
    Dim GORPStart As Single, GORPStop As Single
    Dim TotProps As Integer, PropCntr As Integer, TotalSame As Integer
    Dim Result As String
    Dim LocalError As String
    On Error GoTo LocalError
    Result = "NOT FOUND"
'    GORPStart = Timer
    TotProps = MemObject.TotalProperties
    ' need to check for duplicate property names
'    TotalSame = 0
'    For PropCntr = 1 To TotProps
'        If (UCase(MemObject.Propity(PropCntr)) = UCase(ReadPropertyName)) And (UCase(ReadPropertyName) <> "IS") Then
'            TotalSame = TotalSame + 1
'        End If
'    Next
'    If TotalSame > 1 Then
'        Result = "ERROR: " & MemObject.Name & ": " & ReadPropertyName & " found: " & TotalSame & " Times."
'        '///////////////////////
'        'REMOVE THIS
'        MsgBox "READMEMORY Property: " & ReadPropertyName & " Found " & TotalSame & "Times"
'        GoTo EndSub:
'    End If
    ReadPropertyName = UCase(ReadPropertyName)
    For PropCntr = 1 To TotProps
        If UCase(MemObject.Propity(PropCntr)) = (ReadPropertyName) Then
            Result = MemObject.ValueAlpha(PropCntr)
            Exit For
        End If
    Next
    '///////////////////////////
    ' REMOVE THIS
 '   TotalSame = 0
 '   For PropCntr = 1 To TotProps
 '       If UCase(MemObject.Propity(PropCntr)) = UCase(ReadPropertyName) And (UCase(ReadPropertyName) <> "IS") Then
 '           TotalSame = TotalSame + 1
 '       End If
 '   Next
 '   If TotalSame > 1 Then
 '       Result = "ERROR: " & MemObject.Name & ": " & ReadPropertyName & " found: " & TotalSame & " Times."
 '       '///////////////////////
 '       'REMOVE THIS
 '       MsgBox "READMEMORY Property: " & ReadPropertyName & " " & TotalSame
 '       GoTo EndSub:
 '   End If
    GoTo EndSub
LocalError:
    FloatMsgBox "Read Property Error: ", "Virtual Cortex ReadProperty Error"
    Resume Next
EndSub:
    ReadProperty = Result
    On Error GoTo 0
'    GORPStop = Timer
'    GDSFreelocks
'    MsgBox "Time to read Property: " & ReadPropertyName & " was " & GORPStop - GORPStart
End Function

Friend Function GODCloneObject(SourceObjectID As Long, _
                               CloneObjectName As String) As Long
    ' will clone an object from disk to new name
    ' can do the same thing with WriteMemGadget with id of 0
    Dim t, Msg As String
    Dim AddedObjectID As Long
    t = ReadGadgetByID(SourceObjectID)
    AddedObjectID = GODAddObject(ReadObjectBuffer.Container, _
                                 ReadObjectBuffer.Type, _
                                 CloneObjectName, _
                                 "Retain")
    ReadObjectBuffer.Name = CloneObjectName
    t = WriteMemGadget(AddedObjectID, ReadObjectBuffer)
    GoTo EndCGO:

EndCGO:
'    If Heaven16.Visible Then
'        Currentform.Data_OBJProperties.Refresh
'    End If
    GODCloneObject = AddedObjectID
    GDSFreelocks
End Function

Friend Function GodWriteScreenAsObject(Param As Gadget) As Gadget
    ' writes a screen as a GDS compliant object.
    ' required adherence to strict layout.
    Dim t, Msg As String, Cntr1 As Integer, CNTR2 As Integer
    Dim ResultsGadget As Gadget
    Dim OKToWriteObject As Boolean
    Dim TotProps As Integer
    Dim StartPropNDX As Integer, EndPropNDX As Integer
    Dim lPropName As String, lPropNamePtr As Integer
    Dim lPropValue As String, lPropValuePtr As Integer
    Dim PropValueRequired As Boolean
    
    Dim lTop As String, lLeft As String
    Dim vTop As String, vleft As String
    Dim lDBGadgetsPTR As Integer
    Dim StartDBGadgetsPTR As Integer
    Dim LGadget As Gadget
    Dim LocalError As String
    Dim FormName As String, FormIndex As Integer
    On Error GoTo LocalError
    StartDBGadgetsPTR = DBGadgetsPTR
    OKToWriteObject = True
    ' which form?
    FormName = ReadProperty(Param, "Form Name")
    If FormName = NotFound Then
        FormName = Screen.ActiveForm.Name
    End If
    For FormIndex = 0 To Forms.Count - 1
        If Forms(FormIndex).Name = FormName Then
            Exit For
        End If
    Next
    ' use the passed parameter to define this object
    ' make sure caller sets these things
    LGadget = BlankObject
    LGadget.ObjectID = Param.ObjectID
    LGadget.Name = Param.Name
    LGadget.Type = Param.Type
    LGadget.Container = Param.Container
    t = ReadProperty(Param, "StartPropNDX")
    If t = NotFound Then
        StartPropNDX = 0
    Else
        StartPropNDX = Val(t)
    End If
    t = ReadProperty(Param, "EndPropNDX")
    If t = NotFound Then
        EndPropNDX = Val(Forms(FormIndex).TotIndex)
    Else
        EndPropNDX = Val(t)
    End If
    
    For Cntr1 = StartPropNDX To EndPropNDX
        PropValueRequired = False
        LocalError = ""
        t = Forms(FormIndex).PropValue(Cntr1) 'PropLabel(Cntr1)
        If LocalError = "" Then
            lPropName = Left(Forms(FormIndex).PropLabel(Cntr1), Len(Forms(FormIndex).PropLabel(Cntr1)) - 2)
            lPropValue = Forms(FormIndex).PropValue(Cntr1)
            PropValueRequired = Forms(FormIndex).Required(Cntr1).Value = Checked
'            lTop = Forms(FormIndex).PropLabel(Cntr1).Top
'            lLeft = Forms(FormIndex).PropLabel(Cntr1).Left
'            vTop = Forms(FormIndex).PropValue(Cntr1).Top
'            vleft = Forms(FormIndex).PropValue(Cntr1).Left
'            t = SetProperty(LGadget, lPropName & " lTop", lTop)
'            t = SetProperty(LGadget, lPropName & " lLeft", lLeft)
'            t = SetProperty(LGadget, lPropName & " vTop", vTop)
'            t = SetProperty(LGadget, lPropName & " vLeft", vleft)
'            TotProps = TotProps + 5
'            Msg = Msg & CStr(Cntr1) & ") " & Left(PropLabel(Cntr1), Len(PropLabel(Cntr1)) - 2) & ": " & PropValue(Cntr1) & CrLf
        Else
            ' find the culprit (not a textbox control)
            For CNTR2 = 0 To Forms(FormIndex).Controls.Count - 1
                If Val(Forms(FormIndex).Controls(CNTR2).Tag) = Cntr1 Then
                    lPropName = Left(Forms(FormIndex).PropLabel(Cntr1), Len(Forms(FormIndex).PropLabel(Cntr1)) - 2)
                    lPropValue = Forms(FormIndex).Controls(CNTR2)
                    PropValueRequired = Forms(FormIndex).Required(Cntr1).Value = Checked
'                    lTop = Forms(FormIndex).PropLabel(Cntr1).Top
'                    lLeft = Forms(FormIndex).PropLabel(Cntr1).Left
'                    vTop = Forms(FormIndex).Controls(Cntr2).Top
'                    vleft = Forms(FormIndex).Controls(Cntr2).Left
'                    t = SetProperty(LGadget, lPropName & " lTop", lTop)
'                    t = SetProperty(LGadget, lPropName & " lLeft", lLeft)
'                    t = SetProperty(LGadget, lPropName & " vTop", vTop)
'                    t = SetProperty(LGadget, lPropName & " vLeft", vleft)
'                    TotProps = TotProps + 5
                End If
            Next
'            Msg = t & CrLf
        End If
        If PropValueRequired And Len(AllTrim(lPropValue)) = 0 Then
            OKToWriteObject = False
            Exit For
        End If
        t = SetProperty(LGadget, lPropName, lPropValue)
    Next
    ' which database?
    t = ReadProperty(Param, "DBGadgetsPTR")
    If t = NotFound Then
        lDBGadgetsPTR = DBGadgetsPTR
    Else
        lDBGadgetsPTR = Val(t)
    End If
    If DBGadgetsPTR <> lDBGadgetsPTR Then
        t = DBSwitch(lDBGadgetsPTR)
    End If
    ' save the object
    If OKToWriteObject Then
        Cntr1 = LGadget.ObjectID
        Msg = SetProperty(LGadget, "(Source Form)", FormName)
        t = WriteMemGadget(LGadget.ObjectID, LGadget)
        If (Cntr1 > 0) And (Cntr1 <> LGadget.ObjectID) Then
            MsgBox "Error Writing Screen to Disk", , UCase(App.EXEName) & " Debug Message"
        End If
        Msg = SetProperty(LGadget, "Write Status", CStr(t))
        Msg = SetProperty(LGadget, "ObjectID Before Write", CStr(Cntr1))
        Msg = SetProperty(LGadget, "ObjectID After Write", CStr(LGadget.ObjectID))
    Else
        Msg = SetProperty(LGadget, "Write Status", "Error")
        Msg = SetProperty(LGadget, "Write Error", "Required Field: " & lPropName & " is Empty")
        Msg = SetProperty(LGadget, "Write Error Field Index", CStr(Cntr1))
'        Msg = SetProperty(LGadget, "Write Error Description", lPropName)
    End If
    GoTo EndSub
LocalError:
    LocalError = Error
    Resume Next
EndSub:
    ResultsGadget = LGadget
    GodWriteScreenAsObject = ResultsGadget
    If DBGadgetsPTR <> StartDBGadgetsPTR Then
        t = DBSwitch(StartDBGadgetsPTR)
    End If
    On Error GoTo 0
End Function
Friend Function GODReadObjectAsScreen(Param As Gadget) As Gadget
    ' reads a screen as a GDS compliant object.
    ' required adherence to strict layout.
    Dim t, Msg As String, Cntr1 As Integer, CNTR2 As Integer
    Dim ResultsGadget As Gadget
    Dim StartDBGadgetsPTR As Integer
    Dim lDBGadgetsPTR As Integer
    Dim LGadget As Gadget
    Dim lPropName As String, lPropValue As String
    Dim StartPropNDX As Integer, EndPropNDX As Integer
    Dim LocalError As String
    Dim FormName As String, FormIndex As Integer
    Dim DefaultValue As String
    StartDBGadgetsPTR = DBGadgetsPTR
    On Error GoTo LocalError
    DefaultValue = ReadProperty(Param, "Default Prop Value")
    If DefaultValue = NotFound Then
        DefaultValue = ""
    End If
    ' which form?
    FormName = ReadProperty(Param, "Form Name")
    If FormName = NotFound Then
        FormName = Screen.ActiveForm.Name
    End If
    For FormIndex = 0 To Forms.Count - 1
        If Forms(FormIndex).Name = FormName Then
            Exit For
        End If
    Next
    ' which database?
    t = ReadProperty(Param, "DBGadgetsPTR")
    If t = NotFound Then
        lDBGadgetsPTR = DBGadgetsPTR
    Else
        lDBGadgetsPTR = Val(t)
    End If
    If DBGadgetsPTR <> lDBGadgetsPTR Then
        t = DBSwitch(lDBGadgetsPTR)
    End If
    
'    ObjectIDToLoad = Val(ReadProperty(Param, "ObjectID"))
    Select Case True
        Case Param.ObjectID = 0 And (Param.Name = "" Or Param.Name = BlankObject.Name)
            ' basically clear screen
            LGadget = Param
        Case Param.ObjectID > 0
            t = ReadGadgetByID(Param.ObjectID)
            LGadget = ReadObjectBuffer
        Case Param.Name <> ""
            t = ReadGadgetByName(Param.Name, LGadget)
        
    End Select
'    ShowObject Dematerialize(LGadget), "m "
    ' this thing can read between 2 property index values
    ' defaults to all properties on screen
    t = ReadProperty(Param, "StartPropNDX")
    If t = NotFound Then
        StartPropNDX = 0
    Else
        StartPropNDX = Val(t)
    End If
    t = ReadProperty(Param, "EndPropNDX")
    If t = NotFound Then
        EndPropNDX = Val(Forms(FormIndex).TotIndex)
    Else
        EndPropNDX = Val(t)
    End If
    
    For Cntr1 = StartPropNDX To EndPropNDX
        LocalError = ""
        t = Forms(FormIndex).PropLabel(Cntr1)
        lPropName = Left(Forms(FormIndex).PropLabel(Cntr1), Len(Forms(FormIndex).PropLabel(Cntr1)) - 2)
        t = ReadProperty(LGadget, lPropName)
        LocalError = ""
        Forms(FormIndex).PropValue(Cntr1) = t
        If LocalError = "" Then
            If t <> NotFound Then
                Forms(FormIndex).PropValue(Cntr1) = t
            Else
                Forms(FormIndex).PropValue(Cntr1) = DefaultValue
            End If
        Else
            For CNTR2 = 0 To Forms(FormIndex).Controls.Count - 1
                
                If Forms(FormIndex).Controls(CNTR2).Tag <> "" Then
                    If Val(Forms(FormIndex).Controls(CNTR2).Tag) = Cntr1 Then
                        ' this is the control
                        If t <> NotFound Then
                            Forms(FormIndex).Controls(CNTR2) = t
                        Else
                            Forms(FormIndex).Controls(CNTR2) = DefaultValue
                        End If
                    End If
                End If
            Next
        End If
        If t = OK Then
        End If
'        For Cntr2 = 1 To LGadget.TotalProperties
        
'        lPropName = Left(Forms(FormIndex).PropLabel(Cntr1), Len(Forms(FormIndex).PropLabel(Cntr1)) - 2)
    DoEvents
    Next
    GoTo EndSub
LocalError:
    LocalError = Error
    Resume Next
EndSub:
    DBSwitch StartDBGadgetsPTR
    On Error GoTo 0
End Function

'Public Sub HandlePopUp(CurrentControl As Control, PUPIndex As Integer)
'    MsgBox CurrentControl.Name
'End Sub
'Public Function SynchScreenAndMDB() As String
'    Static LastObjectName As String
'    Dim Crit, Msg, t
'    Dim ndx As Long
'    Dim NewRS As String
'    Dim ObjectName As String
'    Dim Results As String
'    Results = "OK"
'    Set Currentform = Screen.ActiveForm
'    Set CurrentControl = Screen.ActiveForm.ActiveControl
'    ObjectName = CurrentControl.Name
'
'    If LastObjectName = ObjectName Then
'        'adios
'        SynchScreenAndMDB = "OK"
'        GoTo EndSSAMDB:
'    End If
'    Results = ReadGadgetByName(ObjectName, CurrentObject)
''    CurrentObjectName = CurrentObject.Name
''    CurrentObjectID = CurrentObject.ObjectID
'    GoTo EndSSAMDB:
'    Crit = "Name='" & ObjectName & "'"
'    Currentform.Data_Objects.Recordset.FindFirst Crit
'    If Currentform.Data_Objects.Recordset.NoMatch = True Then
''        MsgBox "Program goof, didn't find the Object to Synchronize: " & ObjectName
'        Results = "ERROR: Program goof, didn't find the Object to Synchronize: " & ObjectName
'        GoTo EndSSAMDB:
'    End If
'
'    NewRS = ""
'    NewRS = NewRS & "SELECT DISTINCTROW "
'    NewRS = NewRS & "Props.ObjectID, "
'    NewRS = NewRS & "Props.PropertyID, "
'    NewRS = NewRS & "Props.Property, "
'    NewRS = NewRS & "Props.Caption, "
'    NewRS = NewRS & "Props.ValueAlpha, "
'    NewRS = NewRS & "Props.ValueNum, "
'    NewRS = NewRS & "Props.PropSource, "
'    NewRS = NewRS & "Props.PropType "
'    NewRS = NewRS & "From Props "
'    NewRS = NewRS & "Where ObjectID=" & Currentform.Data_Objects.Recordset![ObjectID] & " "
'    NewRS = NewRS & "ORDER BY Props.Property;"
'    If Currentform.Data_OBJProperties.RecordSource = NewRS Then
'        GoTo EndSSAMDB:
'    End If
'    Currentform.Data_OBJProperties.RecordSource = NewRS
'    Currentform.Data_OBJProperties.Refresh
'    LastObjectName = Currentform.Data_Objects.Recordset![Name]
'
'    ReDim PropertyNames(0), PropertyValues(0)
'    PropertyNames(0) = Currentform.Data_Objects.Recordset![Name]
'    PropertyValues(0) = AllTrim(Str(Currentform.Data_Objects.Recordset![ObjectID]))
'    Msg = PropertyNames(0) & ": " & PropertyValues(0) & CrLf
'    ndx = 0
'    Currentform.Data_OBJProperties.Recordset.MoveFirst
'    Do Until Currentform.Data_OBJProperties.Recordset.EOF
'        ndx = ndx + 1
'        ReDim Preserve PropertyNames(ndx)
'        ReDim Preserve PropertyValues(ndx)
'        PropertyNames(ndx) = Currentform.Data_OBJProperties.Recordset![Property]
'        PropertyValues(ndx) = Currentform.Data_OBJProperties.Recordset![ValueAlpha]
''        Msg = Msg & PropertyNames(NDX) & ": " & PropertyValues(NDX) & CrLf
'        Currentform.Data_OBJProperties.Recordset.MoveNext
'    Loop
''    MsgBox Msg
'EndSSAMDB:
'    SynchScreenAndMDB = Results
'    GDSFreelocks
''    ReadGadgetByName ObjectName, CurrentObject
'End Function
'Public Function IsFRMObjectInGadgetor(CheckForm As Form, CheckControl As Control)
'    ' see if a control on a form is already defined as a GDS Gadget
'    ' can't remember last time i used this
'    Dim Crit As String
'    Dim CurrentControlType As String
'    CurrentControlType = ""
'    CurrentControlType = GetControlTypeOf(CheckForm, CheckControl)
'    If CurrentControlType = "" Then
''        MsgBox "Couldn't determine typeof " & CheckControl.Name
'        IsFRMObjectInGadgetor = "ERROR! Couldn't get Typeof " & CheckControl
'        Exit Function
'    End If
'    Crit = "Name='" & CheckControl.Name & "'"
'    CheckForm.Data_Objects.Recordset.FindFirst Crit
'    If CheckForm.Data_Objects.Recordset.NoMatch = True Then
'        IsFRMObjectInGadgetor = "NO"
'    Else
'        IsFRMObjectInGadgetor = "YES"
'    End If
'End Function

'Public Sub Global16JETInit(JetName)
'   ' initialization of variables used everywhere I write code
'   ' getting big change here, 8/5/98
'   ' GDSINT function replaces in 99.99% of time
'    Dim t, Msg, SQLCmd As String, starttime As Single, stoptime As Single
'    Dim AddedID As Long
'    Dim QueryRS As Recordset
'    Dim Crit As String
'    Dim LocalError As String
'    LocalError = ""
'    On Error GoTo LocalError
''    GDSFirst
''    SetVariables
'    ' need to set up the jet database
'    ' see if the ini file exists
''    APPINIFileName = App.Path & "\" & ucase(App.EXEName) & ".ini"
'    JetDatabaseName = JetName
'    ChDir App.Path
'
'    If Not FileExists(JetDatabaseName) Then
'        MsgBox " Call Real World Solutions for assistance.", , "Something isn't right!"
'        End
'    End If
'    GODMode = "Disk"
'    If Not FileExists(APPINIFileName) Then
'        ' need to create the .INI file here
'        Open APPINIFileName For Output As #1
'        Print #1, "[Data]"
'        Print #1, "Application=" & ucase(App.EXEName)
'        Print #1, "Path=" & CurDir
'        Print #1, "Whozits=Jet"
'        Print #1, "Open=" & CurDir & "\" & JetDatabaseName
'        Print #1, "GODMode=" & GODMode
'        Print #1, "[Options]"
'        Print #1, "SystemDB=" & CurDir & "\RWSSYS.RWS"
'        Close #1
'        Msg = ""
'        Msg = Msg & "Auto Configuration of Initialization File:" & CrLf
'        Msg = Msg & APPINIFileName & CrLf
'        Msg = Msg & "[Data]" & CrLf
'        Msg = Msg & "Application=" & ucase(App.EXEName) & CrLf
'        Msg = Msg & "Path=" & CurDir & CrLf
'        Msg = Msg & "Open=" & CurDir & "\" & JetDatabaseName & CrLf
'        Msg = Msg & "Mode=" & GODMode
''        MsgBox Msg, vbOKOnly, "Just in case you actually give a whiz."
''        Fileform.Show
'    End If
'    JetDatabasePath = GetINIParameter(APPINIFileName, "Data", "Path")
'    If Right(JetDatabasePath, 1) <> "\" Then
'        JetDatabasePath = JetDatabasePath & "\"
'    End If
'    If (CurDir <> JetDatabasePath) And _
'       (CurDir <> Left(JetDatabasePath, Len(JetDatabasePath) - 1)) Then
'        ChDrive Left(JetDatabasePath, 1)
'        ChDir Right(JetDatabasePath, Len(JetDatabasePath) - 2)
'    End If
'    If (CurDir <> JetDatabasePath) And _
'       (CurDir <> Left(JetDatabasePath, Len(JetDatabasePath) - 1)) Then
'        Msg = Msg & "Directory Error! I Could not set Directory to " & CrLf
'        Msg = Msg & JetDatabasePath & CrLf & CrLf
'        Msg = Msg & "This is the 2nd time I have tried." & CrLf
'        Msg = Msg & "Something is very wrong here." & CrLf
'        Msg = Msg & "I'm really confused, apparently." & CrLf
'        Msg = Msg & "I need some serious therapy." & CrLf
'        Msg = Msg & "I'm shutting down, now.  Try again, please." & CrLf
'        Msg = Msg & "If This problem persists, call for help!" & CrLf
'        MsgBox Msg & JetDatabasePath, vbOKOnly, "I just can't go on..."
'        CloseEverything
'        End
'    End If
'    ' opendb(0).name
'    APPProgramHomeDir = CurDir
'    SelectedDrive = Left(CurDir(), 1) & ":"
'    SelectedPath = CurDir
'    OpenDBCNTR = OpenDBCNTR + 1
'    OpenDBPTR = OpenDBCNTR
'    ReDim Preserve OpenDB(OpenDBPTR)
'    DBEngine.IniPath = APPINIFileName
'    DBEngine.DefaultUser = "VBasic"
'    DBEngine.DefaultPassword = "TLHicky"
''    Set GadgetWorkspace = DBEngine.CreateWorkspace(JetName, "VBasic", "TLHicky")
'    Set JetDatabase = GadgetWorkspace.OpenDatabase(JetDatabaseName)
'    Set OpenDB(OpenDBPTR) = JetDatabase
'    Set ObjectsRS = JetDatabase.OpenRecordset("Objects", dbOpenTable) ', dbForwardOnly)
'    ObjectsRS.Index = "PrimaryKey"
'    If ObjectsRS.RecordCount = 0 Then
'        Msg = "Something is apparently wrong with your System." & CrLf
'        Msg = Msg & "I detected that there are zero records when it is impossible." & CrLf
'        Msg = Msg & "Well, not impossible since I see that it is so." & CrLf
'        Msg = Msg & "I need to take a few moments and relax, take a deep breath" & CrLf
'        Msg = Msg & "and see if I can fix this propblem.  Please say OK so I can" & CrLf
'        Msg = Msg & "Start." & CrLf
'        MsgBox Msg, vbOKOnly, "Whenever you are ready."
'        GDSFreelocks
'        JetDatabase.Close
'        DBEngine.RepairDatabase JetDatabaseName
'        DoEvents
''        Set JetDatabase = OpenDataBase(JetDatabaseName)
'        Set ObjectsRS = JetDatabase.OpenRecordset("Objects", dbOpenTable) ', dbForwardOnly)
'        ObjectsRS.Index = "PrimaryKey"
'    End If
'    If ObjectsRS.RecordCount = 0 Then
'        Msg = "Something is apparently really wrong with your System." & CrLf
'        Msg = Msg & "I detected zero System records twice." & CrLf
'        Msg = Msg & "I need to take a leave of absence." & CrLf
'        Msg = Msg & "If this occurs upon starting me again, call for tech support." & CrLf
'        Msg = Msg & "I will shut down when you say so." & CrLf
'        MsgBox Msg, vbOKOnly, "Whenever you are ready."
'        GDSFreelocks
'        JetDatabase.Close
'        End
'    End If
'    Set PropsRS = JetDatabase.OpenRecordset("Props", dbOpenTable) ', dbForwardOnly)
'    PropsRS.Index = "ObjectID"
'    Set MethodsRS = JetDatabase.OpenRecordset("Methods", dbOpenTable) ', dbForwardOnly)
'    MethodsRS.Index = "ObjectID"
''    StartTime = Timer
'    GODMode = GetINIParameter(APPINIFileName, "Data", "GODMODE")
'    ' need to define a blank object as a template
''    t = ReadGadgetByName("BlankObject", BlankObject)
''    If t <> "OK" Or BlankObject.Container <> "BlankObject" Then
''        AddedID = GODAddObject("BlankObject", _
''                               "BlankObject", _
''                               "BlankObject", _
''                               "UNCONDITIONAL")
''        t = ReadGadgetByName("BlankObject", BlankObject)
''        If t <> "OK" Then
''            MsgBox t
''        End If
''    End If
''    BlankObject.ObjectID = 0
'    ' the application gadget contains the application-specific properties
'    ' need to define the multiple database scenario
''    Set ObjectsRS = OpenRS(0)
''    t = ReadGadgetByName(ucase(App.EXEName), CurrentObject)
''    If t <> "OK" Then
''        AppGadget = BlankObject
''        AppGadget.Type = "AppGadget"
''        AppGadget.Container = "GDS Registry"
''        AppGadget.GAppName = ucase(App.EXEName)
''        AppGadget.Name = ucase(App.EXEName)
''        Msg = SetProperty(GDSRegistry, "Installed", "True")
''        Msg = SetProperty(GDSRegistry, "DataBase", JetName)
''        Msg = SetProperty(GDSRegistry, "Active", "True")
''        Msg = SetProperty(AppGadget, "")
''    End If
''    AppGadget = CurrentObject
'    t = ReadGadgetByName("DBF Definition", CurrentObject)
'    If t <> "OK" Then
'
'    End If
'    GoTo EndSub
'LocalError:
'    LocalError = Error
'    Resume Next
'EndSub:
'    GDSFreelocks
'    On Error GoTo 0
'End Sub

Friend Function UtilitiesRepair(Param As Gadget) As Gadget
    ' repair passed jet database
    Dim t, Msg As String
    Dim LParam As Gadget
    Dim LOCDBPTR As Integer
    Dim LocalError As String
    Dim PingParam As Gadget
    Dim Result As String
    Dim ResultsGadget As Gadget
    Dim DBName As String
    DBName = OpenDB(LOCDBPTR).Name
    Result = "OK"
    On Error GoTo LocalError
    t = SetProperty(Param, "Status", "Started")
    t = SetProperty(Param, "Errors", "None")
    LocalError = ""
    LOCDBPTR = Val(ReadProperty(Param, "DBGadgetsPtr"))
    Msg = DBSwitch(LOCDBPTR)
    If Msg <> "OK" Then
        t = SetProperty(Param, "Errors", DBName & " Disabled")
        GoTo EndSub
    End If
    OpenDB(LOCDBPTR).Close
    t = SetProperty(Param, "Status", DBName & " Closed")
    LocalError = ""
    DBEngine.RepairDatabase JetDatabaseName
    If LocalError <> "" Then
        Result = LocalError
        Msg = "The Following Error Occurred:" & CrLf
        Msg = Msg & LocalError & CrLf
        Msg = Msg & "Repair Function Did Not Complete!" & CrLf
        MsgBox Msg, vbExclamation, "Errors Encountered"
        Result = LocalError
        GoTo ReopenFile
    End If
ReopenFile:
    ' reopen it?
    If ReadProperty(Param, "Reopen") = "True" Then
        LParam = DBGadgets(LOCDBPTR)
        t = SetProperty(LParam, "Reset Gadgets", "False")
        Msg = ReadProperty(Param, "Force OpenDBPTR")
        If Msg <> NotFound Then
            t = SetProperty(LParam, "Force OpenDBPTR", Msg)
        End If
        ResultsGadget = OpenJetDataBase(LParam)
        t = SetProperty(Param, "Status Final", OpenDB(LOCDBPTR).Name & " Reopened")
    End If
    GoTo EndSub
LocalError:
    LocalError = Error$
    Msg = ReadProperty(Param, "Errors")
    If Len(Msg) + Len(LocalError) > 128 Then
        Msg = ""
    End If
    Msg = Msg & "/" & LocalError
    t = SetProperty(Param, "Error", Msg)
    Resume Next
EndSub:
    On Error GoTo 0
'    Global16JETInit (DBName)
Abort:
'    InitVGB
    UtilitiesRepair = Param
    ChDrive App.Path
    ChDir App.Path
    On Error GoTo 0
    GDSFreelocks
End Function
Friend Function UtilitiesCompact(Param As Gadget) As Gadget
    ' compact jet database
    Dim t, Msg As String, LocalError As String
    Dim DBName As String
    Dim LParam As Gadget
    Dim LOCDBPTR As Integer
    Dim PingParam As Gadget
    Dim Result As String
    Dim ResultsGadget As Gadget
    Result = "OK"
    On Error GoTo LocalError
    t = SetProperty(Param, "Status", "Started")
    t = SetProperty(Param, "Errors", "None")
    LocalError = ""
    LOCDBPTR = Val(ReadProperty(Param, "DBGadgetsPtr"))
    DBName = OpenDB(LOCDBPTR).Name
    Msg = DBSwitch(LOCDBPTR)
    If Msg <> "OK" Then
        t = SetProperty(Param, "Errors", DBName & " Disabled")
        GoTo EndSub
    End If
    OpenDB(LOCDBPTR).Close
    ChDrive ReadProperty(DBGadgets(LOCDBPTR), "Path")
    ChDir ReadProperty(DBGadgets(LOCDBPTR), "Path")
    If FileExists("Compact.GDS") Then
        SetAttr "Compact.GDS", vbNormal
        Kill "Compact.GDS"
    End If
    DBEngine.CompactDatabase DBName, "Compact.GDS"
    If LocalError <> "" Then
        Msg = "The Following Error Occurred:" & CrLf
        Msg = Msg & LocalError & CrLf
        Msg = Msg & "Compact Function Did Not Complete!" & CrLf
        MsgBox Msg, vbExclamation, "Errors Encountered"
        Result = LocalError
        GoTo ReopenFile
    End If
    If FileExists("GDS.BAK") Then
        SetAttr "GDS.BAK", vbNormal
        Kill "GDS.BAK"
        If FileExists("GDS.LDB") Then
            Kill "GDS.LDB"
        End If
    End If
    Name DBName As "GDS.BAK"
    Name "Compact.GDS" As DBName
    If FileExists("Compact.LDB") Then
        SetAttr "Compact.LDB", vbNormal
        Kill "Compact.LDB"
    End If
ReopenFile:
    ' reopen it?
    If ReadProperty(Param, "Reopen") = "True" Then
        LParam = DBGadgets(LOCDBPTR)
        t = SetProperty(LParam, "Reset Gadgets", "False")
        Msg = ReadProperty(Param, "Force OpenDBPTR")
        If Msg <> NotFound Then
            t = SetProperty(LParam, "Force OpenDBPTR", Msg)
        End If
        ResultsGadget = OpenJetDataBase(LParam)
        t = SetProperty(Param, "Status Final", OpenDB(LOCDBPTR).Name & " Reopened")
    End If
    
'    MsgBox "", vbInformation, "Compact Complete"
    GoTo EndSub
LocalError:
    LocalError = Error$
    Msg = ReadProperty(Param, "Errors")
    If Len(Msg) + Len(LocalError) > 128 Then
        Msg = ""
    End If
    Msg = Msg & "/" & LocalError
    t = SetProperty(Param, "Error", Msg)
    Resume Next
EndSub:
    On Error GoTo 0
'    InitVGB
Abort:
'    Global16JETInit (DBName)
    ChDrive App.Path
    ChDir App.Path
    UtilitiesCompact = Param
    GDSFreelocks
End Function

Friend Function LenTest()
    Dim Msg As String, Cntr1 As Long
    Dim LocalError As String
    On Error GoTo LocalError
    LocalError = ""
    Do
        Msg = Msg & "a"
    Loop Until LocalError <> ""
    MsgBox Len(Msg), , UCase(App.EXEName) & " Debug Message"
    GoTo EndSub
LocalError:
    LocalError = Error
    Resume Next
EndSub:
End Function
Friend Function CloseOPAG(Param As Gadget)
'    ' closes passed OPAG (Object Processing Application Gadget)
'    Dim t, Msg As String, Cntr1 As Integer
'    Dim LParam As Gadget
'    Dim LocalError As String
'    LocalError = ""
'    On Error GoTo LocalError
'' removed for Core
''    If MainForm.ScheduleStatus = "Executing" Then
''        MsgBox "Schedule is being executed, can't terminate", vbExclamation, "Scheduler Busy"
''        GoTo EndSub
''    End If
'
'    If DDEInputCNTR <= 2 Then
'        MsgBox "The Scheduler is not Running", vbExclamation, "Error: Scheduler Not Running"
'        GoTo EndSub
'    End If
''    For Cntr1 = 3 To DDEInputCNTR
''        If DDEControlObject(Cntr1).Name = "RWS_SKED Destination" Then
''            Exit For
''        End If
''    Next
'    LParam = BlankObject
'    LParam.ObjectID = 0
'    DDEPing LParam
'    If InStr(ReadProperty(LParam, "Status"), " Off Line") > 0 Then
'        MsgBox "The Scheduler Application is not responding, can't terminate", vbExclamation, "Error: Application offline"
'        GoTo EndSub
'    End If
'    Msg = "Are you sure you want to Termiate the Scheduler Application?" & CrLf
'    Msg = Msg & "Note: Any Scheduled Operations will not occur"
'    t = MsgBox(Msg, vbYesNo + vbDefaultButton2 + vbQuestion, "Confirm Application Shutdown")
'    If t <> vbYes Then
'        GoTo EndSub:
'    End If
'    Cntr1 = 3
'    OPAG_IO.DDEInput(AppDDEIndex).Text = ""
''    DDEInputDisabled = False
'    DoEvents
'    WasteTime 1
'    If OPAG_IO.DDEInput(Cntr1).Text = "" Then
'        MsgBox "Scheduler did not respond, assuming it is not running"
'    End If
'    If InStr(OPAG_IO.DDEInput(Cntr1).Text, "Can't Stop") > 0 Then
'        MsgBox "Scheduler is busy, Can't Terminate Now.", vbExclamation, "Scheduler Application Can't Stop"
'        GoTo EndSub
'    End If
''    DDEPing BlankObject
''    MainForm.ScheduleStatus = "Not Loaded"
'    GoTo EndSub
'LocalError:
'    LocalError = Error
'    Resume Next
'EndSub:
''    Screen.MousePointer = NORMAL
'    On Error GoTo 0
'    GDSFreelocks
End Function
Friend Sub WriteLockTest()
    Dim t, Msg As String, DBToUse As Integer
    Dim TotDone As Long
    Dim TempRS As Recordset
    DBToUse = Val(InputBox("Enter Database #:", UCase(App.EXEName) & ": Write Test Parameters", "8"))
    If DBToUse = 0 Then GoTo EndSub
    Set TempRS = OpenDB(DBToUse).OpenRecordset("Objects", dbOpenTable)
    DBSwitch DBToUse
    
    Do While True = True
        TempRS.MoveFirst
        Do While TempRS.EOF = False
            TotDone = TotDone + 1
            t = ReadGadgetByID(TempRS!ObjectID)
            t = WriteMemGadget(ReadObjectBuffer.ObjectID, ReadObjectBuffer)
'            TempRS.MoveNext
'            DoEvents
            If AbortRead Then Exit Do
        Loop
        If AbortRead Then Exit Do
    Loop
    
EndSub:
    DBSwitch 1
End Sub

Friend Function GDSFreelocks()
    DBEngine.Idle dbFreeLocks
End Function
Friend Function NOPU(Task As Gadget, Param As Gadget) As Gadget
    ' dummy function for non opag processing units
End Function

Friend Function OpenRecordsetTest(Param As Gadget) As Gadget
    ' this will tell you a total number of recorsets you can open
    ' increase the cnt1 til you get an error
    Dim t, Msg As String, Cntr1 As Integer
    Dim starttime As Single, stoptime As Single
    Dim LocRS() As Recordset
    starttime = Timer
    For Cntr1 = 1 To 200
        ReDim Preserve LocRS(Cntr1)
        Set LocRS(Cntr1) = OpenDB(OpenDBPTR).OpenRecordset("Objects", dbOpenTable)
    Next
    stoptime = Timer
    MsgBox stoptime - starttime, , "Set Recordset test"
    For Cntr1 = 1 To 200
        LocRS(Cntr1).Close
    Next
End Function


'///////////////////////////////////////////////////////////
'//////////////////////////////////////////////////////////
' Gadgetor Internal Tasks, not available to external programs
Friend Function AppAttach(AppToUse As Gadget) As Gadget
    ' this loads all appgadgets from the VGBDatabaseName file
    ' and creates them if necessary
    Dim t, Msg As String, Cntr1 As Integer
    Dim RREsults As Gadget, MResults As Gadget
    Dim AppPath As String, AppName As String, AppPathAndName As String
    Dim Dirty As Boolean
    Dim StartAppPTR As Integer, StartDBPTR As Integer
    Dim LParam As Gadget
    Dim NOPAGPath As String
    Dim UserInput As String, Default As String
    Dim LocalError As String
    On Error GoTo LocalError
    
    SetProperty Trace, NextID("trace") & "AppAttach", AppToUse.Name
    StartDBPTR = DBGadgetsPTR
    StartAppPTR = AppGadgetsPTR
    If StartDBPTR <> 0 Then
        DBSwitch 0
    End If
    AppPath = AddBackSlash(ReadProperty(AppToUse, "AppPath"))
    AppName = ReadProperty(AppToUse, "AppName")
    If AppName = NotFound Then
        AppName = AppToUse.Name
    End If
    
    LParam = BlankObject
    ' see if the app gadget exists
    For AppGadgetsPTR = 1 To AppGadgetsCNTR
        If AppGadgets(AppGadgetsPTR).Name = AppName Then
            ' already loaded
            Exit For
        End If
    Next
    If (AppGadgetsPTR > AppGadgetsCNTR) Or (AppGadgetsCNTR = 0) Then
        ' not loaded, do so
        AppGadgetsCNTR = AppGadgetsCNTR + 1
        AppGadgetsPTR = AppGadgetsCNTR
        ReDim Preserve AppGadgets(AppGadgetsCNTR)
        RREsults = Recall(AppName, "From " & VGBDatabaseNameAndPath)
        If RREsults.Name = AppName Then
'            SetProperty Trace, NextID("trace") & "Attached App", AppName & " Exists"
            ' found on disk
            AppToUse.ObjectID = RREsults.ObjectID
            SetProperty AppToUse, "Registered Date", ReadProperty(RREsults, "Registered Date")
            SetProperty AppToUse, "Registered Time", ReadProperty(RREsults, "Registered Time")
        Else
'            SetProperty Trace, NextID("trace") & "Attached App", AppName & " Added"
            SetProperty AppToUse, "Registered Date", Format(Now, "Long Date")
            SetProperty AppToUse, "Registered Time", Format(Now, "Long Time")
        End If
        AppGadgets(AppGadgetsPTR) = AppToUse
        ' save the passed object to disk
        MResults = Memorize(AppGadgets(AppGadgetsPTR), "in " & VGBDatabaseNameAndPath)
    End If
    ' here we have the app on disk and in memory
    ' we're done
GoTo EndSub
    
    
    
    
    
    
    
'    CurrentObject = Recall(App.EXEName)
'    If UCase(CurrentObject.Name) <> UCase(App.EXEName) Then
'        ' the me isn't here, make it
''        MsgBox "Adding Application: " & ucase(App.EXEName), , "Application Setup"
'        ' no apps are registered
'        ' can register me now
'        AppGadgetsCNTR = AppGadgetsCNTR + 1
'        AppGadgetsPTR = AppGadgetsCNTR
'        ReDim Preserve AppGadgets(AppGadgetsCNTR)
'        AppGadgets(AppGadgetsPTR) = BlankObject
'        AppGadgets(AppGadgetsPTR).ObjectID = 0
'        AppGadgets(AppGadgetsPTR).Name = UCase(App.EXEName)
'        AppGadgets(AppGadgetsPTR).Container = "GDS Registry"
'        AppGadgets(AppGadgetsPTR).Type = "AppGadget"
'        AppGadgets(AppGadgetsPTR).GAppName = UCase(App.EXEName)
'        t = SetProperty(AppGadgets(AppGadgetsPTR), "AppPath", App.Path)
'        t = SetProperty(AppGadgets(AppGadgetsPTR), "AppINIFile", UCase(App.EXEName) & ".INI")
'        t = SetProperty(AppGadgets(AppGadgetsPTR), "Long Name", "None")
'        t = SetProperty(AppGadgets(AppGadgetsPTR), "Site Name", "None")
'        t = SetProperty(AppGadgets(AppGadgetsPTR), "Registered Date", Format(Now, "Long Date"))
'        t = SetProperty(AppGadgets(AppGadgetsPTR), "Registered Time", Format(Now, "Long Time"))
'        t = SetProperty(AppGadgets(AppGadgetsPTR), "Status", "Initializing")
'        t = SetProperty(AppGadgets(AppGadgetsPTR), "Last Activated Date", Format(Now, "Long Date"))
'        t = SetProperty(AppGadgets(AppGadgetsPTR), "Last Activated Time", Format(Now, "Long Time"))
'        t = SetProperty(AppGadgets(AppGadgetsPTR), "NetID", "None")
'    Else
'        Msg = "Add"
'        For Cntr1 = 1 To AppGadgetsCNTR
'            If AppGadgets(Cntr1).Name = UCase(App.EXEName) Then
'                Msg = "No"
'                AppGadgetsPTR = Cntr1
'                Exit For
'            End If
'        Next
'        If Msg = "Add" Then
'            AppGadgetsCNTR = AppGadgetsCNTR + 1
'            AppGadgetsPTR = AppGadgetsCNTR
'            ReDim Preserve AppGadgets(AppGadgetsCNTR)
'            AppGadgets(AppGadgetsPTR) = CurrentObject
'        End If
'        t = SetProperty(AppGadgets(AppGadgetsPTR), "Status", "Initializing")
'    End If
'    ' this are fixups
'    ' all gds apps are opags, after all
'    ' opags are (o)bject (p)rocessing (a)pplication (g)adgets
'    If ReadProperty(AppGadgets(AppGadgetsPTR), "App Type") = NotFound Then
'        t = SetProperty(AppGadgets(AppGadgetsPTR), "App Type", "OPAG")
''        t = WriteMemGadget(AppGadgets(AppGadgetsPTR).ObjectID, AppGadgets(AppGadgetsPTR))
'    End If
''    If ReadProperty(AppGadgets(AppGadgetsPTR), "App Type") = "OPAG" Then
''        t = SetProperty(AppGadgets(AppGadgetsPTR), "App Type", "OPAG")
''        t = WriteMemGadget(AppGadgets(AppGadgetsPTR).ObjectID, AppGadgets(AppGadgetsPTR))
''    End If
'    t = WriteMemGadget(AppGadgets(AppGadgetsPTR).ObjectID, AppGadgets(AppGadgetsPTR))
'    ' reset the arrays to 0?
'    If ReadProperty(AppToUse, "Reset Gadgets") = "True" Then
'        ReDim AppGadgets(0)
'        AppGadgetsCNTR = 0
'        AppGadgetsPTR = 0
'    End If
'    ObjectsRS.Index = "Type"
'    ObjectsRS.Seek "=", "AppGadget"
'    Do While ObjectsRS.NoMatch = False
'        Msg = "Add"
'        For AppGadgetsPTR = 0 To AppGadgetsCNTR
'            If AppGadgets(AppGadgetsPTR).Name = ObjectsRS!Name Then
'                Msg = "No"
'                Exit For
'            End If
'        Next
'        If Msg = "Add" Then
'            AppGadgetsCNTR = AppGadgetsCNTR + 1
'            AppGadgetsPTR = AppGadgetsCNTR
'            ReDim Preserve AppGadgets(AppGadgetsCNTR)
'            t = ReadGadgetByID(ObjectsRS!ObjectID)
'            AppGadgets(AppGadgetsPTR) = ReadObjectBuffer
'        End If
'        ObjectsRS.MoveNext
'        If ObjectsRS.EOF Then Exit Do
'        If ObjectsRS!Type <> "AppGadget" Then Exit Do
'    Loop
'    ' set the meappptr
'    For AppGadgetsPTR = 0 To AppGadgetsCNTR
'        If AppGadgets(AppGadgetsPTR).Name = UCase(App.EXEName) Then
'            MeAppPTR = AppGadgetsPTR
'            Exit For
'        End If
'    Next
'    If AppGadgetsPTR > AppGadgetsCNTR Then
'        ' problem, no me.  bad juju
''        MsgBox "AppGadgetsPTR > AppGadgetsCNTR: No Me Application", , ucase(App.EXEName) & " Debug Message"
'        GoTo EndSub
'    End If
    GoTo EndSub
LocalError:
    LocalError = Error
'    MsgBox "App Load Errror: " & Error, , UCase(App.EXEName) & " Debug Message"
    SetProperty Trace, NextID("trace") & "Trapped App Attach", "Error: " & AppToUse.Name & " / " & LocalError
    SetProperty VGBErrors, NextID("error") & "Trapped App Attach", "Error: " & AppToUse.Name & " / " & LocalError
    Resume Next
EndSub:
    GDSFreelocks
    If DBGadgetsPTR <> StartDBPTR Then
        DBSwitch StartDBPTR
    End If
    
'    SetProperty Trace, NextID("trace") & "App Attached", AppPath & AppName
    SetProperty AppGadgets(AppGadgetsPTR), "Status ", "Recognized @ " & Now
    AppAttach = AppGadgets(AppGadgetsPTR)
    On Error GoTo 0
End Function
Friend Function AppGadgetsLaunch(Param As Gadget)
    ' must start all dependent applications
    Dim t, Msg As String, Cntr1 As Integer
    Dim DateTimeNow As Variant
    Dim ExpireDateTime As Variant
    Dim LocAppPTR As Integer
    Dim LGadget As Gadget
    Dim LaunchIndex As Integer
    Dim LaunchOIDS() As Long, LaunchOIDSCNTR As Integer
    Dim LaunchOK As Boolean
    Dim ShellAppPath As String
    Dim ShellName As String, ShellDelay As Integer
    Dim ThisNetID As String
    Dim MSGFormVisible As Boolean
    MSGFormVisible = False
    ' see if we need to display something
    For Cntr1 = 0 To Forms.Count - 1
        If UCase(Forms(Cntr1).Name) = "GDSMSG" Then
            If Forms(Cntr1).Visible Then
                MSGFormVisible = True
                Exit For
            End If
        End If
    Next
    LaunchIndex = -1
    ' fix this to open the passed appgadget
    
    
    ' is it running?
    ' do non opags first
    ' these are sequence dependent
    ' get the load sequence
    Do
        LaunchIndex = LaunchIndex + 1
        For LocAppPTR = 1 To AppGadgetsCNTR
            If ReadProperty(AppGadgets(LocAppPTR), "App Type") <> "OPAG" And _
               ReadProperty(AppGadgets(LocAppPTR), "Auto Start") = "True" Then
                If Val(ReadProperty(AppGadgets(LocAppPTR), "Shell Sequence")) = LaunchIndex Then
                    LaunchOIDSCNTR = LaunchOIDSCNTR + 1
                    ReDim Preserve LaunchOIDS(LaunchOIDSCNTR)
                    LaunchOIDS(LaunchOIDSCNTR) = LocAppPTR
                End If
            End If
        Next
    Loop Until LaunchIndex >= AppGadgetsCNTR
    ' got all the non opags in sequence, start 'em
    LGadget = BlankObject
    LGadget.Name = "AppActivate Param"
    For LaunchIndex = 1 To LaunchOIDSCNTR
        If ReadProperty(AppGadgets(LaunchOIDS(LaunchIndex)), "Auto Start") <> "True" Then
            ' this is not an autostart app
            GoTo NextApp1
        End If
        ShellAppPath = UCase(ReadProperty(AppGadgets(LaunchOIDS(LaunchIndex)), "AppPath"))
        If Right(ShellAppPath, 1) <> "\" Then
            ShellAppPath = ShellAppPath & "\"
        End If
        ShellName = UCase(AppGadgets(LaunchOIDS(LaunchIndex)).Name & ".EXE")
        If MSGFormVisible Then
            GDSMsg.MsgText2 = "Checking: " & ReadProperty(AppGadgets(LaunchOIDS(LaunchIndex)), "Long Name")
            WasteTime 0.5
        End If
        ShellDelay = Val(ReadProperty(AppGadgets(LaunchOIDS(LaunchIndex)), "Shell Delay"))
        ThisNetID = ReadProperty(AppGadgets(LaunchOIDS(LaunchIndex)), "NetID")
        If Not FileExists(ShellAppPath & ShellName) Then
            GoTo NextApp1
        End If
        If ThisNetID <> "None" Then
            ' this is a net dde app, not on this
            GoTo NextApp1
        End If
        t = SetProperty(AppGadgets(LaunchOIDS(LaunchIndex)), "Status", "Not Running")
'        ShowObject Dematerialize(AppGadgets(LaunchOIDS(LaunchIndex))), "m"
        LGadget = BlankObject
        LGadget.Name = "App Detect Param"
        t = SetProperty(LGadget, "Application", ShellName)
        t = GDSAppActive(LGadget)
        If t = False Then
            ' this app is not running, need to fire it up
            GDSMsg.MsgText2 = "Launching: " & ReadProperty(AppGadgets(LaunchOIDS(LaunchIndex)), "Long Name")
            Shell ShellAppPath & ShellName, vbNormalNoFocus
            DateTimeNow = Format(Date, "mm/dd/yyyy")
            DateTimeNow = DateTimeNow & " " & Format(Time, "Long time")
            ExpireDateTime = CDate(DateAdd("s", 60, DateTimeNow))
            Do
                WasteTime 3
                DateTimeNow = Format(Date, "mm/dd/yyyy")
                DateTimeNow = DateTimeNow & " " & Format(Time, "Long time")
                LaunchOK = GDSAppActive(LGadget)
                Select Case True
                    Case LaunchOK
                        t = SetProperty(AppGadgets(LaunchOIDS(LaunchIndex)), "Status", "Running")
                        t = SetProperty(AppGadgets(AppGadgetsPTR), "Last Activated Date", Format(Now, "Long Date"))
                        t = SetProperty(AppGadgets(AppGadgetsPTR), "Last Activated Time", Format(Now, "Long Time"))
                        WasteTime 3
                        Exit Do
                    Case CDate(DateTimeNow) > CDate(ExpireDateTime)
                        t = SetProperty(AppGadgets(LaunchOIDS(LaunchIndex)), "Status", "Launch Failed")
                        Exit Do
                End Select
            Loop
        Else
            t = SetProperty(AppGadgets(LaunchOIDS(LaunchIndex)), "Status", "Running")
        End If
'        ShowObject Dematerialize(AppGadgets(LaunchOIDS(LaunchIndex))), "m"
'        MsgBox t
NextApp1:
    Next
    ' now do opags
    For LocAppPTR = 1 To AppGadgetsCNTR
        If AppGadgets(LocAppPTR).Name <> UCase(App.EXEName) And _
           ReadProperty(AppGadgets(LocAppPTR), "App Type") = "OPAG" And _
           ReadProperty(AppGadgets(LocAppPTR), "Auto Start") = "True" Then
'            If ReadProperty(AppGadgets(LocAppPTR), "Auto Start") = "True" Then
'                ' this is not an autostart app
'                GoTo NextApp2
'            End If
            ShellAppPath = UCase(ReadProperty(AppGadgets(LocAppPTR), "AppPath"))
            If Right(ShellAppPath, 1) <> "\" Then
                ShellAppPath = ShellAppPath & "\"
            End If
            ShellName = UCase(AppGadgets(LocAppPTR).Name & ".exe")
            ShellDelay = Val(ReadProperty(AppGadgets(LocAppPTR), "Shell Delay"))
            ThisNetID = ReadProperty(AppGadgets(LocAppPTR), "NetID")
            If Not FileExists(ShellAppPath & ShellName) Then
                GoTo NextApp2
            End If
            If ThisNetID <> "None" Then
                ' this is a net dde app, not on this
                GoTo NextApp2
            End If
            t = SetProperty(AppGadgets(LocAppPTR), "Status", "Not Running")
            LGadget = BlankObject
            LGadget.Name = "App Detect Param"
            t = SetProperty(LGadget, "Application", ShellName)
            t = GDSAppActive(LGadget)
            If t = False Then
               ' app is not running, needs started
                Shell ShellAppPath & ShellName, vbNormalNoFocus
                DateTimeNow = Format(Date, "mm/dd/yyyy")
                DateTimeNow = DateTimeNow & " " & Format(Time, "Long time")
                ExpireDateTime = CDate(DateAdd("s", 60, DateTimeNow))
                Do
                    WasteTime 3
                    DateTimeNow = Format(Date, "mm/dd/yyyy")
                    DateTimeNow = DateTimeNow & " " & Format(Time, "Long time")
                    LaunchOK = GDSAppActive(LGadget)
                    Select Case True
                        Case LaunchOK
                            t = SetProperty(AppGadgets(LocAppPTR), "Status", "Running")
                            WasteTime 3
                            Exit Do
                        Case CDate(DateTimeNow) > CDate(ExpireDateTime)
                            Exit Do
                    End Select
                Loop
            Else
                t = SetProperty(AppGadgets(LocAppPTR), "Status", "Running")
            End If
        End If
NextApp2:
    Next
EndSub:
End Function

Friend Function DBGadgetsLoad(Param As Gadget)
    Dim starttime As Single
    starttime = Timer
    Dim t, Msg As String, Cntr1 As Integer, CNTR2 As Integer, Cntr3 As Integer
    Dim AppRSName As String
    Dim StartDBPTR As Integer
    Dim LParam As Gadget
    Dim CurrDBName As String
    Dim CurrDBGadget As Gadget
    Dim ThisDBName As String
    Dim DBCheckName As String
    Dim DelOIDS() As Long, DelOIDSCNTR As Integer
    Dim DelNames() As String
    Dim CurrAppRSGadget As Gadget
    Dim TBookmark As String
    Dim TempRS As Recordset
    Set TempRS = OpenDB(OpenDBPTR).OpenRecordset("Objects", dbOpenTable)
    Dim LocalError As String
    On Error GoTo LocalError
    StartDBPTR = DBGadgetsPTR
    SetProperty Trace, NextID("trace") & "DBGadgetsLoad Start", "Name: " & Param.Name
    If DBGadgetsPTR > 0 Then
        DBSwitch 0
    End If
    LParam = BlankObject
    ' reset the arrays to 0?
    If ReadProperty(Param, "Reset Gadgets") = "True" Then
        ReDim DBGadgets(0)
        DBGadgetsCNTR = 0
        DBGadgetsPTR = 0
    End If
    ' let's see if there are no dbgadgets
    ' i don't think this situation occurs any more
    ObjectsRS.Index = "Type"
    ObjectsRS.Seek "=", "DBGadget"
    If ObjectsRS.NoMatch = True Then
        ' none found, create registry one
        DBGadgetsCNTR = DBGadgetsCNTR + 1
        ReDim Preserve DBGadgets(DBGadgetsCNTR)
        DBGadgets(DBGadgetsCNTR) = BlankObject
        DBGadgets(DBGadgetsCNTR).Name = VGBDatabaseName & "-0"
        DBGadgets(DBGadgetsCNTR).Type = "DBGadget"
        DBGadgets(DBGadgetsCNTR).Container = "AppGadget"
    End If
    ' go with it, open dbs and remove any missing files
    Do While ObjectsRS.NoMatch = False
        SetProperty Trace, NextID("trace") & "DBGadgetsLoad Load Loop", "File Name: " & ObjectsRS!Name
        Msg = "Add"
        TBookmark = ObjectsRS.Bookmark
        ' already loaded?
        For DBGadgetsPTR = 0 To DBGadgetsCNTR
            If DBGadgets(DBGadgetsPTR).Name = ObjectsRS!Name Then
                Msg = "No"
                Exit For
            End If
        Next
        If Msg = "Add" Then
            ' see if the file exists and delete objects not represented by a real file
            t = ReadGadgetByID(ObjectsRS!ObjectID)
            CurrDBGadget = ReadObjectBuffer
            ThisDBName = ReadProperty(CurrDBGadget, "DB Name")
            DBCheckName = ReadProperty(CurrDBGadget, "Path")
            If Right(DBCheckName, 1) <> "\" Then
                DBCheckName = DBCheckName & "\"
            End If
            DBCheckName = DBCheckName & ThisDBName
            SetProperty Trace, NextID("trace") & "DBGadgetsLoad Checking File", "Name: " & DBCheckName
            If Not FileExists(DBCheckName) Then
                ' this file is gone from disk
                ' remove the dbgadgets, appdbgadgets and apprs gadgets associate with it
                ' this is the dbgadget
                SetProperty Trace, NextID("trace") & "DBGadgetsLoad Delete DB", "Name: " & DBCheckName
                Msg = "No Add"
                DelOIDSCNTR = DelOIDSCNTR + 1
                ReDim Preserve DelOIDS(DelOIDSCNTR)
                DelOIDS(DelOIDSCNTR) = CurrDBGadget.ObjectID
                ReDim Preserve DelNames(DelOIDSCNTR)
                DelNames(DelOIDSCNTR) = CurrDBGadget.Name
                ' find all the appdb gadgets and delete them
                Msg = UCase(App.EXEName) & "-" & CurrDBGadget.Name
                TempRS.Index = "Type"
                TempRS.Seek "=", "AppDBGadget"
                Do While TempRS.NoMatch = False
                    t = ReadGadgetByID(TempRS!ObjectID)
                    If ReadProperty(ReadObjectBuffer, "DB Name") = ThisDBName Then
                        DelOIDSCNTR = DelOIDSCNTR + 1
                        ReDim Preserve DelOIDS(DelOIDSCNTR)
                        DelOIDS(DelOIDSCNTR) = TempRS!ObjectID
                        ReDim Preserve DelNames(DelOIDSCNTR)
                        DelNames(DelOIDSCNTR) = TempRS!Name
                    End If
                    TempRS.MoveNext
                    If TempRS.EOF Then Exit Do
                    If TempRS!Type <> "AppDBGadget" Then Exit Do
                Loop
                ' find all the rs gadgets and delete them
                TempRS.Seek "=", "AppRSGadget"
                CurrDBName = ReadProperty(CurrDBGadget, "DB Name")
                Do While TempRS.NoMatch = False
                    t = ReadGadgetByID(TempRS!ObjectID)
                    Msg = ReadProperty(ReadObjectBuffer, "DB Name")
'                    Msg = ucase(App.EXEName) & "-" & CurrDBGadget.Name
                    
                    If (Msg = ThisDBName) And (ThisDBName <> VGBDatabaseName) Then
                        DelOIDSCNTR = DelOIDSCNTR + 1
                        ReDim Preserve DelOIDS(DelOIDSCNTR)
                        DelOIDS(DelOIDSCNTR) = TempRS!ObjectID
                        ReDim Preserve DelNames(DelOIDSCNTR)
                        DelNames(DelOIDSCNTR) = TempRS!Name
                    End If
                    TempRS.MoveNext
                    If TempRS.EOF Then Exit Do
                    If TempRS!Type <> "AppRSGadget" Then Exit Do
                Loop
            End If
            If Msg = "Add" Then
                DBGadgetsCNTR = DBGadgetsCNTR + 1
                DBGadgetsPTR = DBGadgetsCNTR
                ReDim Preserve DBGadgets(DBGadgetsCNTR)
                t = ReadGadgetByID(ObjectsRS!ObjectID)
                DBGadgets(DBGadgetsPTR) = ReadObjectBuffer
                SetProperty Trace, NextID("trace") & "DBGadgetsLoad Loaded", "DB Name: " & ReadObjectBuffer.Name
            End If
        End If 'msg="Add"
        ObjectsRS.Bookmark = TBookmark
        ObjectsRS.MoveNext
        If ObjectsRS.EOF Then Exit Do
        If ObjectsRS!Type <> "DBGadget" Then Exit Do
    Loop
'    MsgBox "stop"
    If DBGadgetsCNTR = 10 ^ 4 Then
        ' need system set up
        ' rws not here
        t = ReadProperty(DBGadgetDef, "Last DBGadget Name Index")
        t = Val(t) + 1
        Msg = SetProperty(DBGadgetDef, "Last DBGadget Name Index", CStr(t))
        DBGadgetsCNTR = DBGadgetsCNTR + 1
        DBGadgetsPTR = DBGadgetsCNTR
        ReDim Preserve DBGadgets(DBGadgetsCNTR)
        DBGadgets(DBGadgetsCNTR) = BlankObject
        DBGadgets(DBGadgetsCNTR).ObjectID = 0
        DBGadgets(DBGadgetsCNTR).Name = "RWS.RWS-" & t
        DBGadgets(DBGadgetsCNTR).Type = "DBGadget"
        DBGadgets(DBGadgetsCNTR).Container = "AppGadget"
        DBGadgets(DBGadgetsCNTR).GAppName = "GDS"
        DBGadgets(DBGadgetsCNTR).Tag = "DBGadgetsLoad/DBGadgetsCNTR=0: " & CStr(Now())
        t = SetProperty(DBGadgets(DBGadgetsCNTR), "DB Name", "RWS.RWS")
        t = SetProperty(DBGadgets(DBGadgetsCNTR), "System", "RWSSYS.RWS")
        t = SetProperty(DBGadgets(DBGadgetsCNTR), "AutoOpen", "True")
        t = SetProperty(DBGadgets(DBGadgetsCNTR), "Type", "Jet")
        t = SetProperty(DBGadgets(DBGadgetsCNTR), "Version", "2.0")
        t = SetProperty(DBGadgets(DBGadgetsCNTR), "DU", "VBasic")
        t = SetProperty(DBGadgets(DBGadgetsCNTR), "DP", "TLHicky")
'        t = WriteMemGadget(DBGadgets(DBGadgetsCNTR).ObjectID, DBGadgets(DBGadgetsCNTR))
        If FileExists(App.Path & "\RWS.RWS") Then
            t = SetProperty(DBGadgets(DBGadgetsCNTR), "Path", App.Path)
        End If
        t = WriteMemGadget(DBGadgets(DBGadgetsCNTR).ObjectID, DBGadgets(DBGadgetsCNTR))
        t = WriteMemGadget(DBGadgetDef.ObjectID, DBGadgetDef)
        Msg = UCase(App.EXEName) & "-" & DBGadgets(DBGadgetsCNTR).Name
        t = ReadGadgetByName(Msg, CurrentObject)
'        MsgBox t
        If t <> OK Then
            AppDBGadgetsCNTR = AppDBGadgetsCNTR + 1
            ReDim Preserve AppDBGadgets(AppDBGadgetsCNTR)
            AppDBGadgets(AppDBGadgetsCNTR) = BlankObject
            AppDBGadgets(AppDBGadgetsCNTR).Name = Msg
            AppDBGadgets(AppDBGadgetsCNTR).ObjectID = 0
            AppDBGadgets(AppDBGadgetsCNTR).Type = "AppDBGadget"
            AppDBGadgets(AppDBGadgetsCNTR).Container = UCase(App.EXEName)
            AppDBGadgets(AppDBGadgetsCNTR).Tag = "DBGadgetsLoad: " & Msg & " / " & CStr(Now())
            t = SetProperty(AppDBGadgets(AppDBGadgetsCNTR), "DB Name", "RWS.RWS")
            t = SetProperty(AppDBGadgets(AppDBGadgetsCNTR), "DBGadgets ID", CStr(DBGadgets(DBGadgetsCNTR).ObjectID))
            t = SetProperty(AppDBGadgets(AppDBGadgetsCNTR), "Enabled", "True")
            t = SetProperty(AppDBGadgets(AppDBGadgetsCNTR), "Open in this App?", "True")
            t = SetProperty(AppDBGadgets(AppDBGadgetsCNTR), "Show DB to User", "False")
            t = WriteMemGadget(AppDBGadgets(AppDBGadgetsCNTR).ObjectID, AppDBGadgets(AppDBGadgetsCNTR))
        End If
    End If
    ' delete all the dbgasdget objects without valid files
    For Cntr1 = 1 To DelOIDSCNTR
        t = DeleteGadget(DelOIDS(Cntr1))
    Next
    ' load the appdbgadgets
    ObjectsRS.Index = "Type"
    ObjectsRS.Seek "=", "AppDBGadget"
'    Msg = ucase(App.EXEName) & "-" & CurrDBGadget.Name
    If ObjectsRS.NoMatch Then
        ' there are no appdbgadgets, need to create some
        DBGadgetsPTR = 0
        For Cntr1 = 0 To DBGadgetsCNTR
            ' load all appdbgadgets if none are defined
            Msg = UCase(App.EXEName) & "-" & DBGadgets(Cntr1).Name
            AppDBGadgetsCNTR = AppDBGadgetsCNTR + 1
            ReDim Preserve AppDBGadgets(AppDBGadgetsCNTR)
            AppDBGadgets(AppDBGadgetsCNTR) = BlankObject
            AppDBGadgets(AppDBGadgetsCNTR).Name = Msg
            AppDBGadgets(AppDBGadgetsCNTR).ObjectID = 0
            AppDBGadgets(AppDBGadgetsCNTR).Type = "AppGadget"
            AppDBGadgets(AppDBGadgetsCNTR).Container = UCase(App.EXEName)
            AppDBGadgets(AppDBGadgetsCNTR).Tag = "DBGadgetsLoad: No AppdbGadgets" & Now
            t = SetProperty(AppDBGadgets(AppDBGadgetsCNTR), "DB Name", ReadProperty(DBGadgets(Cntr1), "DB Name"))
            t = SetProperty(AppDBGadgets(AppDBGadgetsCNTR), "DBGadgets ID", CStr(DBGadgets(Cntr1).ObjectID))
            
            t = SetProperty(AppDBGadgets(AppDBGadgetsCNTR), "Enabled", "True")
            If Not ExecutingSchedule Then
                FloatMsgBox "Added: " & Msg, "DB Load"
            End If
        Next
    End If
    DBGadgetsPTR = 0
    For Cntr1 = 0 To DBGadgetsCNTR
        ' fix up the appdbgadgets
'        DoEvents
        Msg = UCase(App.EXEName) & "-" & DBGadgets(Cntr1).Name
        t = ReadGadgetByName(Msg, CurrentObject)
        If t <> OK Then
            ' need a disk appdbgadget for this guy
            AppDBGadgetsCNTR = AppDBGadgetsCNTR + 1
            AppDBGadgetsPTR = AppDBGadgetsCNTR
            ReDim Preserve AppDBGadgets(AppDBGadgetsPTR)
            AppDBGadgets(AppDBGadgetsPTR).Name = UCase(App.EXEName) & "-" & DBGadgets(Cntr1).Name
            AppDBGadgets(AppDBGadgetsPTR).ObjectID = 0
            AppDBGadgets(AppDBGadgetsPTR).Type = "AppDBGadget"
            AppDBGadgets(AppDBGadgetsPTR).Container = UCase(App.EXEName)
            AppDBGadgets(AppDBGadgetsPTR).Tag = "DBGadgets Load/Failed to find: " & Msg
            ThisDBName = ReadProperty(DBGadgets(Cntr1), "DB Name")
            t = SetProperty(AppDBGadgets(AppDBGadgetsPTR), "DB Name", ThisDBName)
            t = SetProperty(AppDBGadgets(AppDBGadgetsPTR), "DBGadgets ID", CStr(DBGadgets(Cntr1).ObjectID))
            t = SetProperty(AppDBGadgets(AppDBGadgetsPTR), "Enabled", "True")
            t = WriteMemGadget(AppDBGadgets(AppDBGadgetsPTR).ObjectID, AppDBGadgets(AppDBGadgetsPTR))
'            MsgBox t
        Else
            ' load it if not already
            For CNTR2 = 0 To AppDBGadgetsCNTR
                If AppDBGadgets(CNTR2).Name = UCase(App.EXEName) & "-" & DBGadgets(Cntr1).Name Then
                    Exit For
                End If
            Next
            If CNTR2 > AppDBGadgetsCNTR Then
                AppDBGadgetsCNTR = AppDBGadgetsCNTR + 1
                AppDBGadgetsPTR = AppDBGadgetsCNTR
                CNTR2 = AppDBGadgetsCNTR
                ReDim Preserve AppDBGadgets(AppDBGadgetsPTR)
                AppDBGadgets(AppDBGadgetsPTR) = CurrentObject
            End If
            ' this is a fix for the dbgadgets property
            t = ReadProperty(AppDBGadgets(CNTR2), "DBGadgets ID")
            If t = NotFound And CNTR2 > 0 Then
'                t = SetProperty(AppDBGadgets(Cntr2), "DBGadgets ID", CStr(DBGadgets(Cntr1).ObjectID))
                t = SetProperty(AppDBGadgets(AppDBGadgetsPTR), "DB Name", DBGadgets(Cntr1).Name)
                t = WriteMemGadget(AppDBGadgets(CNTR2).ObjectID, AppDBGadgets(CNTR2))
'                MsgBox t
            End If
            
        End If
    Next Cntr1
    For Cntr1 = 0 To AppDBGadgetsCNTR
'        DoEvents
        ' now load the apprs gadgets
        ' the recordsets for the dbgadgets this app opens
'        Msg = AppDBGadgets(Cntr1).Name
        For CNTR2 = 1 To 3
            Select Case True
                Case CNTR2 = 1
                    Msg = "Objects"
                Case CNTR2 = 2
                    Msg = "Props"
                Case CNTR2 = 3
                    Msg = "Methods"
            End Select
            AppRSName = AppDBGadgets(Cntr1).Name & "-" & Msg
            For Cntr3 = 0 To AppRSGadgetsCNTR
                If AppRSGadgets(Cntr3).Name = AppRSName Then
                    Exit For
                End If
            Next
            If Cntr3 > AppRSGadgetsCNTR Then
    '           Msg = ucase(App.EXEName) & "-" & CurrDBName & "-" & Msg
                AppRSGadgetsCNTR = AppRSGadgetsCNTR + 1
                AppRSGadgetsPTR = AppRSGadgetsCNTR
                ReDim Preserve AppRSGadgets(AppRSGadgetsCNTR)
                AppRSGadgets(AppRSGadgetsCNTR) = BlankObject
                AppRSGadgets(AppRSGadgetsCNTR).ObjectID = 0
                AppRSGadgets(AppRSGadgetsCNTR).Name = AppRSName
                AppRSGadgets(AppRSGadgetsCNTR).Type = "AppRSGadget"
                AppRSGadgets(AppRSGadgetsCNTR).Container = UCase(App.EXEName)
                AppRSGadgets(AppRSGadgetsCNTR).Tag = Now
                t = SetProperty(AppRSGadgets(AppRSGadgetsCNTR), "DB Name", ReadProperty(AppDBGadgets(Cntr1), "DB Name"))
                t = SetProperty(AppRSGadgets(AppRSGadgetsCNTR), "RS Source", Msg)
                t = SetProperty(AppRSGadgets(AppRSGadgetsCNTR), "RS Name", Msg & "RS")
                t = ReadProperty(AppRSGadgets(AppRSGadgetsCNTR), "RS Index")
                t = SetProperty(AppRSGadgets(AppRSGadgetsCNTR), "RS Index", "?")
    '            ShowObject Dematerialize(AppRSGadgets(AppRSGadgetsCNTR)), "mem"
                ' let's see if this one exists, shouldn't
                ReadObjectBuffer = BlankObject
                t = ReadGadgetByName(AppRSGadgets(AppRSGadgetsCNTR).Name, ReadObjectBuffer)
                If t = OK Then
                    AppRSGadgets(AppRSGadgetsCNTR).ObjectID = ReadObjectBuffer.ObjectID
                End If
                t = WriteMemGadget(AppRSGadgets(AppRSGadgetsCNTR).ObjectID, AppRSGadgets(AppRSGadgetsCNTR))
            End If
        Next CNTR2
    Next Cntr1
    ' load the appdbgadgets
    ObjectsRS.Index = "Type"
    ObjectsRS.Seek "=", "AppDBGadget"
    Msg = UCase(App.EXEName) & "-" & CurrDBGadget.Name
    Do While ObjectsRS.NoMatch = False
        If ObjectsRS!Container = UCase(App.EXEName) Then
            Msg = "Add"
            For Cntr1 = 0 To AppDBGadgetsCNTR
                If AppDBGadgets(Cntr1).Name = ObjectsRS!Name Then
                    Msg = "No"
                    Exit For
                End If
            Next
            If Msg = "Add" Then
                AppDBGadgetsCNTR = AppDBGadgetsCNTR + 1
                ReDim Preserve AppDBGadgets(AppDBGadgetsCNTR)
                t = ReadGadgetByID(ObjectsRS!ObjectID)
                AppDBGadgets(AppDBGadgetsCNTR) = ReadObjectBuffer
            End If
        End If
        ObjectsRS.MoveNext
        If ObjectsRS.EOF Then Exit Do
        If ObjectsRS!Type <> "AppDBGadget" Then Exit Do
    Loop
    ObjectsRS.Index = "Type"
    ObjectsRS.Seek "=", "AppRSGadget"
    Do While ObjectsRS.NoMatch = False
        If ObjectsRS!Container = UCase(App.EXEName) Then
            Msg = "Load AppRS"
            t = ReadGadgetByID(ObjectsRS!ObjectID)
            CurrAppRSGadget = ReadObjectBuffer
            For Cntr1 = 0 To AppRSGadgetsCNTR
                If UCase(AppRSGadgets(Cntr1).Name) = UCase(ObjectsRS!Name) Then
                    Msg = "No Load"
                    Exit For
                End If
            Next Cntr1
            If Msg = "Load AppRS" Then
                ' get name from apprsgadgets
'                t = ReadGadgetByName(ObjectsRS!Name, CurrentObject)
                AppRSGadgetsCNTR = AppRSGadgetsCNTR + 1
                ReDim Preserve AppRSGadgets(AppRSGadgetsCNTR)
                AppRSGadgets(AppRSGadgetsCNTR) = ReadObjectBuffer
                t = SetProperty(AppRSGadgets(AppRSGadgetsCNTR), "RS Index", "?")
            End If
        End If
'        DoEvents
        ObjectsRS.MoveNext
        If ObjectsRS.EOF Then Exit Do
        If ObjectsRS!Type <> "AppRSGadget" Then Exit Do
    Loop
    GoTo EndSub
LocalError:
    LocalError = Error
'    MsgBox "DB Load Error: " & Error, , UCase(App.EXEName) & " Debug Message"
    SetProperty Trace, NextID("trace") & "Trapped DBGadgetsLoad Error", Param.Name & " / " & LocalError
    SetProperty VGBErrors, NextID("error") & "Trapped DBGadgetsLoad Error", Param.Name & " / " & LocalError
    Resume Next
EndSub:
    If StartDBPTR > 0 Then
        DBSwitch StartDBPTR
    Else
        DBGadgetsPTR = StartDBPTR
    End If
    SetProperty Trace, NextID("trace") & "DBGadgetsLoaded", CStr(DBGadgetsCNTR)
    SetProperty Trace, NextID("trace") & "DBGadgetsLoad Time", CStr(Timer - starttime)
'    MsgBox Timer - starttime
End Function
'Public Function OpenDB(Param As Gadget)

Friend Function DBEnable(Param As Gadget)
    ' this enables a db for a given app
    Dim t, Msg As String, Cntr1 As Integer
    Dim RREsults As Gadget, MResults As Gadget
    Dim ThisDBName As String
    ThisDBName = UCase(ReadProperty(Param, "DB Name"))
    For Cntr1 = 0 To AppDBGadgetsCNTR
        Msg = ReadProperty(AppDBGadgets(Cntr1), "DB Name")
        If Msg = ThisDBName Then
            t = SetProperty(AppDBGadgets(Cntr1), "Enabled", "True")
            MResults = Memorize(AppDBGadgets(Cntr1), "in " & VGBDatabaseNameAndPath)
            't = WriteGDSGadget(AppDBGadgets(Cntr1).ObjectID, AppDBGadgets(Cntr1))
            Exit For
        End If
    Next
EndSub:
End Function
Friend Function DBDisable(Param As Gadget)
    Dim t, Msg As String, Cntr1 As Integer
    Dim RREsults As Gadget, MResults As Gadget
    Dim ThisDBName As String
    ThisDBName = UCase(ReadProperty(Param, "DB Name"))
    If ThisDBName = "RWS.RWS" Then
        If Not ExecutingSchedule Then
            MsgBox "You can't Disable the System Database", vbExclamation, "System Database Selected"
        End If
        GoTo EndSub
    End If
    For Cntr1 = 0 To AppDBGadgetsCNTR
        Msg = ReadProperty(AppDBGadgets(Cntr1), "DB Name")
        If Msg = ThisDBName Then
            t = SetProperty(AppDBGadgets(Cntr1), "Enabled", "False")
            MResults = Memorize(AppDBGadgets(Cntr1), "in " & VGBDatabaseNameAndPath)
            't = WriteGDSGadget(AppDBGadgets(Cntr1).ObjectID, AppDBGadgets(Cntr1))
            Exit For
        End If
    Next
    If Cntr1 > AppDBGadgetsCNTR Then
        ' this appdbgadget not registered yet
        t = ReadGDSGadget(Msg, CurrentObject)
        If t <> OK Then
            If Not ExecutingSchedule Then
                MsgBox "Adding Application Database: " & ThisDBName
            End If
        End If
    End If
EndSub:
    On Error GoTo 0
End Function

Friend Function DBSwitch(DBGadgetPTRToUse As Integer) As String
    ' sets current database to the one pointed to by DBGadgetPTRToUse
    ' all subsequent object i/o is to the one last set
    ' if the passed pointer is not valid, add the current application's appdbgadget
    Dim starttime As Single, stoptime As Single
    starttime = Timer
    
    Dim RREsults As Gadget, MResults As Gadget
    Dim t, Msg As String, Msg2 As String
    Dim Cntr1 As Integer, CNTR2 As Integer
    Dim ObjectRSFound As Boolean
    Dim PropRSFound As Boolean
    Dim MethodRSFound As Boolean
    Dim TotDbs As Integer
    Dim ThisDBPath As String, ThisDBName As String, ThisDBPathAndName As String
    Dim AppDBGadgetName As String
    Dim LocalError As String
    Dim Result As String
    Dim FloatMsg As String
    Result = OK
    LocalError = ""
    On Error GoTo LocalError
    SetProperty Trace, NextID("trace") & "DBSwitch Start *********************************", "***"
    If DBGadgetPTRToUse = DBGadgetsPTR Then
        SetProperty Trace, NextID("trace") & "DB Switch", "Already on " & DBGadgets(DBGadgetPTRToUse).Name
        Result = OK
        GoTo EndSub
    End If
    SetProperty Trace, NextID("trace") & "DB Switch", "To: " & DBGadgets(DBGadgetPTRToUse).Name
    If DBGadgetsPTR = DBGadgetPTRToUse Then
        ' no need to waste any time doing something that's already done
        GoTo EndSub
    End If
    ' is the cntr valid?
    If DBGadgetPTRToUse > DBGadgetsCNTR Then
        ' error!
        SetProperty Trace, NextID("trace"), "[" & "DB Pointer wrong" & " DBPTR: " & CStr(DBGadgetsPTR) & "DB To Use: " & CStr(DBGadgetPTRToUse) & "] "
        FloatMsg = FloatMsg & " [" & "DB Pointer wrong" & " DBPTR: " & CStr(DBGadgetsPTR) & "DB To Use: " & CStr(DBGadgetPTRToUse) & "] "
        Result = "Error"
        GoTo EndSub
    End If
    ObjectRSFound = False
    PropRSFound = False
    MethodRSFound = False
    ' check to see if this database actually exists.
    ' if not, we re-initialize to unregister it
    ThisDBName = UCase(ReadProperty(DBGadgets(DBGadgetPTRToUse), "DB Name"))
    ThisDBPath = UCase(AddBackSlash(ReadProperty(DBGadgets(DBGadgetPTRToUse), "Path")))
    ThisDBPathAndName = ThisDBPath & ThisDBName
    AppDBGadgetName = UCase(App.EXEName) & "-" & DBGadgets(DBGadgetPTRToUse).Name
    If Not FileExists(ThisDBPathAndName) Then
        Result = "File Not Found: " & ThisDBPathAndName
        SetProperty Trace, NextID("trace") & "DBSwitch Error ", "File not found: " & ThisDBPathAndName
        If GDSMsg.CommandClose.Visible = False Then
            GDSMsg.Caption = ThisDBPathAndName & " Database Not Found"
            GDSMsg.CommandClose.Visible = False
            GDSMsg.Show
            GDSMsg.WindowState = NORMAL
            GDSMsg.MsgText.Visible = True
            GDSMsg.MsgText = ""
            GDSMsg.MsgText = GDSMsg.MsgText & "Please wait while I delete the Database and Reinitialize the System.  This will take a few seconds" & CrLf
            GDSMsg.MsgText = GDSMsg.MsgText & ""
        End If
'        InitVGB
        Unload GDSMsg
        GoTo EndSub
    End If
    ' here we know the db exists
    ' let's see if this appdbgadget exists
    ' dbgadget name is filename-index# like VGBDatabaseName-0
    ' the appdbgadget's name is: appname-dbgadget name
    ' like Virtual Cortex-VGBDatabaseName-0
'    Msg = UCase(App.EXEName) & "-" & ThisDBName
    ' this is the name of the appdbgadget we need
    Msg = UCase(App.EXEName) & "-" & DBGadgets(DBGadgetPTRToUse).Name
    For Cntr1 = 0 To AppDBGadgetsCNTR
        If AppDBGadgets(Cntr1).Name = AppDBGadgetName Then
            t = ReadProperty(AppDBGadgets(Cntr1), "Enabled")
            If t = NotFound Then
                If Not ExecutingSchedule Then
                     FloatMsg = FloatMsg & " [" & " Adding: " & ThisDBName & "] "
'                    MsgBox "Adding: " & ThisDBName
                End If
                t = SetProperty(AppDBGadgets(Cntr1), "Enabled", "True")
                t = SetProperty(AppDBGadgets(Cntr1), "Open in this App?", "True")
                MResults = Memorize(AppDBGadgets(Cntr1), "in " & VGBDatabaseNameAndPath)
                't = WriteGDSGadget(AppDBGadgets(Cntr1).ObjectID, AppDBGadgets(Cntr1))
            End If
            If ReadProperty(AppDBGadgets(Cntr1), "Enabled") = "False" Then
                Result = "Disabled"
                GoTo EndSub
            End If
            Exit For
        End If
    Next
    ' was this appdb found?
    If Cntr1 > AppDBGadgetsCNTR Then
        ' no, add the appdbgadget
'        Msg = UCase(App.EXEName) & "-" & DBGadgets(DBGadgetPTRToUse).Name
        If (ThisDBName <> VGBDatabaseName) Then
            AppDBGadgetsCNTR = AppDBGadgetsCNTR + 1
            ReDim Preserve AppDBGadgets(AppDBGadgetsCNTR)
            AppDBGadgets(AppDBGadgetsCNTR) = BlankObject
            AppDBGadgets(AppDBGadgetsCNTR).Name = AppDBGadgetName
            AppDBGadgets(AppDBGadgetsCNTR).Type = "AppDBGadget"
            AppDBGadgets(AppDBGadgetsCNTR).Container = UCase(App.EXEName)
            AppDBGadgets(AppDBGadgetsCNTR).Tag = "DBSwitch/Cntr1 > AppDBGadgetsCNTR: " & ThisDBName & Now()
            SetProperty AppDBGadgets(AppDBGadgetsCNTR), "DB Name", ThisDBName
            SetProperty AppDBGadgets(AppDBGadgetsCNTR), "DBGadgets ID", CStr(DBGadgets(DBGadgetPTRToUse).ObjectID)
            SetProperty AppDBGadgets(AppDBGadgetsCNTR), "Enabled", "True"
            MResults = Memorize(AppDBGadgets(AppDBGadgetsCNTR), "in " & VGBDatabaseNameAndPath)
            't = WriteGDSGadget(AppDBGadgets(AppDBGadgetsCNTR).ObjectID, AppDBGadgets(AppDBGadgetsCNTR))
        End If
    End If
    ' this makes the switch to db the current one
    DBGadgetsPTR = DBGadgetPTRToUse
'    ThisDBName = DBGadgets(DBGadgetPTRToUse).Name
    ' we need to select the correct recordsets for this database
    For Cntr1 = 0 To AppRSGadgetsCNTR
        If DBGadgetsPTR <> DBGadgetPTRToUse Then
             FloatMsg = FloatMsg & " [" & "DB Pointer wrong" & " DBPTR: " & CStr(DBGadgetsPTR) & "DB To Use: " & CStr(DBGadgetPTRToUse) & "] "
'            MsgBox "DB Pointer wrong"
        End If
        If AppRSGadgets(Cntr1).Name = AppDBGadgetName & "-Objects" Then
            CNTR2 = Val(ReadProperty(AppRSGadgets(Cntr1), "RS Index"))
            Set ObjectsRS = OpenRS(CNTR2)
            ObjectRSFound = True
        End If
        If AppRSGadgets(Cntr1).Name = AppDBGadgetName & "-Props" Then
            CNTR2 = Val(ReadProperty(AppRSGadgets(Cntr1), "RS Index"))
            Set PropsRS = OpenRS(CNTR2)
            PropRSFound = True
        End If
        If AppRSGadgets(Cntr1).Name = AppDBGadgetName & "-Methods" Then
            CNTR2 = Val(ReadProperty(AppRSGadgets(Cntr1), "RS Index"))
            Set MethodsRS = OpenRS(CNTR2)
            MethodRSFound = True
        End If
    Next Cntr1
    If ObjectRSFound = False Or PropRSFound = False Or MethodRSFound = False Then
         FloatMsg = FloatMsg & " [" & "DB Switch failed ObjectsRSFound: " & "ObjectsRSFound: " & CStr(ObjectRSFound) & " PropsRSFound: " & CStr(PropRSFound) & " MethodsRSFound: " & CStr(MethodRSFound) & "] "
'        MsgBox "DB Switch failed"
    End If
    If DBGadgetsPTR = 0 Then
        ' must be gdsregister
        Set JetDatabase = OpenDB(0)
        JetDatabaseName = OpenDB(0).Name
        Set ObjectsRS = OpenRS(0)
        Set PropsRS = OpenRS(1)
        Set MethodsRS = OpenRS(2)
        DBGadgetsPTR = 0
        OpenDBPTR = 0
        Result = OK
        GoTo EndSub
    End If
    ' switch the master recordsets to the given dbgadget
    ' this is the opendb() array
    For OpenDBPTR = 1 To OpenDBCNTR
        Msg2 = "Don't Skip"
        For Cntr1 = 1 To AppDBGadgetsCNTR
            If UCase(ReadProperty(AppDBGadgets(Cntr1), "DB Name")) = _
                     UCase(ReadProperty(DBGadgets(OpenDBPTR), "DB Name")) Then
                    If ReadProperty(AppDBGadgets(Cntr1), "Open in this App?") = "False" Then
                        Msg2 = "Skip"
                        Exit For
                    End If
            End If
        Next
        LocalError = ""
        If Msg2 <> "Skip" Then
            If UCase(OpenDB(OpenDBPTR).Name) = ThisDBPathAndName Then
                If LocalError = "" Then
                    Result = OK
                    Exit For
                End If
            End If
        Else
            If Cntr1 = DBGadgetPTRToUse Then
                ' this db is closed
                Result = "DB Not Open"
                Exit For
            End If
        End If
    Next OpenDBPTR
    If OpenDBPTR > OpenDBCNTR And LocalError <> "Object variable or With block variable not set" Then
        FloatMsg = FloatMsg & " [" & "DB Pointer > DB Counter" & " DBPTR: " & CStr(OpenDBPTR) & " Open DBCNTR: " & CStr(OpenDBCNTR) & " Error was " & LocalError & "] "
'        MsgBox "DB Pointer greater than Counter", , UCase(App.EXEName) & " Debug Message"
        Result = "Switch Error " & " [" & "DB Pointer > DB Counter" & " DBPTR: " & CStr(OpenDBPTR) & " Open DBCNTR: " & CStr(OpenDBCNTR) & " Error was [" & LocalError & "] "
        GoTo EndSub
    End If
    If LocalError = "Object variable or With block variable not set" Then
        Result = "Database Not Open"
    End If
    If Result = OK Then
        Set JetDatabase = OpenDB(OpenDBPTR)
        JetDatabaseName = OpenDB(OpenDBPTR).Name
    End If
GoTo EndSub
LocalError:
    LocalError = Error
    SetProperty Trace, NextID("trace") & "DBSwitch Trapped Error ", "PTR=" & DBGadgetPTRToUse & "/Error=" & LocalError
    SetProperty VGBErrors, NextID("error") & "DBSwitch Trapped Error ", "PTR=" & DBGadgetPTRToUse & "/Error=" & LocalError
    If Not (ExecutingSchedule And (LocalError <> "Object variable or With block variable not set")) Then
        If LocalError <> "Object is invalid or not Set." Then
            FloatMsg = FloatMsg & " [" & "Trapped DBSwitch Error: " & CStr(Error) & "] "
'            MsgBox "Error: " & Error, , "DBSwitch Error"
        End If
    End If
    Resume Next
EndSub:
    GDSFreelocks
    If FloatMsg <> "" Then
'        FloatMsgBox FloatMsg, "DBSwitch Errors Encountered: Debug Message"
    End If
    SetProperty Trace, NextID("trace") & "DBSwitch End *********************************", "***"
    On Error GoTo 0
    DBSwitch = Result
'    stoptime = Timer
'    MsgBox stoptime - starttime
End Function
Friend Function APPFindIndex(Param As Gadget) As Integer
    ' this returns the index of the APPgadgets with the APPname passed
    ' use the return value to set APP with APPswitch function
    Dim t, Msg As String, Msg2 As String, Cntr1 As Integer
    Dim TGadget As Gadget
    Dim APPPathToUse As String, APPNameToUse As String
    Dim Result As Integer
    APPPathToUse = AddBackSlash(ReadProperty(Param, "AppPath"))
    APPNameToUse = UCase(Param.Name)
    Result = 0 ' zero is a nofind
    For Cntr1 = 1 To AppGadgetsCNTR
        ' get app name
        Msg = UCase(AppGadgets(Cntr1).Name) 'UCase(ReadProperty(AppGadgets(Cntr1), "APPName"))
        If Msg = APPNameToUse Then
            ' this is the name, how about path?
            If APPPathToUse = NotFound Then
                ' they didn't say, so this is it
                Result = Cntr1
                Exit For
            End If
            ' path is provided
            Msg2 = UCase(ReadProperty(AppGadgets(Cntr1), "AppPath"))
            
        End If
'        Msg = AddBackSlash(Msg)
        Msg2 = UCase(ReadProperty(AppGadgets(Cntr1), "AppPath"))
        Msg2 = AddBackSlash(Msg2)
        Msg = Msg2 & Msg
        If Msg = APPPathToUse & APPNameToUse Then
            Result = Cntr1
            Exit For
        End If
    Next
    If Cntr1 > AppGadgetsCNTR Then
        ' this app was not found in memory
        ' load from disk?
        If ReadProperty(Param, "Load From Disk") = "True" Then
            t = ReadGadgetByName(Param.Name, TGadget)
            If t = OK Then
                AppGadgetsCNTR = AppGadgetsCNTR + 1
                ReDim Preserve AppGadgets(AppGadgetsCNTR)
                AppGadgets(AppGadgetsCNTR) = TGadget
                Result = AppGadgetsCNTR
            End If
        End If
    End If
    APPFindIndex = Result
End Function

Friend Function DBFindIndex(DBNameToUse As String) As Integer
    ' this returns the index of the dbgadgets with the dbname passed
    ' use the return value to set db with dbswitch function
    Dim t, Msg As String, Msg2 As String, Cntr1 As Integer
    Dim Result As Integer
    DBNameToUse = UCase(DBNameToUse)
    Result = -1 ' < zero is a nofind
    SetProperty Trace, NextID("trace") & "DBFindindex", DBNameToUse & " Total DBs: " & CStr(DBGadgetsCNTR)
    
    For Cntr1 = 0 To DBGadgetsCNTR
        Msg = UCase(ReadProperty(DBGadgets(Cntr1), "DB Name"))
        SetProperty Trace, NextID("trace") & "DBFindindex", "Checking Name: " & Msg
        If Msg = DBNameToUse Then
            SetProperty Trace, NextID("trace") & "DBFindindex", "Found (no path): " & DBNameToUse
            Result = Cntr1
            Exit For
        End If
'        Msg = AddBackSlash(Msg)
        Msg2 = UCase(ReadProperty(DBGadgets(Cntr1), "Path"))
        Msg2 = AddBackSlash(Msg2)
        Msg = Msg2 & Msg
        SetProperty Trace, NextID("trace") & "DBFindindex", "Checking Path: " & Msg
        If Msg = DBNameToUse Then
            SetProperty Trace, NextID("trace") & "DBFindindex", "Found (with path): " & DBNameToUse
            Result = Cntr1
            Exit For
        End If
    Next
    DBFindIndex = Result
End Function

'Friend Function GDSFirst()
'    Dim t
'    RunningApplication.Name = UCase(App.EXEName) & "/" & CStr(App.hInstance)
'    Randomize
'    RunningApplication.ID = Rnd()
'    RunningApplication.Name = UCase(App.EXEName) & "/" & CStr(RunningApplication.ID)
'End Function




'//////////////////
Friend Function WasteTime(SecondsToWaste As Single) As Integer
    ' waste a give amount of time
    Dim timerholder As Single, t
    Dim StartingTime As Single
    Dim SecsInDay As Double
    StartingTime = Timer
    ' see if we're on the cusp of timer rollover
    ' Total seconds in a day=(24 hrs * 60 min/hr * 60 secs/min)
    SecsInDay = 86400
    If (StartingTime + SecondsToWaste) > SecsInDay Then
        ' Timer will roll over before we are done, causing a loop that lasts 24 hrs.
        ' need to do some figuring here
        t = 0
        Do While Timer <= SecsInDay And t <= 10000
            If SecondsToWaste > 2 Then
'                DoEvents
            End If
            t = t + 1
        Loop
    Else
        timerholder = Timer + SecondsToWaste
        t = 0
        Do While Timer <= timerholder 'And t <= 100000
            If SecondsToWaste > 2 Then
'                DoEvents
            End If
            t = t + 1
        Loop
    End If
End Function


Friend Function ExtractPathAndFile(Param As Gadget) As Gadget
    ' this returns a gadget with properties
    '   "Drive Only"
    '   "Path Only"
    '   "File Only"
    '   "File Name Without Extension"
    '   "Extension Only"
    ' plus any properties sent in original parameter gadget
    '
    '
    '
    Dim t, Msg As String, Cntr1 As Integer, CNTR2 As Integer, TotLen As Integer
    Dim TotToRemove As Integer
    Dim TempChar As String
    Dim PathAndFile As String
    Dim PathOnly As String
    Dim FileOnly As String
    Dim DriveOnly As String
    Dim FileWithoutExt As String
    Dim ExtOnly As String
    Dim PathDone As Boolean, FileDone As Boolean
    PathAndFile = ReadProperty(Param, "PathFile")
    TotLen = Len(PathAndFile)
    ' get file
    PathDone = False
    FileDone = False
    For Cntr1 = TotLen To 0 Step -1
        TempChar = Mid(PathAndFile, Cntr1, 1)
        Select Case True
            Case TempChar = "\" And Not FileDone
'                TotToRemove = TotToRemove + 1
                FileDone = True
                Exit For
            Case TempChar <> "\" And Not FileDone
                FileOnly = FileOnly & TempChar
                TotToRemove = TotToRemove + 1
        End Select
    Next Cntr1
    TempChar = ""
    ' turn it around, it's backwards
    For Cntr1 = Len(FileOnly) To 1 Step -1
        TempChar = TempChar & Mid(FileOnly, Cntr1, 1)
    Next
    FileOnly = TempChar
    TotLen = TotLen - TotToRemove
    For Cntr1 = 1 To TotLen
        PathOnly = PathOnly & Mid(PathAndFile, Cntr1, 1)
    Next Cntr1
    If Right(PathOnly, 1) <> "\" Then
       PathOnly = PathOnly & "\"
    End If
    If Mid(PathOnly, 2, 1) = ":" Then
        DriveOnly = Left(PathOnly, 2)
    Else
        DriveOnly = "None Provided"
    End If
    ' do the filename without extension
    FileWithoutExt = ""
    TotLen = Len(FileOnly)
    For Cntr1 = 1 To TotLen
        TempChar = Mid(FileOnly, Cntr1, 1)
        If TempChar = "." Then
            Exit For
        End If
        FileWithoutExt = FileWithoutExt & TempChar
    Next Cntr1
    ' do the extension only
    ExtOnly = ""
    TotLen = Len(FileOnly)
    For Cntr1 = 1 To TotLen
        TempChar = Mid(FileOnly, Cntr1, 1)
        If TempChar = "." Then
            For CNTR2 = Cntr1 To TotLen
                TempChar = Mid(FileOnly, CNTR2, 1)
                ExtOnly = ExtOnly & TempChar
            Next
            Exit For
        End If
    Next Cntr1
    ' set the properties and ship it back
    t = SetProperty(Param, "Drive Only", DriveOnly)
    t = SetProperty(Param, "Path Only", PathOnly)
    t = SetProperty(Param, "File Only", FileOnly)
    t = SetProperty(Param, "File Name Without Extension", FileWithoutExt)
    t = SetProperty(Param, "Extension Only", ExtOnly)
    
    ExtractPathAndFile = Param
End Function

Friend Function AddBackSlash(Param As String) As String
    ' add backslash to passed param if ain't one already
    If Right(Param, 1) <> "\" Then
        Param = Param & "\"
    End If
    AddBackSlash = Param
End Function

Friend Sub ShowGadget(Param As Gadget)
    ' a perfect example of how this stuff is supposed to work
    Dim t, Msg As String, Cntr As Integer, Cntr1 As Integer
    ShowGadgetForm.Show
    ShowGadgetForm.WindowState = NORMAL
    ShowGadgetForm.Caption = UCase(UCase(App.EXEName)) & " Show Gadget: " & Param.Name
'    DoEvents
    ShowGadgetForm.GadgetOID = Param.ObjectID
    If Param.ObjectID = 0 Then
        ShowGadgetForm.GadgetSource = "Memory"
    Else
        ShowGadgetForm.GadgetSource = "Disk"
    End If
    ShowGadgetForm.GadgetTag = Param.Tag
    ShowGadgetForm.GadgetName = Param.Name
    ShowGadgetForm.GadgetType = Param.Type
    ShowGadgetForm.GadgetContainer = Param.Container
    ShowGadgetForm.ListOfGadgetProperties.Clear
    ShowGadgetForm.Graphic = LoadPicture
    ' convert to load properties
    ' use Public Sub LoadProps(LObj As Gadget, ListToUse As Control)
    For Cntr1 = 1 To Param.TotalProperties
        Msg = Param.Propity(Cntr1) & ": " & Param.ValueAlpha(Cntr1)
        ShowGadgetForm.ListOfGadgetProperties.AddItem Msg
        If Param.Propity(Cntr1) = "Picture File" Then
            If FileExists(Param.ValueAlpha(Cntr1)) Then
                ShowGadgetForm.Graphic = LoadPicture(Param.ValueAlpha(Cntr1))
            End If
        End If
        
'        Msg = ""
    Next Cntr1
    ShowGadgetForm.LabelGadgetsProps = "Gadget Properties: (" & CStr(Param.TotalProperties) & ")"
    ShowGadgetForm.SetFocus
    ShowGadgetForm.GadgetUp = True
    Do While ShowGadgetForm.GadgetUp = True
        DoEvents
    Loop
    
End Sub


Friend Function FloatMsgBox(DMsg As String, DTitle As String, Optional ClearFirst As Boolean = False)
    If DMsg = "" Then
        GDSMsg.Text1 = ""
    End If
    If ClearFirst Then
        GDSMsg.Text1 = ""
    End If
    GDSMsg.Caption = DTitle
    GDSMsg.CommandClose.Visible = True
    GDSMsg.WindowState = NORMAL
    GDSMsg.Text1.Visible = True
    GDSMsg.Text1 = GDSMsg.Text1 & DMsg
'    GDSMsg.Show
End Function


Friend Function WriteErrorLog()

End Function
Friend Function FileExists(Checkfile) As Boolean
    ' CheckFile is the complete path with filename of the file to check
    Dim HadError As Boolean
    Dim ThisHandle As Integer
    ThisHandle = FreeFile
    On Error GoTo FEError
    Open Checkfile For Input As #ThisHandle
    If HadError Then
        Close #ThisHandle
        On Error GoTo 0
        FileExists = False
        Exit Function
    Else
        Close #ThisHandle
        On Error GoTo 0
        FileExists = True
        Exit Function
    End If
FEError:
    FileError = UCase(Error$)
    HadError = (FileError = UCase("File Not Found")) Or (FileError = UCase("Path Not FOUND"))

    Resume Next
End Function
Friend Function DriveExists(DriveToCheck As String) As Boolean
    ' drive to check is the drive to check, well huh
    Dim HadError As Boolean
    Dim StartDrive As String, StartDir As String
    StartDir = CurDir
    StartDrive = Left(StartDir, 2)
    On Error GoTo DEError
    ChDir DriveToCheck
    If HadError Then
        Close #1
        On Error GoTo 0
        ChDrive StartDrive
        ChDir StartDir
        DriveExists = False
        Exit Function
    Else
        Close #1
        On Error GoTo 0
        ChDrive StartDrive
        ChDir StartDir
        DriveExists = True
        Exit Function
    End If
DEError:
    HadError = True
    Resume Next
End Function

Friend Function AllTrim(TVar As String) As String
    ' trim all spaces from a string variable
    AllTrim = RTrim(LTrim(TVar))
End Function

Friend Function GetWindowsDir() As String
    ' yank the windows directory from the win.ini file
    Dim Temp As String, X As Long
    Temp$ = String$(145, 0)              ' Size Buffer
    X = GetWindowsDirectory(Temp$, 145)  ' Make API Call
    Temp$ = Left$(Temp$, X)              ' Trim Buffer

    If Right$(Temp$, 1) <> "\" Then      ' Add \ if necessary
        Temp$ = Temp$ + "\"
    End If
    WindowsDir = Temp$
    GetWindowsDir$ = Temp$
End Function
Friend Function DetectOS() As String
   Dim MsgEnd As String
   Dim OSName As String, OSVer As String, OSBld As String
   Load OSDetectAndStatus
   OSDetectAndStatus.Hide
   IsAwake = True
   Select Case OSDetectAndStatus.SysInfo1.OSPlatform
      Case 0
         MsgEnd = "Unidentified"
      Case 1
        OSName = "Windows 95"
        OSVer = CStr(OSDetectAndStatus.SysInfo1.OSVersion)
        OSBld = CStr(OSDetectAndStatus.SysInfo1.OSBuild)
        OSGadget.Name = OSName
        OSGadget.Type = "Operating System Definition"
        OSGadget.Container = "System"
        SetProperty OSGadget, "Name", OSName
        SetProperty OSGadget, "Version", OSVer
        SetProperty OSGadget, "Build", OSBld
        MsgEnd = "Windows 95, ver. " & _
                    CStr(OSDetectAndStatus.SysInfo1.OSVersion) & "(" & _
                    CStr(OSDetectAndStatus.SysInfo1.OSBuild) & ")"
      Case 2
        OSName = "Windows NT"
        OSVer = CStr(OSDetectAndStatus.SysInfo1.OSVersion)
        OSBld = CStr(OSDetectAndStatus.SysInfo1.OSBuild)
        OSGadget.Name = OSName
        OSGadget.Type = "Operating System Definition"
        OSGadget.Container = "System"
        SetProperty OSGadget, "Name", OSName
        SetProperty OSGadget, "Version", OSVer
        SetProperty OSGadget, "Build", OSBld
      
         MsgEnd = "Windows NT, ver. " & _
                    CStr(OSDetectAndStatus.SysInfo1.OSVersion) & "(" & _
                    CStr(OSDetectAndStatus.SysInfo1.OSBuild) & ")"
   End Select
   If Not StayAwake Then
        Unload OSDetectAndStatus
    End If
   DetectOS = MsgEnd
'   MsgBox "System: " & MsgEnd
End Function



Friend Function GDSAppActive(Param As Gadget)
    Dim starttime As Single, stoptime As Single
    starttime = Timer
    Dim t, Msg As String, Cntr1 As Integer
    Dim AppToCheck As String
    Dim Result As Boolean
    
'    Dim mCount As Integer, tCount As Integer, hModule As Integer
    Dim lpFileName As String
'    mCount = 0
    AppToCheck = UCase(ReadProperty(Param, "Application"))
    'Determine if Application is running
    Result = False
    #If Win16 Then
        Dim mCount As Integer, tCount As Integer, hModule As Integer
        hModule = GetModuleHandle(AppToCheck)
        mCount = GetModuleUsage(hModule%)
        Result = mCount > 0
    #Else
        Dim hSnapShot As Long
        Dim uProcess As PROCESSENTRY32
        Dim TotProcesses As Long
        Dim r As Long
        hSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
        If hSnapShot = 0 Then
            GoTo EndSub
        End If
        uProcess.dwSize = Len(uProcess)
        r = ProcessFirst(hSnapShot, uProcess)
        Do While r
            If InStr(UCase(uProcess.szExeFile), AppToCheck) > 0 Then
                Result = True
'                Exit Do
            End If
            TotProcesses = TotProcesses + 1
            r = ProcessNext(hSnapShot, uProcess)
        Loop
        Call CloseHandle(hSnapShot)
        
        GoTo EndSub
    #End If

EndSub:
    stoptime = Timer
 
    Msg = ""
    Msg = Msg & "App: " & AppToCheck & CrLf
    Msg = Msg & "Running: " & CStr(Result) & CrLf
    Msg = Msg & "Total Processes: " & CStr(TotProcesses) & CrLf
    Msg = Msg & "" & CrLf
    Msg = Msg & "Time: " & CStr(stoptime - starttime) & CrLf
    Msg = Msg & "" & CrLf
    Msg = Msg & "Continue?" & CrLf
'    t = MsgBox(Msg, vbExclamation + vbYesNo, "Debug Message")
'    If t = vbNo Then
'        End
'    End If
'    GDSAppActive = True
   GDSAppActive = Result
End Function

Friend Sub UnloadMe()
    Unloading = True
    Unload Screen.ActiveForm
End Sub

Friend Function SendStatus() As Gadget
    Dim t, Msg As String, ErrCntr As Integer
    Dim Result As Gadget
    Dim LocalError As String
    On Error GoTo LocalError
    Result = DBGadgets(DBGadgetsPTR)
    Result.Name = App.EXEName & " Status"
    Result.Type = "Result"
    SetProperty Result, "Tot Open DB", CStr(DBGadgetsCNTR)
    SetProperty Result, "Current Open DB PTR", CStr(DBGadgetsPTR)
    
    SetProperty Result, "ObjectsRS Recordcount", CStr(ObjectsRS.RecordCount)
    SendStatus = Result
LocalError:
    LocalError = Error
    ErrCntr = ErrCntr + 1
    SetProperty Result, "Status Error " & CStr(ErrCntr), LocalError
    Resume Next
EndSub:
End Function

Friend Function PullMethodNames(Task As Gadget, Params As Gadget) As Gadget
    ' read a class/form/basic file and create a list of the functions in it
    
End Function
Friend Function ParseCommand(Param As String) As Gadget
    ' this function will return a fully qualified command gadget to
    ' caller.  the command processor can then perform the task
    Dim t, Msg As String, Cntr1 As Long
    Dim Results As Gadget
    Dim ParamLen As Long
    Dim TempChar As String, CharCNTR As Long, CharPTR As Long
    Dim Words() As String, WordsCNTR As Long, WordsPTR As Long
    Dim Command As String, CommandDone As Boolean
    Dim FirstPropWordPTR As Long, LastPropWordPTR As Long
    Dim Object1 As String, Object1Done As Boolean
    Dim Object2 As String, Object2Done As Boolean
    Dim Props() As String, PropValues() As String
    Dim PropsDone As Boolean
    ParamLen = Len(Param)
    ' parse the string into separate words and punctuation
    For Cntr1 = 1 To ParamLen
        TempChar = Mid(Param, Cntr1, 1)
        If TempChar = " " Or TempChar = "," Then
            WordsCNTR = WordsCNTR + 1
            ' this gets punctuation mark in next word
            Words(WordsCNTR) = TempChar
            WordsCNTR = WordsCNTR + 1
        Else
            Words(WordsCNTR) = Words(WordsCNTR) & TempChar
        End If
    Next Cntr1
    ' have sentence in array
    Command = Words(1)
    CommandDone = True
    ' where is the first property definition?
    For WordsPTR = 2 To WordsCNTR
        Select Case True
            Case FirstPropWordPTR = 0 And _
                 (InStr(UCase(Words(WordsPTR)), "=") > 0 Or _
                  UCase(Words(WordsPTR)) = "IS")
                FirstPropWordPTR = WordsPTR
                Exit For
            Case FirstPropWordPTR > 0
        End Select
    Next WordsPTR
    ' the last prop definitions is where?
    For WordsPTR = WordsCNTR To 2 Step -1
        Select Case True
            Case LastPropWordPTR = 0 And _
                 (InStr(UCase(Words(WordsPTR)), "=") > 0 Or _
                  UCase(Words(WordsPTR)) = "IS")
                LastPropWordPTR = WordsPTR
                Exit For
        End Select
    Next WordsPTR
    
    For WordsPTR = 2 To WordsCNTR
        Select Case True
            Case Words(WordsPTR) = " " Or Words(WordsPTR) = ","
                ' these are delimiters
                
            Case CommandDone
                If TempChar = " " Or TempChar = "," Then
                    WordsCNTR = WordsCNTR + 1
                Else
                    Words(WordsCNTR) = Words(WordsCNTR) & TempChar
                End If
                
            Case Not Object2Done
            Case Not PropsDone
            
        End Select
    Next WordsPTR
    ' here we have all words in sentence
    ' the first one is the command
    For WordsPTR = 1 To WordsCNTR
    
    Next
End Function

Friend Function Compare2Gadgets(cGadget1 As Gadget, _
                                cGadget2 As Gadget) As Gadget
    ' see if the given objects have the same properties
    ' returns a list of properties from 2nd gadget that aren't the same as first
    Dim starttime As Single, stoptime As Single
    starttime = Timer
    Dim t, Prop1Name As String, Prop2Name As String
    Dim Cntr1 As Integer, CNTR2 As Integer
    Dim TotDiffProps As Integer
    Dim TotPropsNotFound As Integer
    Dim ResultGadget As Gadget
    TotDiffProps = 0
    ResultGadget = BlankObject
    ResultGadget.Name = "Same"
    t = SetProperty(ResultGadget, "Total Diff Props", CStr(TotDiffProps))
    ' skip thru all props in first object
    For Cntr1 = 1 To cGadget1.TotalProperties
        ' find corresponding prop in second
        For CNTR2 = 1 To cGadget2.TotalProperties
            If cGadget1.Propity(Cntr1) = cGadget2.Propity(CNTR2) Then
                ' found the same property
                ' check equivalence
                If cGadget1.ValueAlpha(Cntr1) <> cGadget2.ValueAlpha(CNTR2) Then
                    ' values not same
                    TotDiffProps = TotDiffProps + 1
                    ResultGadget.Name = "Different"
                    t = SetProperty(ResultGadget, "Total Diff Props", CStr(TotDiffProps))
                    t = SetProperty(ResultGadget, "Diff Prop #" & CStr(TotDiffProps), cGadget2.Propity(CNTR2))
                End If
                Exit For
            End If
        Next
        If CNTR2 > cGadget2.TotalProperties Then
            TotDiffProps = TotDiffProps + 1
            ResultGadget.Name = "Different"
            t = SetProperty(ResultGadget, "Total Diff Props", CStr(TotDiffProps))
            t = SetProperty(ResultGadget, cGadget1.Propity(Cntr1), "Not Found in: " & cGadget2.Name)
        End If
    Next
    stoptime = Timer
    t = SetProperty(ResultGadget, "StartTimer", CStr(starttime))
    t = SetProperty(ResultGadget, "StopTimer", CStr(stoptime))
    t = SetProperty(ResultGadget, "Total Time", CStr(stoptime - starttime))
    Compare2Gadgets = ResultGadget
'    MsgBox stoptime - starttime
End Function
Friend Function TestFXN(DBName As String) As Gadget

End Function
Friend Function ConvertLegacy(DBName As String) As Gadget
    Dim starttime As Single, stoptime As Single
    starttime = Timer
    Dim OCntr As Long, TotToConvert As Long
    Dim CheckedCellCntr As Long
    Dim ChangedCellCntr As Long
    Dim LegacyCNTR As Long
    Dim CResults As Gadget
    Dim DBsDoneCNTR As Long
    Dim RREsults As Gadget
    Dim MResults As Gadget
    Dim CurrentOID As Long
    Dim ThisOID As Long
    Dim ObjectRSBookmark As String
    Dim LType As String, LContainer As String
    Dim AddTypeProperty As Boolean, AddContainerProperty As Boolean
    Dim CurrRep As Gadget, CurrCell As Gadget
    Dim AddCellName As Boolean, OldCellName As String
    Dim AddCellReportGroup As Boolean
    Dim DBPointer As Integer
    Dim LocalError  As String
    Dim TotalErrors As Long
    Dim TotalBytesAdded As Long
    Dim DoAll As Boolean
    Dim TotGaugeFulls As Single, TotGaugeFullsCntr As Integer
    Dim PropsBookmark As String
    On Error GoTo LocalError
    SetProperty Trace, NextID("trace") & "Convert Legacy Start *********************************", "************************"
    SetProperty Trace, NextID("trace") & "Legacy Converter", "Instruction: " & DBName
    Load OSDetectAndStatus
    OSDetectAndStatus.Top = 100
    OSDetectAndStatus.Left = 100
    OSDetectAndStatus.Caption = "Data Conversion Progress"
    OSDetectAndStatus.ProgressLabel = "Converting Data Pool"
    OSDetectAndStatus.GageLabel.Caption = "0 %"
    OSDetectAndStatus.CmdCancel.Visible = False
    OSDetectAndStatus.Show
    DBPointer = DBGadgetsPTR
    DoAll = (UCase(DBName) = "ALL")
    DBPointer = -1
StartNewDatabase:
    If DoAll Then
        If DBPointer < DBGadgetsCNTR Then
            DBPointer = DBPointer + 1
            DBSwitch DBPointer
            DBName = ReadProperty(DBGadgets(DBPointer), "DB Name")
            SetProperty Trace, NextID("trace") & "Legacy Converter", "Switched DB: " & DBName
            SetProperty CResults, "Legacy Converter", "Switched DB: " & DBName
        Else
            SetProperty Trace, NextID("trace") & "Legacy Converter", "Last DB Done: " & DBName
'            SetProperty CResults, "Bytes added to Pool " & CStr(DBGadgetsPTR), CStr(TotalBytesAdded)
            GoTo EndSub
        End If
        SetProperty Trace, NextID("trace") & "Legacy Converter", "DB: " & DBName
        SetProperty CResults, "Legacy Converter", "Switched DB: " & DBName
    Else
        SetProperty Trace, NextID("trace") & "Legacy Converter", "DB: " & DBName
        DBSwitch DBFindIndex(DBName)
    End If
    DBsDoneCNTR = DBsDoneCNTR + 1
    ObjectsRS.Index = "Name"
    PropsRS.Index = "ObjectID"
    
    ObjectsRS.MoveLast
    TotToConvert = ObjectsRS.RecordCount
    TotGaugeFulls = TotToConvert / 32000
    
    If LocalError <> "" Then
        SetProperty Trace, NextID("trace") & "Legacy Converter Got New Tot To Convert", CStr(TotToConvert)
    End If
    LocalError = ""
    If LocalError <> "" Then
        SetProperty Trace, NextID("trace") & "set gage value 1", "0" & "/ Error" & LocalError
    End If
    LocalError = ""
    
    OSDetectAndStatus.GageLabel.Caption = "0 %"
    If LocalError <> "" Then
        SetProperty Trace, NextID("trace") & "set gage caption 1", "0 %" & "/ Error" & LocalError
    End If
    LocalError = ""
    
    If TotToConvert < 32000 Then
'        OSDetectAndStatus.ProgressGauge.Max = CInt(TotToConvert + 100)
    Else
        TotGaugeFullsCntr = TotGaugeFullsCntr + 1
'        OSDetectAndStatus.ProgressGauge.Max = CInt(32000)
    End If
    OSDetectAndStatus.ProgressLabel = "Converting " & CStr(TotToConvert) & " Data Elements"
    If LocalError <> "" Then
        SetProperty CResults, "Converter Set Gage 1", "Error: " & LocalError
    End If
    ' start skipping thru the data and set the new properties
    LocalError = ""
    ObjectsRS.MoveFirst
    PropsRS.Index = "ObjectID"
    Do While ObjectsRS.EOF = False
        If UserCancel = True Then
            UserCancel = False
            GoTo EndSub
        End If
        OCntr = OCntr + 1
        LocalError = ""
        DoEvents
        If LocalError <> "" Then
            SetProperty Trace, NextID("trace") & "set gage value 2", CStr(OCntr) & "/ Error" & LocalError
        End If
        LocalError = ""
        If OCntr Mod 100 = 0 Then
            OSDetectAndStatus.GageLabel.Caption = CStr(((Round(((OCntr / TotToConvert) * 100))))) & " %" & " (" & CStr(OCntr) & ")"
        End If
        If LocalError <> "" Then
            SetProperty Trace, NextID("trace") & "Gage caption set", CInt(OCntr) & " / Error: " & LocalError
        End If
        LocalError = ""
        AddCellName = False
        DoEvents
        If ObjectsRS!Type = "Cell" Then
            OldCellName = ObjectsRS!Name
            If LocalError <> "" Then
                SetProperty Trace, NextID("trace") & "Type=Cell", CInt(OCntr) & " / Error: " & LocalError
            End If
            CheckedCellCntr = CheckedCellCntr + 1
            AddCellName = True
        End If
        LType = ObjectsRS!Type
        LContainer = ObjectsRS!Container
        ' find the properties of this object
        PropsRS.Seek "=", ObjectsRS!ObjectID
        AddTypeProperty = True
        AddContainerProperty = True
        Do While PropsRS.NoMatch = False
            ' this checks to see if the object already has any property and disables
            ' the add if it does
            If PropsRS!Property = "Cell Name" Then
                AddCellName = False
            End If
            If PropsRS!Property = "Type" Then
                AddTypeProperty = False
            End If
            If PropsRS!Property = "Container" Then
                AddContainerProperty = False
            End If
            If PropsRS!Property = "" Then
                AddContainerProperty = False
            End If
            PropsRS.MoveNext
            If PropsRS.EOF Then
                Exit Do
            End If
            If PropsRS!ObjectID <> ObjectsRS!ObjectID Then
                Exit Do
            End If
'            OSDetectAndStatus.GageLabel.Caption = CStr(((Round(((OCntr / TotToConvert) * 100))))) & " %" & " (" & CStr(OCntr) & ")"
            'OSDetectAndStatus.SetFocus
            DoEvents
        Loop
        If ObjectsRS!Name = VGBDatabaseName Then
            AddCellName = False
            AddTypeProperty = False
            AddContainerProperty = False
        End If
        If AddCellName = True Then
            PropsRS.AddNew
            PropsRS![ObjectID] = ObjectsRS!ObjectID
            PropsRS!Property = "Cell Name"
            PropsRS!ValueAlpha = OldCellName
            PropsRS!PropSource = "GB"
            PropsRS!PropType = 0
            PropsRS.Update
        End If
        If AddTypeProperty = True Then
            LegacyCNTR = LegacyCNTR + 1
            PropsRS.AddNew
            PropsRS![ObjectID] = ObjectsRS!ObjectID
            PropsRS!Property = "Type"
            PropsRS!ValueAlpha = LType
            PropsRS!PropSource = "GB"
            PropsRS!PropType = 0
            PropsRS.Update
        End If
        If AddContainerProperty = True Then
            PropsRS.AddNew
            PropsRS![ObjectID] = ObjectsRS!ObjectID
            PropsRS!Property = "Container"
            PropsRS!ValueAlpha = LContainer
            PropsRS!PropSource = "GB"
            PropsRS!PropType = 0
            PropsRS.Update
        End If
        ObjectsRS.MoveNext
        If ObjectsRS.EOF Then
            Exit Do
        End If
        DoEvents
    Loop
    If DoAll Then
        GoTo StartNewDatabase
    End If
    GoTo EndSub
LocalError:
    LocalError = Error
    TotalErrors = TotalErrors + 1
    SetProperty VGBErrors, NextID("error") & "Convert Error " & CStr(TotalErrors), "Error: " & LocalError
    SetProperty Trace, NextID("error") & "Convert Error " & CStr(TotalErrors), "Error: " & LocalError
    SetProperty CResults, "Error " & CStr(TotalErrors), LocalError
    SetProperty CResults, "Error", LocalError
    If TotalErrors > 5 Then
        SetProperty CResults, "Terminated", "Terminated because of Totalerrors > 5"
        SetProperty CResults, "Error", "Terminated because of Totalerrors > 5"
        GoTo EndSub
    End If
    Resume Next
EndSub:
    CResults.Name = "Conversion Status"
    CResults.Type = "System"
    CResults.Container = "System"
    SetProperty CResults, "Date of Convert", Now
    SetProperty CResults, "Total Memories Pools Done", CStr(DBsDoneCNTR)
    SetProperty CResults, "Total Cells Done", CStr(CheckedCellCntr)
    SetProperty CResults, "Total Legacies Done", CStr(LegacyCNTR)
    stoptime = Timer
    SetProperty CResults, "Total Time", CStr(stoptime - starttime) & " seconds"
    OSDetectAndStatus.Hide
    UserCancel = False
    DBSwitch DBGadgetsPTR
    DoEvents
    ConvertLegacy = CResults
End Function

Friend Function CheckTrace()
    Dim LocalError As String
    On Error GoTo LocalError
    GoTo EndSub
    If Trace.TotalProperties >= 64 Then
        Trace.Name = "Saved: " & CStr(Now())
        Trace.Type = "Trace Record"
        Memorize Trace, "in " & AddBackSlash(App.Path) & "Trace.VGB"
        Trace = BlankObject
        Trace.Name = "Trace Cleared " & Now
    End If
GoTo EndSub
LocalError:
    LocalError = Error
    SetProperty VGBErrors, NextID("error") & "CheckTrace Trapped Error", "Error: " & LocalError
    FloatMsgBox LocalError, "Brain Clear Trace Error"
    Resume Next
EndSub:
End Function

Public Function ASCIIFileRead(FileToUse As String, ArrayToUse(), Optional ForceUCase As Boolean = False) As String
    ' reads the file into the passed array (variant)
    Dim ArrayToUseNDX As Long
    Dim ThisHandle As Integer, HandleNDX As Integer
    Dim LocalError As String, Result As String
    On Error GoTo RAFError
    LocalError = ""
    ' get us a good file handle
    ThisHandle = FreeFile
    'Binary Access Read
    Open FileToUse For Input As #ThisHandle
    'Open FileToUse For Binary Access Read As #ThisHandle
    If LocalError <> "" Then
'        MsgBox "Couldn't find ASCII File: " & FileToUse, vbOKOnly + MB_ICONEXCLAMATION, "File Locate Error"
        Result = "ERROR: Couldn't find ASCII File: " & FileToUse
        GoTo EndRAF
    End If
    Result = "OK"
    ArrayToUseNDX = 0
    Do Until EOF(ThisHandle)
        ArrayToUseNDX = ArrayToUseNDX + 1
        ReDim Preserve ArrayToUse(ArrayToUseNDX)
        Line Input #ThisHandle, ArrayToUse(ArrayToUseNDX)
        If ForceUCase Then
            ArrayToUse(ArrayToUseNDX) = UCase(ArrayToUse(ArrayToUseNDX))
        End If
        If ArrayToUseNDX Mod 9 = 0 Then
            DoEvents
        End If
    Loop
    Close #ThisHandle
    GoTo EndRAF
RAFError:
    LocalError = Error$
    Result = Error
    Resume Next
EndRAF:
    ASCIIFileRead = Result
End Function

Public Function ASCIIFileWrite(FileToUse As String, ArrayToUse(), Optional StringVar As String = "", Optional OverWrite As Boolean = True) As String
    ' writes the array or string into the file
    Static FileHandles()
    Dim ArrayToUseNDX As Long, ArrayLen As Long
    Dim ThisHandle As Integer
    Dim LocalError As String, Result As String
    On Error GoTo RAFError
    LocalError = ""
    ' get us a good file handle
    ThisHandle = FreeFile
    If OverWrite Then
        Open FileToUse For Output As #ThisHandle
    Else
        Open FileToUse For Append As #ThisHandle
    End If
    If LocalError <> "" Then
'        MsgBox "Couldn't find ASCII File: " & FileToUse, vbOKOnly + MB_ICONEXCLAMATION, "File Locate Error"
        If LocalError = "File not found" Then
            Open FileToUse For Output As #ThisHandle
        Else
            Result = "ERROR: Couldn't open ASCII File: " & FileToUse
            GoTo EndSub
        End If
    End If
    Result = "OK"
    Select Case True
        Case StringVar <> ""
            Print #ThisHandle, StringVar
        Case Else
            ArrayLen = UBound(ArrayToUse())
            ArrayToUseNDX = 1
            Do Until ArrayToUseNDX >= ArrayLen
                Print #ThisHandle, ArrayToUse(ArrayToUseNDX)
                ArrayToUseNDX = ArrayToUseNDX + 1
                If ArrayToUseNDX Mod 9 = 0 Then
                    DoEvents
                End If
            Loop
    End Select
    Close #ThisHandle
    GoTo EndSub
RAFError:
    LocalError = Error$
    Result = LocalError
    Resume Next
EndSub:
    ASCIIFileWrite = Result
End Function

Private Sub Class_Initialize()
    ' when it first fires up
'    frmSplash.Show
    
    Dim t, Msg As String
    If DoneDone Then
        GoTo EndSub
    End If
    DoneDone = True
    SetCoreVariables
    SetVariables
    SetProperty VGBStatus, "Class Init", Now()
    Msg = "Instance of BrainGadget Init" & CrLf

'    Msg = Msg & InitVGB & CrLf
    
'    FloatMsgBox Msg, "Status Message"
EndSub:
End Sub


Private Sub Class_Terminate()
'    Debug.Print "Shutdown: " & Now
    Unload OSDetectAndStatus
    Suicide = True
End Sub
