'============================================================== ' GeneratePOBOAndRepository.vbs ' ' Usage: ' cscript //nologo GeneratePOBOAndRepository.vbs /table:Orders /pk:OrderID [/cs:MyConnString] [/config:C:\path\web.config] ' ' Reads connection string from web.config , ' discovers [table] schema, and generates: ' � POBO_.asp (Classic ASP class with typed Property Lets) ' �
Repository.asp (parameterized CRUD + paging + search) ' ' Safe for Access or SQL Server connection strings. '============================================================== Option Explicit '---------------- Args & paths ---------------- Dim fso, args, i, arg, parts Dim tableName, primaryKey, csKey, configPath, thisFolder Set fso = CreateObject("Scripting.FileSystemObject") Set args = WScript.Arguments csKey = "ConnectionString" thisFolder = fso.GetParentFolderName(WScript.ScriptFullName) configPath = fso.GetParentFolderName(fso.GetParentFolderName(WScript.ScriptFullName)) & "\public\web.config" For i = 0 To args.Count - 1 arg = args(i) If InStr(arg, ":") > 0 Then parts = Split(arg, ":", 2) Select Case LCase(Replace(parts(0), "/", "")) Case "table": tableName = parts(1) Case "pk": primaryKey = parts(1) Case "cs": csKey = parts(1) Case "config": configPath = parts(1) End Select End If Next If Len(tableName) = 0 Or Len(primaryKey) = 0 Then WScript.Echo "Usage: cscript //nologo GeneratePOBOAndRepository.vbs /table: /pk: [/cs:] [/config:]" WScript.Quit 1 End If ' Validate table name format (alphanumeric, underscore only - prevent SQL injection) If Not IsValidIdentifier(tableName) Then WScript.Echo "Error: Invalid table name format. Only letters, numbers, and underscores are allowed." WScript.Quit 1 End If ' Validate primary key format If Not IsValidIdentifier(primaryKey) Then WScript.Echo "Error: Invalid primary key format. Only letters, numbers, and underscores are allowed." WScript.Quit 1 End If '---------------- Config & connection ---------------- Dim connStr connStr = GetAppSetting(csKey, configPath) If connStr = "nothing" Then WScript.Echo "Error: Key '" & csKey & "' not found in " & configPath WScript.Quit 1 End If Dim conn Set conn = CreateObject("ADODB.Connection") On Error Resume Next conn.Open connStr If Err.Number <> 0 Then WScript.Echo "DB connection failed: " & Err.Description WScript.Quit 1 End If On Error GoTo 0 '---------------- Discover schema (portable) ---------------- ' Strategy: ' 1) Try OpenSchema(adSchemaColumns) for rich metadata. ' 2) Fallback to "SELECT * WHERE 1=0" to at least get names/types. Const adSchemaColumns = 4 Dim cols(), types(), nullable(), ordinals(), fld, idx Dim haveSchema : haveSchema = False On Error Resume Next Dim rsCols Set rsCols = conn.OpenSchema(adSchemaColumns, Array(Empty, Empty, tableName, Empty)) If Err.Number = 0 Then idx = -1 Do Until rsCols.EOF idx = idx + 1 ReDim Preserve cols(idx), types(idx), nullable(idx), ordinals(idx) cols(idx) = CStr(rsCols("COLUMN_NAME")) types(idx) = Nz(rsCols("DATA_TYPE"), 0) ' ADO type enum nullable(idx) = LCase(CStr(Nz(rsCols("IS_NULLABLE"), "YES"))) = "yes" ordinals(idx) = CLng(Nz(rsCols("ORDINAL_POSITION"), idx+1)) rsCols.MoveNext Loop rsCols.Close : Set rsCols = Nothing haveSchema = (idx >= 0) Else Err.Clear End If On Error GoTo 0 If Not haveSchema Then ' Fallback: get names/types from zero-row select On Error Resume Next Dim rsProbe Set rsProbe = conn.Execute("SELECT * FROM " & QI(tableName) & " WHERE 1=0") If Err.Number <> 0 Then WScript.Echo "Error querying table [" & tableName & "]: " & Err.Description conn.Close : Set conn = Nothing WScript.Quit 1 End If On Error GoTo 0 idx = -1 For Each fld In rsProbe.Fields idx = idx + 1 ReDim Preserve cols(idx), types(idx), nullable(idx), ordinals(idx) cols(idx) = fld.Name types(idx) = fld.Type nullable(idx) = True ' Unknown; assume nullable ordinals(idx) = idx + 1 Next rsProbe.Close : Set rsProbe = Nothing End If If idx < 0 Then WScript.Echo "No columns found for table [" & tableName & "]." WScript.Quit 1 End If ' Sort metadata by ordinal (defensive) Call ArraySortByParallel(ordinals, Array(cols, types, nullable)) ' Validate PK exists If Not InArrayInsensitive(cols, primaryKey) Then WScript.Echo "Primary key '" & primaryKey & "' not found in table [" & tableName & "]." WScript.Quit 1 End If '---------------- Generate POBO_
.asp ---------------- Dim poboOut poboOut = BuildPOBO(cols, types, tableName, primaryKey) Dim poboPath, tf poboPath = fso.BuildPath(thisFolder, "POBO_" & tableName & ".asp") Set tf = fso.CreateTextFile(poboPath, True, False) tf.Write poboOut tf.Close Set tf = Nothing WScript.Echo "POBO class written to: " & poboPath '---------------- Generate
Repository.asp ---------------- Dim repoOut repoOut = BuildRepository(cols, tableName, primaryKey) Dim repoPath repoPath = fso.BuildPath(thisFolder, tableName & "Repository.asp") Set tf = fso.CreateTextFile(repoPath, True, False) tf.Write repoOut tf.Close Set tf = Nothing WScript.Echo "Repository written to: " & repoPath '---------------- Cleanup ---------------- conn.Close : Set conn = Nothing Set fso = Nothing '============================================================== ' POBO generator (your example, integrated) '============================================================== Function BuildPOBO(byRef colsArr, byRef typesArr, ByVal tName, ByVal pk) Dim classDef, idxLocal, name, ftype Dim parts() ReDim parts(1000) ' Pre-allocate for performance Dim partIdx : partIdx = 0 ' Build using array for performance (StringBuilder pattern) parts(partIdx) = "<%" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = "' Auto-generated POBO for table [" & tName & "]" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = "' Generated on " & Now() & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = "' Generator: GenerateRepo.vbs v1.0" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = "'" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = "' Dependencies: core/helpers.asp (QuoteValue function)" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = vbCrLf & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = "Class POBO_" & tName & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = " ' Public array of all property names" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = " Public Properties" & vbCrLf & vbCrLf : partIdx = partIdx + 1 ' Private backing fields For idxLocal = 0 To UBound(colsArr) parts(partIdx) = " Private p" & colsArr(idxLocal) & vbCrLf : partIdx = partIdx + 1 Next ' Initializer with defaults parts(partIdx) = vbCrLf & " Private Sub Class_Initialize()" & vbCrLf : partIdx = partIdx + 1 For idxLocal = 0 To UBound(colsArr) Select Case typesArr(idxLocal) Case 200,201,202,203 ' adChar, adVarChar, adVarWChar, adWChar (strings) parts(partIdx) = " p" & colsArr(idxLocal) & " = """"" & vbCrLf : partIdx = partIdx + 1 Case 7,133,135 ' adDate, adDBDate, adDBTimeStamp (dates) parts(partIdx) = " p" & colsArr(idxLocal) & " = #1/1/1970#" & vbCrLf : partIdx = partIdx + 1 Case 2,3,4,5,6,14,131 ' adSmallInt, adInteger, adSingle, adDouble, adCurrency, adDecimal, adNumeric parts(partIdx) = " p" & colsArr(idxLocal) & " = 0" & vbCrLf : partIdx = partIdx + 1 Case 11 ' adBoolean parts(partIdx) = " p" & colsArr(idxLocal) & " = False" & vbCrLf : partIdx = partIdx + 1 Case Else parts(partIdx) = " p" & colsArr(idxLocal) & " = Null" & vbCrLf : partIdx = partIdx + 1 End Select Next parts(partIdx) = " Properties = Array(""" & Join(colsArr, """,""") & """)" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = " End Sub" & vbCrLf & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = " Public Property Get PrimaryKey()" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = " PrimaryKey = """ & pk & """" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = " End Property" & vbCrLf & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = " Public Property Get TableName()" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = " TableName = """ & tName & """" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = " End Property" & vbCrLf & vbCrLf : partIdx = partIdx + 1 ' Get/Let with coercion For idxLocal = 0 To UBound(colsArr) name = colsArr(idxLocal) ftype = typesArr(idxLocal) parts(partIdx) = " Public Property Get " & name & "()" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = " " & name & " = p" & name & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = " End Property" & vbCrLf & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = " Public Property Let " & name & "(val)" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = " On Error Resume Next" & vbCrLf : partIdx = partIdx + 1 Select Case ftype Case 200,201,202,203 ' Strings parts(partIdx) = " p" & name & " = CStr(val)" & vbCrLf : partIdx = partIdx + 1 Case 7 ' Dates parts(partIdx) = " p" & name & " = CDate(val)" & vbCrLf : partIdx = partIdx + 1 Case 133,135 ' Timestamps parts(partIdx) = " p" & name & " = QuoteValue(val)" & vbCrLf : partIdx = partIdx + 1 Case 11 ' Boolean parts(partIdx) = " p" & name & " = CBool(val)" & vbCrLf : partIdx = partIdx + 1 Case Else ' Numeric or other parts(partIdx) = " If IsNumeric(val) Then" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = " p" & name & " = CDbl(val)" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = " Else" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = " p" & name & " = val" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = " End If" & vbCrLf : partIdx = partIdx + 1 End Select parts(partIdx) = " If Err.Number <> 0 Then" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = " Err.Raise Err.Number, ""POBO_" & tName & "." & name & """, ""Invalid value for " & name & ": "" & Err.Description" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = " End If" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = " On Error GoTo 0" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = " End Property" & vbCrLf & vbCrLf : partIdx = partIdx + 1 Next parts(partIdx) = "End Class" & vbCrLf : partIdx = partIdx + 1 parts(partIdx) = "%>" & vbCrLf : partIdx = partIdx + 1 ' Join array for performance ReDim Preserve parts(partIdx - 1) BuildPOBO = Join(parts, "") End Function '============================================================== ' Repository generator (parameterized; DAL.* expected) '============================================================== Function BuildRepository(byRef colsArr, ByVal tName, ByVal pk) Dim insertCols(), updateCols(), allCols(), idCol Dim iLocal, cName idCol = pk ' Copy columns (no array-to-array assignment in VBScript) ReDim allCols(UBound(colsArr)) For iLocal = 0 To UBound(colsArr) allCols(iLocal) = colsArr(iLocal) Next ' Insert/Update sets: exclude PK Dim insIdx : insIdx = -1 For Each cName In colsArr If Not StrEqualCI(cName, idCol) Then insIdx = insIdx + 1 ReDim Preserve insertCols(insIdx) insertCols(insIdx) = cName End If Next Dim updIdx : updIdx = -1 For Each cName In colsArr If Not StrEqualCI(cName, idCol) Then updIdx = updIdx + 1 ReDim Preserve updateCols(updIdx) updateCols(updIdx) = cName End If Next Dim QTable, QPK, selectList, selectBase QTable = QI(tName) QPK = QI(idCol) selectList = JoinQI(allCols, ", ") selectBase = "Select " & selectList & " FROM " & QTable Dim out out = out & "<%" & vbCrLf out = out & "' Auto-generated Repository for table [" & tName & "]" & vbCrLf out = out & "' Generated on " & Now() & vbCrLf out = out & "' Generator: GenerateRepo.vbs v1.0" & vbCrLf out = out & "'" & vbCrLf out = out & "' Dependencies:" & vbCrLf out = out & "' - core/lib.DAL.asp (DAL singleton for database access)" & vbCrLf out = out & "' - core/lib.AutoMapper.asp (Automapper for object mapping)" & vbCrLf out = out & "' - core/lib.Collections.asp (LinkedList_Class)" & vbCrLf out = out & "' - core/lib.helpers.asp (KVUnzip, BuildOrderBy, QI, Destroy)" & vbCrLf out = out & vbCrLf & vbCrLf Dim className : className = tName & "Repository_Class" out = out & "Class " & className & vbCrLf & vbCrLf ' FindByID out = out & " Public Function FindByID(id)" & vbCrLf out = out & " Dim sql : sql = """ & selectBase & " WHERE " & QPK & " = ?""" & vbCrLf out = out & " Dim rs : Set rs = DAL.Query(sql, Array(id))" & vbCrLf out = out & " If rs.EOF Then" & vbCrLf out = out & " Err.Raise 1, """ & className & """, RecordNotFoundException(""" & idCol & """, id)" & vbCrLf out = out & " Else" & vbCrLf out = out & " Set FindByID = Automapper.AutoMap(rs, ""POBO_" & tName & """)" & vbCrLf out = out & " End If" & vbCrLf out = out & " Destroy rs" & vbCrLf out = out & " End Function" & vbCrLf & vbCrLf ' GetAll -> Find out = out & " Public Function GetAll(orderBy)" & vbCrLf out = out & " Set GetAll = Find(Empty, orderBy)" & vbCrLf out = out & " End Function" & vbCrLf & vbCrLf ' Find out = out & " Public Function Find(where_kvarray, order_string_or_array)" & vbCrLf out = out & " Dim sql : sql = """ & selectBase & """" & vbCrLf out = out & " Dim where_keys, where_values, i" & vbCrLf out = out & " If Not IsEmpty(where_kvarray) Then" & vbCrLf out = out & " KVUnzip where_kvarray, where_keys, where_values" & vbCrLf out = out & " If Not IsEmpty(where_keys) Then" & vbCrLf out = out & " sql = sql & "" WHERE """ & vbCrLf out = out & " For i = 0 To UBound(where_keys)" & vbCrLf out = out & " If i > 0 Then sql = sql & "" AND """ & vbCrLf out = out & " sql = sql & "" "" & QI(where_keys(i)) & "" = ?""" & vbCrLf out = out & " Next" & vbCrLf out = out & " End If" & vbCrLf out = out & " End If" & vbCrLf out = out & " sql = sql & BuildOrderBy(order_string_or_array, """ & QPK & """)" & vbCrLf out = out & " Dim rs : Set rs = DAL.Query(sql, where_values)" & vbCrLf out = out & " Dim list : Set list = new LinkedList_Class" & vbCrLf out = out & " Do Until rs.EOF" & vbCrLf out = out & " list.Push Automapper.AutoMap(rs, ""POBO_" & tName & """)" & vbCrLf out = out & " rs.MoveNext" & vbCrLf out = out & " Loop" & vbCrLf out = out & " Set Find = list" & vbCrLf out = out & " Destroy rs" & vbCrLf out = out & " End Function" & vbCrLf & vbCrLf ' FindPaged out = out & " Public Function FindPaged(where_kvarray, order_string_or_array, per_page, page_num, ByRef page_count, ByRef record_count)" & vbCrLf out = out & " Dim sql : sql = """ & selectBase & """" & vbCrLf out = out & " Dim where_keys, where_values, i" & vbCrLf out = out & " If Not IsEmpty(where_kvarray) Then" & vbCrLf out = out & " KVUnzip where_kvarray, where_keys, where_values" & vbCrLf out = out & " If Not IsEmpty(where_keys) Then" & vbCrLf out = out & " sql = sql & "" WHERE """ & vbCrLf out = out & " For i = 0 To UBound(where_keys)" & vbCrLf out = out & " If i > 0 Then sql = sql & "" AND """ & vbCrLf out = out & " sql = sql & "" "" & QI(where_keys(i)) & "" = ?""" & vbCrLf out = out & " Next" & vbCrLf out = out & " End If" & vbCrLf out = out & " End If" & vbCrLf out = out & " sql = sql & BuildOrderBy(order_string_or_array, """ & QPK & """)" & vbCrLf out = out & " Dim rs : Set rs = DAL.PagedQuery(sql, where_values, per_page, page_num)" & vbCrLf out = out & " If Not rs.EOF Then" & vbCrLf out = out & " rs.PageSize = per_page" & vbCrLf out = out & " rs.AbsolutePage = page_num" & vbCrLf out = out & " page_count = rs.PageCount" & vbCrLf out = out & " record_count = rs.RecordCount" & vbCrLf out = out & " End If" & vbCrLf out = out & " Set FindPaged = PagedList(rs, per_page)" & vbCrLf out = out & " Destroy rs" & vbCrLf out = out & " End Function" & vbCrLf & vbCrLf ' SearchTablePaged (OR col LIKE ?) out = out & " Public Function SearchTablePaged(columns_array, search_value, order_string_or_array, per_page, page_num, ByRef page_count, ByRef record_count)" & vbCrLf out = out & " Dim sql : sql = """ & selectBase & """" & vbCrLf out = out & " Dim i, params()" & vbCrLf out = out & " If IsArray(columns_array) And UBound(columns_array) >= 0 Then" & vbCrLf out = out & " sql = sql & "" WHERE """ & vbCrLf out = out & " ReDim params(UBound(columns_array))" & vbCrLf out = out & " For i = 0 To UBound(columns_array)" & vbCrLf out = out & " If i > 0 Then sql = sql & "" OR """ & vbCrLf out = out & " sql = sql & "" "" & QI(columns_array(i)) & "" LIKE ?""" & vbCrLf out = out & " params(i) = ""%"" & search_value & ""%""" & vbCrLf out = out & " Next" & vbCrLf out = out & " End If" & vbCrLf out = out & " sql = sql & BuildOrderBy(order_string_or_array, """ & QPK & """)" & vbCrLf out = out & " Dim rs : Set rs = DAL.PagedQuery(sql, params, per_page, page_num)" & vbCrLf out = out & " If Not rs.EOF Then" & vbCrLf out = out & " rs.PageSize = per_page" & vbCrLf out = out & " rs.AbsolutePage = page_num" & vbCrLf out = out & " page_count = rs.PageCount" & vbCrLf out = out & " record_count = rs.RecordCount" & vbCrLf out = out & " End If" & vbCrLf out = out & " Set SearchTablePaged = PagedList(rs, per_page)" & vbCrLf out = out & " Destroy rs" & vbCrLf out = out & " End Function" & vbCrLf & vbCrLf ' PagedList helper out = out & " Private Function PagedList(rs, per_page)" & vbCrLf out = out & " Dim list : Set list = new LinkedList_Class" & vbCrLf out = out & " Dim x : x = 0" & vbCrLf out = out & " Do While (per_page <= 0 Or x < per_page) And Not rs.EOF" & vbCrLf out = out & " list.Push Automapper.AutoMap(rs, ""POBO_" & tName & """)" & vbCrLf out = out & " x = x + 1" & vbCrLf out = out & " rs.MoveNext" & vbCrLf out = out & " Loop" & vbCrLf out = out & " Set PagedList = list" & vbCrLf out = out & " End Function" & vbCrLf & vbCrLf ' AddNew out = out & " Public Sub AddNew(ByRef model)" & vbCrLf out = out & " Dim sql : sql = ""INSERT INTO " & QTable & " (" & JoinQI(insertCols, ", ") & ") VALUES (" & Placeholders(UBound(insertCols)+1) & ")""" & vbCrLf out = out & " DAL.Execute sql, " & BuildModelParamsArray("model", insertCols) & vbCrLf out = out & " " & vbCrLf out = out & " ' Retrieve the newly inserted ID" & vbCrLf out = out & " On Error Resume Next" & vbCrLf out = out & " Dim rsId : Set rsId = DAL.Query(""SELECT @@IDENTITY AS NewID"", Empty)" & vbCrLf out = out & " If Err.Number <> 0 Then" & vbCrLf out = out & " ' Fallback for Access databases" & vbCrLf out = out & " Err.Clear" & vbCrLf out = out & " Set rsId = DAL.Query(""SELECT TOP 1 " & QPK & " FROM " & QTable & " ORDER BY " & QPK & " DESC"", Empty)" & vbCrLf out = out & " End If" & vbCrLf out = out & " On Error GoTo 0" & vbCrLf out = out & " " & vbCrLf out = out & " If Not rsId.EOF Then" & vbCrLf out = out & " If Not IsNull(rsId(0)) Then model." & idCol & " = rsId(0)" & vbCrLf out = out & " End If" & vbCrLf out = out & " Destroy rsId" & vbCrLf out = out & " End Sub" & vbCrLf & vbCrLf ' Update out = out & " Public Sub Update(model)" & vbCrLf out = out & " Dim sql : sql = ""UPDATE " & QTable & " SET " & JoinSetters(updateCols) & " WHERE " & QPK & " = ?""" & vbCrLf out = out & " DAL.Execute sql, " & BuildModelParamsArrayWithPK("model", updateCols, idCol) & vbCrLf out = out & " End Sub" & vbCrLf & vbCrLf ' Delete out = out & " Public Sub Delete(id)" & vbCrLf out = out & " Dim sql : sql = ""DELETE FROM " & QTable & " WHERE " & QPK & " = ?""" & vbCrLf out = out & " DAL.Execute sql, Array(id)" & vbCrLf out = out & " End Sub" & vbCrLf & vbCrLf ' Exceptions & helpers out = out & " Private Function RecordNotFoundException(ByVal field_name, ByVal field_val)" & vbCrLf out = out & " RecordNotFoundException = """ & tName & " record was not found with "" & field_name & "" = '"" & field_val & ""'.""" & vbCrLf out = out & " End Function" & vbCrLf & vbCrLf out = out & " Private Function QI(name)" & vbCrLf out = out & " QI = ""["" & Replace(CStr(name), ""]"", ""]]"") & ""]""" & vbCrLf out = out & " End Function" & vbCrLf & vbCrLf out = out & " Private Function BuildOrderBy(orderArg, defaultCol)" & vbCrLf out = out & " Dim s : s = """"" & vbCrLf out = out & " If IsEmpty(orderArg) Or IsNull(orderArg) Or orderArg = """" Then" & vbCrLf out = out & " s = "" ORDER BY "" & defaultCol & "" ASC""" & vbCrLf out = out & " ElseIf IsArray(orderArg) Then" & vbCrLf out = out & " Dim i : s = "" ORDER BY """ & vbCrLf out = out & " For i = 0 To UBound(orderArg)" & vbCrLf out = out & " If i > 0 Then s = s & "", """ & vbCrLf out = out & " s = s & QI(orderArg(i))" & vbCrLf out = out & " Next" & vbCrLf out = out & " Else" & vbCrLf out = out & " s = "" ORDER BY "" & QI(orderArg)" & vbCrLf out = out & " End If" & vbCrLf out = out & " BuildOrderBy = s" & vbCrLf out = out & " End Function" & vbCrLf out = out & "End Class" & vbCrLf & vbCrLf out = out & "Dim " & tName & "Repository__Singleton" & vbCrLf out = out & "Function " & tName & "Repository()" & vbCrLf out = out & " If IsEmpty(" & tName & "Repository__Singleton) Then" & vbCrLf out = out & " Set " & tName & "Repository__Singleton = new " & className & vbCrLf out = out & " End If" & vbCrLf out = out & " Set " & tName & "Repository = " & tName & "Repository__Singleton" & vbCrLf out = out & "End Function" & vbCrLf out = out & "%>" & vbCrLf BuildRepository = out End Function '============================================================== ' Helpers (generator side) '============================================================== Function GetAppSetting(key, configFilePath) Dim xml, nodes, node, j, localFso Set localFso = CreateObject("Scripting.FileSystemObject") Set xml = CreateObject("Microsoft.XMLDOM") If Not localFso.FileExists(configFilePath) Then GetAppSetting = "nothing" : Exit Function End If xml.Async = False xml.Load(configFilePath) If xml.ParseError.ErrorCode <> 0 Then GetAppSetting = "nothing" : Exit Function End If Set nodes = xml.selectNodes("//appSettings/add") For j = 0 To nodes.Length - 1 Set node = nodes.Item(j) If node.getAttribute("key") = key Then GetAppSetting = node.getAttribute("value") Exit Function End If Next GetAppSetting = "nothing" End Function Function Nz(val, defaultVal) If IsNull(val) Or IsEmpty(val) Then Nz = defaultVal Else Nz = val End If End Function Sub ArraySortByParallel(keys, arrs) Dim iLocal, jLocal, kLocal, tmpKey, tmp For iLocal = 0 To UBound(keys) - 1 For jLocal = iLocal + 1 To UBound(keys) If keys(jLocal) < keys(iLocal) Then tmpKey = keys(iLocal) : keys(iLocal) = keys(jLocal) : keys(jLocal) = tmpKey For kLocal = 0 To UBound(arrs) tmp = arrs(kLocal)(iLocal) arrs(kLocal)(iLocal) = arrs(kLocal)(jLocal) arrs(kLocal)(jLocal) = tmp Next End If Next Next End Sub Function InArrayInsensitive(a, val) Dim z InArrayInsensitive = False For z = 0 To UBound(a) If StrEqualCI(a(z), val) Then InArrayInsensitive = True : Exit Function Next End Function Function StrEqualCI(a, b) StrEqualCI = (LCase(CStr(a)) = LCase(CStr(b))) End Function Function QI(name) QI = "[" & Replace(CStr(name), "]", "]]") & "]" End Function Function JoinQI(a, sep) Dim j, s : s = "" For j = 0 To UBound(a) If j > 0 Then s = s & sep s = s & QI(a(j)) Next JoinQI = s End Function Function Placeholders(n) Dim j, s : s = "" For j = 1 To n If j > 1 Then s = s & ", " s = s & "?" Next Placeholders = s End Function Function JoinSetters(a) Dim j, s : s = "" For j = 0 To UBound(a) If j > 0 Then s = s & ", " s = s & QI(a(j)) & " = ?" Next JoinSetters = s End Function Function BuildModelParamsArray(modelName, a) Dim j, s : s = "Array(" For j = 0 To UBound(a) If j > 0 Then s = s & ", " s = s & modelName & "." & a(j) Next s = s & ")" BuildModelParamsArray = s End Function Function BuildModelParamsArrayWithPK(modelName, a, pk) Dim j, s : s = "Array(" For j = 0 To UBound(a) If j > 0 Then s = s & ", " s = s & modelName & "." & a(j) Next s = s & ", " & modelName & "." & pk & ")" BuildModelParamsArrayWithPK = s End Function ' Validate identifier (table name, column name, etc.) Function IsValidIdentifier(name) If IsEmpty(name) Or Len(name) = 0 Then IsValidIdentifier = False Exit Function End If Dim i, ch For i = 1 To Len(name) ch = Mid(name, i, 1) ' Allow a-z, A-Z, 0-9, and underscore only If Not ((ch >= "a" And ch <= "z") Or _ (ch >= "A" And ch <= "Z") Or _ (ch >= "0" And ch <= "9") Or _ ch = "_") Then IsValidIdentifier = False Exit Function End If Next IsValidIdentifier = True End Function