'*** jsdatabase-constructor (V3)
'*** The code below will automatically generate recordsets, fields and records for AccessObject-JavaScriptDatabase (C)
'*** Latest Access-Object JavaScript Database: http://www.javascriptdatabase.com
'*** Latest jsdatabase-constructor: http://www.javascriptdatabase.com
'*** Forum: http://www.i-t.net/jswwwboard
'*** Copyright(C) Kevin Gibney, kevin@javascriptdatabase.com
'*** Distributed under the terms of the GNU Library General Public License


'*** Instructions - see function Initialise() below.
'1 see function Initialise() below to set values
'2 records.js is created in the folder that you run your database from.
'3 if you have the module as a text file simply copy into access and execute function main() from a button in a form.
'4 to change where records.js is saved see function main()


'//START program variables
Public MyDB As String
Dim MydbIndex(2, 6) As String
Public JSNoTables() As String
Public MyIdx As Integer
Public JsNoIdx As Integer
Public Const defDatabase = "var <!--mydb--> = new Database('<!--mydb-->')"
Public Const defRecordset = "<!--mydb-->.CreateRecordset('<!--table-->')"
Public Const defCreateField = "<!--mydb-->.<!--table-->.CreateField('<!--fieldname-->'<!--dbIndex-->)"
Public Const defAddRec = "A([<!--rec-->])"
'//END program variables

Public Sub Initialise()
    '*** 1 set database name
    MyDB = "DB"
        
    '*** 2 set primary key fields - although i could detect for primary key, you may not always want to set a primary key for a recordset as this will have a time overhead when loading the records, not a problem unless u have thousands of records - see AO-JD Vietnam example which has speed diagnostic code.
    Call CreatePrimaryKey("tCOUNTRIES", "COUNTRY_ID")
    Call CreatePrimaryKey("tRANKS", "RANK_ID")
    Call CreatePrimaryKey("tSERVICES", "SERVICE_ID")
    Call CreatePrimaryKey("tSTATES", "STATE_ID")
    Call CreatePrimaryKey("tSTATUSES", "STATUS_ID")
    Call CreatePrimaryKey("tVEHICLES", "VEHICLE_ID")
      
   '*** 3 set ignore tables
   Call IgnoreTable("Switchboard Items")
End Sub
Public Sub main()
    Dim recspath
    MyIdx = -1
    JsNoIdx = -1

    recspath = Application.CurrentProject.Path + "\records.js"
    
    Open recspath For Output Shared As #1
    
    Call Initialise
    
    Call create_defRecordset
    Call create_defCreateField
    Call create_defAddRec
    Close #1
    MsgBox "records.js create in folder of your database"
End Sub
Public Sub CreatePrimaryKey(tablename, fieldname)
    Dim length
    
    MyIdx = MyIdx + 1
    'ReDim Preserve MydbIndex(2, MyIdx)
    MydbIndex(0, MyIdx) = tablename
    MydbIndex(1, MyIdx) = fieldname
End Sub

Public Sub IgnoreTable(table)
    Dim length
    
    JsNoIdx = JsNoIdx + 1
    ReDim Preserve JSNoTables(JsNoIdx)
    JSNoTables(JsNoIdx) = table
    length = UBound(JSNoTables)
End Sub



Public Sub create_defRecordset()
    Dim rst As recordset
    Dim dbs As Database

    Set dbs = CurrentDb
    Dim tdfLoop As TableDef
    
    'Dim fieldLoop As field
    
    Dim idx As Index
    Dim propLoop As Property
    Dim count As Long
    count = 0
    Dim temp_replace As String
    Dim temp_replace2 As String
    Dim temp_defRecordset As String
    Dim jstable As Boolean
    Dim t
    
   
    Print #1, "// *********"
    Print #1, "// Generated by Microsoft Access visual basic module: jsdatabase-constructor V3.0"
    Print #1, "// jsdatabase-constructor module available as freeware at: http://www.javascriptdatabase.com"
    Print #1, "//"
    Print #1, "// latest version of AccessObject-JavascriptDatabase at http://www.javascriptdatabase.com"
    Print #1, "// *********"
    Print #1,
    
    Print #1, replace("<!--mydb-->", MyDB, defDatabase)
    With dbs
            For Each tdfLoop In .TableDefs
                jstable = True

                If (tdfLoop.Attributes And dbSystemObject) Then
                    'system tables - ignore
                ElseIf check_JSNoTables(tdfLoop) Then
                    'not a jstable - ignore
                Else
                    temp_defRecordset = defRecordset
                    
                    temp_replace = replace("<!--table-->", tdfLoop.Name, temp_defRecordset)
                    temp_replace2 = replace("<!--mydb-->", MyDB, temp_replace)
                    Print #1, temp_replace2
                End If
            Next tdfLoop
    End With
End Sub



