|
- '==============================================================
- ' GeneratePOBOAndRepository.vbs
- '
- ' Usage:
- ' cscript //nologo GeneratePOBOAndRepository.vbs /table:Orders /pk:OrderID [/cs:MyConnString] [/config:C:\path\web.config]
- '
- ' Reads connection string from web.config <appSettings>,
- ' discovers [table] schema, and generates:
- ' � POBO_<Table>.asp (Classic ASP class with typed Property Lets)
- ' � <Table>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:<TableName> /pk:<PrimaryKey> [/cs:<ConnStringKey>] [/config:<PathToWebConfig>]"
- 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_<Table>.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 <Table>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
|