Public Sub create_defCreateField()
    Dim dbs As Database
    Set dbs = CurrentDb
    Dim tdfLoop As TableDef
    Dim fieldLoop As field
    Dim idxLoop As Index
    Dim propLoop As Property
    Dim temp_replace As String
    Dim temp_replace2 As String
    Dim countidx As Long
    
    Dim temp_defCreateField As String
    Dim temp As String
    Dim temp2 As String
    
    Dim dbIndex As String
    Dim f
    With dbs
            For Each tdfLoop In .TableDefs
                If (tdfLoop.Attributes And dbSystemObject) Then
                    'system tables - ignore
                ElseIf check_JSNoTables(tdfLoop) Then
                    'not a jstable - ignore
                Else
                    Print #1, ""
                    temp_defCreateField = defCreateField
                    temp = replace("<!--table-->", tdfLoop.Name, temp_defCreateField)
                    temp2 = temp
                    For Each fieldLoop In tdfLoop.Fields
                        'check if field for this table has dbIndex
                        dbIndex = ""
                        
                        'If (is_primary_key(tdfLoop, fieldLoop.Name)) Then
                        If (check_PrimaryKey(tdfLoop.Name, fieldLoop.Name)) Then
                            dbIndex = ",dbPrimaryKey"
                            temp_defCreateField = temp2
                            temp = replace("<!--dbIndex-->", dbIndex, temp_defCreateField)
                        End If

                        If dbIndex = "" Then
                            temp_defCreateField = temp2
                            temp = replace("<!--dbIndex-->", "", temp_defCreateField)
                        End If
                        
                        temp_defCreateField = temp
                        temp_replace = replace("<!--fieldname-->", fieldLoop.Name, temp_defCreateField)
                        temp_replace2 = replace("<!--mydb-->", MyDB, temp_replace)
                        Print #1, temp_replace2
                        
                    Next fieldLoop
                End If
            Next tdfLoop
    End With
End Sub

Public Sub create_defAddRec()
    Dim dbs As Database
    Set dbs = CurrentDb
    Dim tdfLoop As TableDef
    Dim fieldLoop As field
    Dim idxLoop As Index
    Dim propLoop As Property
    Dim rst As recordset
        
    Dim record As String
    Dim query As String
    
    Dim temp_defAddRec As String
    Dim temp As String
    Dim x

    Dim printquote As String
    Dim fieldvalue
    With dbs
            For Each tdfLoop In .TableDefs
                If (tdfLoop.Attributes And dbSystemObject) Then
                    'system tables - ignore
                ElseIf check_JSNoTables(tdfLoop) Then
                    'not a jstable - ignore
                Else
                    temp_defAddRec = defAddRec
                                        
                    query = "SELECT * FROM " & tdfLoop.Name
                    Set rst = dbs.OpenRecordset(query)
                    If rst.RecordCount = 0 Then
                        rst.Close
                        
                    Else
                        Print #1, ""
                        Print #1, "with ("; MyDB & "." & tdfLoop.Name & ")" & " {"
                        rst.MoveFirst
                    
                    
                        With rst
                            Do While Not .EOF
                                temp_defAddRec = defAddRec
                                For x = 1 To .Fields.count

                                    '*** select field types to put double quotes around
                                    Select Case .Fields(x - 1).Type
                                    Case dbText
                                        printquote = """"
                                    Case dbMemo
                                        printquote = """"
                                    Case dbChar
                                        printquote = """"
                                    Case dbDate
                                        printquote = """"
                                    Case Else
                                        printquote = "" 'print nothing
                                    End Select
                                    '*** end select field types
                                    fieldvalue = .Fields(x - 1)
                                    If x = 1 Then
                                        record = record & printquote & fieldvalue & printquote
                                    Else
                                        record = record & "," & printquote & fieldvalue & printquote
                                    End If
                                Next x
                                temp = replace("<!--rec-->", record, temp_defAddRec)
                                Print #1, temp
                                record = ""
                            
                                rst.MoveNext
                            Loop
                        End With
                        Print #1, "}"
                    End If
                End If
            Next tdfLoop
    End With
End Sub


Public Function replace(oldstr As String, newstr As String, replacestr As String, Optional startvalue As Long) As String
    Dim endstr As String
    Dim start, oldlen As Integer
    
    If startvalue = 0 Then startvalue = 1
    
    oldlen = Len(oldstr)
    start = InStr(startvalue, replacestr, oldstr)
    If start > 0 Then
        endstr = Right(replacestr, Len(replacestr) - start - oldlen + 1)
        replacestr = Left(replacestr, start - 1) + newstr + endstr
        replacestr = replace(oldstr, newstr, replacestr, start + 1)
    End If

   replace = replacestr

End Function

Public Function check_JSNoTables(table) As Boolean
    Dim t
    Dim jsnotable As Boolean
    jsnotable = False
    For t = 0 To UBound(JSNoTables)
        If (JSNoTables(t) = table.Name) Then
            jsnotable = True
        End If
    Next t
    
    check_JSNoTables = jsnotable
    
End Function

Public Function check_PrimaryKey(tablename, fieldname) As Boolean
    Dim t
    Dim length
    Dim primarykey As Boolean
    primarykey = False
    length = UBound(MydbIndex, 2)
    For t = 0 To length
        If (MydbIndex(0, t) = tablename) Then
            If (MydbIndex(1, t) = fieldname) Then
                primarykey = True
            End If
        End If
    Next t
    
    check_PrimaryKey = primarykey
    
End Function

'function not used
Public Function is_primary_key(tdf, fldname)
    Dim idx As Index
    
    fldname = "+" & fldname
    
    For Each idx In tdf.Indexes
        If idx.Fields = fldname Then
            If idx.Primary Then
                is_primary_key = True
                Exit Function
            End If
        End If
    Next idx

    is_primary_key = False
End Function