浏览代码

Add service areas: businesses can cover multiple areas

- New areas and business_areas tables (migration 20261025120001).
- /areas page to add, rename, merge and delete areas (AreasController,
  AreaRepository), registered in the controller allow-list and nav.
- Business detail: area badges, tick existing areas or add new ones
  (comma-separated) when saving details.
- Businesses list: Area filter (any / none / specific) and a sortable
  Areas column (sorts by each business's first area alphabetically).
- CSV export: Areas column; respects the area filter.
- Area ids inside subqueries are inlined as CLng because Access binds
  ? markers in subqueries ahead of outer ones.
- run_site.cmd: use 64-bit IIS Express to match the installed 64-bit
  ACE provider (fixes "Provider cannot be found", 3706).

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
master
父节点
当前提交
e5b53e9b31
共有 15 个文件被更改,包括 546 次插入 和 19 次删除
  1. +128
    -0
      app/controllers/AreasController.asp
  2. +32
    -4
      app/controllers/BusinessesController.asp
  3. +7
    -3
      app/controllers/ExportController.asp
  4. +2
    -0
      app/controllers/autoload_controllers.asp
  5. +1
    -1
      app/lib/lib.BusinessHelpers.asp
  6. +190
    -0
      app/repositories/AreaRepository.asp
  7. +39
    -7
      app/repositories/BusinessRepository.asp
  8. +86
    -0
      app/views/Areas/index.asp
  9. +14
    -3
      app/views/Businesses/index.asp
  10. +16
    -0
      app/views/Businesses/show.asp
  11. +3
    -0
      app/views/shared/header.asp
  12. +1
    -0
      core/lib.ControllerRegistry.asp
  13. +19
    -0
      db/migrations/20261025120001_create_areas_tables.asp
  14. +7
    -0
      public/Default.asp
  15. +1
    -1
      run_site.cmd

+ 128
- 0
app/controllers/AreasController.asp 查看文件

@@ -0,0 +1,128 @@
<%
Class AreasController_Class
Private m_useLayout
Private m_title

Private Sub Class_Initialize()
m_useLayout = True
m_title = "Areas"
End Sub

Public Property Get useLayout
useLayout = m_useLayout
End Property

Public Property Let useLayout(v)
m_useLayout = v
End Property

Public Property Get Title
Title = m_title
End Property

Public Property Let Title(v)
m_title = v
End Property

'-------------------------------------------------------------------------------------------------------------------
' GET /areas
'-------------------------------------------------------------------------------------------------------------------
Public Sub index()
Dim list, unassigned, csrf
Set list = AreaRepository().All()
unassigned = AreaRepository().UnassignedCount()
csrf = Csrf_Token("areas")
%>
<!--#include file="../views/Areas/index.asp" -->
<%
End Sub

'-------------------------------------------------------------------------------------------------------------------
' POST /areas/create
'-------------------------------------------------------------------------------------------------------------------
Public Sub create()
Dim name
GuardCsrf
name = Left(Trim(F("name")), 100)
If Len(name) = 0 Then Fail "Enter an area name."
If AreaRepository().NameTaken(name, 0) Then Fail """" & name & """ already exists."
AreaRepository().Create name
Flash().Success = "Added """ & name & """."
Response.Redirect "/areas"
End Sub

'-------------------------------------------------------------------------------------------------------------------
' POST /areas/:id/rename
'-------------------------------------------------------------------------------------------------------------------
Public Sub rename(id)
Dim area, name
Set area = Load(id)
name = Left(Trim(F("name")), 100)
If Len(name) = 0 Then Fail "The name can't be blank."
If AreaRepository().NameTaken(name, area("id")) Then
Fail """" & name & """ already exists. Use Merge to combine them."
End If
AreaRepository().Rename area("id"), name
Flash().Success = "Renamed to """ & name & """."
Response.Redirect "/areas"
End Sub

'-------------------------------------------------------------------------------------------------------------------
' POST /areas/:id/merge : move every business from this area into another one, then delete this one
'-------------------------------------------------------------------------------------------------------------------
Public Sub merge(id)
Dim area, target, moved
Set area = Load(id)
If Not Valid_Id(F("target_id")) Then Fail "Choose the area to merge into."
If CLng(F("target_id")) = area("id") Then Fail "Choose a different area to merge into."
Set target = AreaRepository().Find(CLng(F("target_id")))
If target Is Nothing Then Fail "That area no longer exists."
moved = AreaRepository().Merge(area("id"), target("id"))
Flash().Success = "Merged """ & area("name") & """ into """ & target("name") & """ (" & moved & " businesses moved)."
Response.Redirect "/areas"
End Sub

'-------------------------------------------------------------------------------------------------------------------
' POST /areas/:id/delete : only when no business is in it
'-------------------------------------------------------------------------------------------------------------------
Public Sub delete(id)
Dim area
Set area = Load(id)
If area("n") > 0 Then Fail "Can't delete """ & area("name") & """ while " & area("n") & " businesses are in it. Merge it instead."
AreaRepository().Delete area("id")
Flash().Success = "Deleted """ & area("name") & """."
Response.Redirect "/areas"
End Sub

'-------------------------------------------------------------------------------------------------------------------
Private Function Load(id)
GuardCsrf
If Not Valid_Id(id) Then Response.Redirect "/404"
Dim area : Set area = AreaRepository().Find(CLng(id))
If area Is Nothing Then Response.Redirect "/404"
Set Load = area
End Function

Private Sub GuardCsrf()
If Not Csrf_Valid("areas", F("csrf")) Then Fail "Invalid form state. Please try again."
End Sub

Private Sub Fail(msg)
Flash().AddError msg
Response.Redirect "/areas"
End Sub

Private Function F(name)
F = CStr(Request.Form(name))
End Function

End Class

Dim AreasController_Class__Singleton
Function AreasController()
If IsEmpty(AreasController_Class__Singleton) Then
Set AreasController_Class__Singleton = New AreasController_Class
End If
Set AreasController = AreasController_Class__Singleton
End Function
%>

+ 32
- 4
app/controllers/BusinessesController.asp 查看文件

@@ -29,10 +29,10 @@ Class BusinessesController_Class
'-------------------------------------------------------------------------------------------------------------------
Public Sub index()
Const PER_PAGE = 50
Dim f, k, page, pageCount, result, rows, total, industries, sort, dir, firstRow, lastRow
Dim f, k, page, pageCount, result, rows, total, industries, areas, sort, dir, firstRow, lastRow

Set f = CreateObject("Scripting.Dictionary")
For Each k In Array("q", "industry", "status", "show", "contacted", "phone", "sort", "dir")
For Each k In Array("q", "industry", "area", "status", "show", "contacted", "phone", "sort", "dir")
f(k) = Trim(CStr(Request.QueryString(k)))
Next
f("q") = Left(f("q"), 100)
@@ -48,6 +48,7 @@ Class BusinessesController_Class
total = result("total")
Set rows = result("rows")
Set industries = BusinessRepository().Industries()
Set areas = AreaRepository().All()

pageCount = Int((total + PER_PAGE - 1) / PER_PAGE)
If pageCount < 1 Then pageCount = 1
@@ -80,9 +81,21 @@ Class BusinessesController_Class

' Renders the detail page. dup (a matching other business) and fv (unsaved form values) are Nothing normally.
Private Sub RenderShow(id, b, dup, fv)
Dim interactions, industries, csrf, today
Dim interactions, industries, allAreas, bizAreas, areaSel, ai, csrf, today
Set interactions = BusinessRepository().Interactions(CLng(id))
Set industries = BusinessRepository().Industries()
Set allAreas = AreaRepository().All()
Set bizAreas = AreaRepository().ForBusiness(CLng(id))

' Ticked area ids (CStr keys): the saved ones, or the unsaved selection when re-showing the form.
If fv Is Nothing Then
Set areaSel = CreateObject("Scripting.Dictionary")
For ai = 0 To bizAreas.Count - 1
areaSel(CStr(bizAreas(ai)("id"))) = True
Next
Else
Set areaSel = fv("_area_ids")
End If
csrf = Csrf_Token("business")
today = Date_Iso(Date)
m_title = b("name")
@@ -95,7 +108,7 @@ Class BusinessesController_Class
' POST /businesses/:id/update : edit details
'-------------------------------------------------------------------------------------------------------------------
Public Sub update(id)
Dim d, email, phone, indName, indSel
Dim d, email, phone, indName, indSel, areaIds, areaNew, ai, areaId, areaName
GuardPost id

Set d = CreateObject("Scripting.Dictionary")
@@ -129,6 +142,13 @@ Class BusinessesController_Class
indSel = F("industry_id")
If Valid_Id(indSel) Then d("industry_id") = CLng(indSel) Else d("industry_id") = Null

' Areas: the ticked boxes, plus any comma-separated new names (created once the save is going ahead).
Set areaIds = CreateObject("Scripting.Dictionary")
For ai = 1 To Request.Form("area_ids").Count
If Valid_Id(Request.Form("area_ids")(ai)) Then areaIds(CStr(CLng(Request.Form("area_ids")(ai)))) = True
Next
areaNew = Left(Trim(F("area_new")), 500)

' Warn when a changed phone/email is already used by another business (unless "Save anyway" was pressed).
If F("allow_duplicate") <> "1" Then
Dim existing, chkPhone, chkEmail, dupMatch, fv
@@ -144,6 +164,8 @@ Class BusinessesController_Class
fv(k) = d(k)
Next
fv("_industry_new") = indName
fv("_area_new") = areaNew
Set fv("_area_ids") = areaIds
RenderShow id, existing, dupMatch, fv
Exit Sub
End If
@@ -152,7 +174,13 @@ Class BusinessesController_Class
' A typed-in industry wins over the dropdown; it is only created once the save is going ahead.
If Len(indName) > 0 Then d("industry_id") = BusinessRepository().FindOrCreateIndustry(indName)

For Each areaName In Split(areaNew, ",")
areaId = AreaRepository().FindOrCreate(areaName)
If Not IsNull(areaId) Then areaIds(CStr(areaId)) = True
Next

BusinessRepository().Update CLng(id), d
AreaRepository().SetForBusiness CLng(id), areaIds
Flash().Success = "Saved."
Response.Redirect "/businesses/" & id
End Sub


+ 7
- 3
app/controllers/ExportController.asp 查看文件

@@ -28,10 +28,10 @@ Class ExportController_Class
' GET /export/businesses : CSV of everything matching the list's search/filters (opens directly in Excel)
'-------------------------------------------------------------------------------------------------------------------
Public Sub businesses()
Dim f, k, rs, line, n, fileName
Dim f, k, rs, line, n, fileName, areaNames, bizAreas

Set f = CreateObject("Scripting.Dictionary")
For Each k In Array("q", "industry", "status", "show", "contacted", "phone", "sort", "dir")
For Each k In Array("q", "industry", "area", "status", "show", "contacted", "phone", "sort", "dir")
f(k) = Trim(CStr(Request.QueryString(k)))
Next
f("q") = Left(f("q"), 100)
@@ -47,12 +47,16 @@ Class ExportController_Class
Response.AddHeader "Content-Disposition", "attachment; filename=""" & fileName & """"

Response.Write ChrW(&HFEFF) ' UTF-8 BOM so Excel reads accents correctly
Response.Write "Business,Contact,Industry,Phone,Email,Website,Address,City,State,Zip,Status,Customer,Last contacted,Next action" & vbCrLf
Response.Write "Business,Contact,Industry,Areas,Phone,Email,Website,Address,City,State,Zip,Status,Customer,Last contacted,Next action" & vbCrLf

Set areaNames = AreaRepository().NamesByBusiness("")
Set rs = BusinessRepository().ExportRows(f)
n = 0
Do While Not rs.EOF
bizAreas = ""
If areaNames.Exists(CStr(rs("id"))) Then bizAreas = areaNames(CStr(rs("id")))
line = Csv_Cell(rs("name")) & "," & Csv_Cell(rs("contact_name")) & "," & Csv_Cell(rs("industry_name")) & "," & _
Csv_Cell(bizAreas) & "," & _
Csv_Cell(rs("phone")) & "," & Csv_Cell(rs("email")) & "," & Csv_Cell(rs("website")) & "," & _
Csv_Cell(rs("address1")) & "," & Csv_Cell(rs("city")) & "," & Csv_Cell(rs("state")) & "," & _
Csv_Cell(rs("zip")) & "," & Csv_Cell(Businesses_StatusLabel(rs("status"))) & "," & _


+ 2
- 0
app/controllers/autoload_controllers.asp 查看文件

@@ -6,12 +6,14 @@
<!--#include file="../lib/lib.ImportService.asp" -->
<!--#include file="../repositories/BusinessRepository.asp" -->
<!--#include file="../repositories/IndustryRepository.asp" -->
<!--#include file="../repositories/AreaRepository.asp" -->
<!--#include file="../repositories/StatsRepository.asp" -->
<!--#include file="HomeController.asp" -->
<!--#include file="ErrorController.asp" -->
<!--#include file="TodayController.asp" -->
<!--#include file="BusinessesController.asp" -->
<!--#include file="IndustriesController.asp" -->
<!--#include file="AreasController.asp" -->
<!--#include file="ImportController.asp" -->
<!--#include file="ExportController.asp" -->
<!--#include file="DashboardController.asp" -->

+ 1
- 1
app/lib/lib.BusinessHelpers.asp 查看文件

@@ -62,7 +62,7 @@ End Function
Function Businesses_QS(f, page, sort, dir)
Dim k, s
s = ""
For Each k In Array("q", "industry", "status", "show", "contacted", "phone")
For Each k In Array("q", "industry", "area", "status", "show", "contacted", "phone")
If f.Exists(k) Then
If Len(f(k)) > 0 Then s = s & "&" & k & "=" & Server.URLEncode(f(k))
End If


+ 190
- 0
app/repositories/AreaRepository.asp 查看文件

@@ -0,0 +1,190 @@
<%
'=======================================================================================================================
' AREA REPOSITORY
' Areas (cities, regions...) and which businesses cover them. A business can be linked to any number of areas
' through business_areas (business_id, area_id).
'=======================================================================================================================
Class AreaRepository_Class

' All areas with the number of businesses in each: list of Dictionary(id, name, n)
Public Function All()
Dim list, rs, d
Set list = CreateObject("Scripting.Dictionary")
Set rs = Db_Query("SELECT a.id, a.name, COUNT(ba.business_id) AS n FROM areas a LEFT JOIN business_areas ba ON ba.area_id = a.id GROUP BY a.id, a.name ORDER BY a.name", Array())
Do While Not rs.EOF
Set d = CreateObject("Scripting.Dictionary")
d("id") = CLng(rs(0)) : d("name") = rs(1) & "" : d("n") = CLng(rs(2))
list.Add list.Count, d
rs.MoveNext
Loop
rs.Close
Set All = list
End Function

' Businesses not linked to any area.
Public Function UnassignedCount()
Dim rs
Set rs = Db_Query("SELECT COUNT(*) FROM businesses b WHERE NOT EXISTS (SELECT ba.area_id FROM business_areas ba WHERE ba.business_id = b.id)", Array())
UnassignedCount = CLng(rs(0))
rs.Close
End Function

Public Function Find(id)
Dim rs
Set rs = Db_Query("SELECT a.id, a.name, (SELECT COUNT(*) FROM business_areas ba WHERE ba.area_id = a.id) AS n FROM areas a WHERE a.id = ?", Array(Db_PI(id)))
If rs.EOF Then
Set Find = Nothing
Else
Dim d : Set d = CreateObject("Scripting.Dictionary")
d("id") = CLng(rs(0)) : d("name") = rs(1) & "" : d("n") = CLng(rs(2))
Set Find = d
End If
rs.Close
End Function

' True when another area (not excludeId) already has this name (case-insensitive).
Public Function NameTaken(name, excludeId)
Dim rs
Set rs = Db_Query("SELECT COUNT(*) FROM areas WHERE name = ? AND id <> ?", Array(Db_PS(name), Db_PI(excludeId)))
NameTaken = (CLng(rs(0)) > 0)
rs.Close
End Function

Public Sub Create(name)
Db_Exec "INSERT INTO areas (name) VALUES (?)", Array(Db_PS(name))
End Sub

' Returns the area id for a name, creating the area when it does not exist. Null for a blank name.
Public Function FindOrCreate(ByVal name)
Dim rs
name = Left(Trim(name), 100)
If Len(name) = 0 Then
FindOrCreate = Null
Exit Function
End If
Set rs = Db_Query("SELECT id FROM areas WHERE name = ?", Array(Db_PS(name)))
If Not rs.EOF Then
FindOrCreate = CLng(rs(0))
rs.Close
Exit Function
End If
rs.Close
Create name
Set rs = Db_Query("SELECT @@IDENTITY", Array())
FindOrCreate = CLng(rs(0))
rs.Close
End Function

Public Sub Rename(id, name)
Db_Exec "UPDATE areas SET name = ? WHERE id = ?", Array(Db_PS(name), Db_PI(id))
End Sub

' Moves every business from sourceId to targetId (a business already in both keeps one link), then deletes
' sourceId. Returns the number of businesses that were in sourceId.
Public Function Merge(sourceId, targetId)
Dim conn, moved, rs, msg
Set conn = DAL().Connection
Set rs = Db_Query("SELECT COUNT(*) FROM business_areas WHERE area_id = ?", Array(Db_PI(sourceId)))
moved = CLng(rs(0))
rs.Close

conn.BeginTrans
On Error Resume Next
' Ids inlined as CLng: Access binds ? markers inside a subquery ahead of the outer ones.
Db_Exec "DELETE FROM business_areas WHERE area_id = " & CLng(sourceId) & _
" AND business_id IN (SELECT x.business_id FROM business_areas x WHERE x.area_id = " & CLng(targetId) & ")", Array()
If Err.Number = 0 Then Db_Exec "UPDATE business_areas SET area_id = ? WHERE area_id = ?", Array(Db_PI(targetId), Db_PI(sourceId))
If Err.Number = 0 Then Db_Exec "DELETE FROM areas WHERE id = ?", Array(Db_PI(sourceId))
If Err.Number <> 0 Then
msg = Err.Description
Err.Clear
conn.RollbackTrans
On Error GoTo 0
Err.Raise 5, "AreaRepository.Merge", msg
End If
conn.CommitTrans
On Error GoTo 0
Merge = moved
End Function

Public Sub Delete(id)
Db_Exec "DELETE FROM areas WHERE id = ?", Array(Db_PI(id))
End Sub

'---------------------------------------------------------------------------------------------------------------------
' Links to businesses
'---------------------------------------------------------------------------------------------------------------------

' Areas of one business: list of Dictionary(id, name), by name.
Public Function ForBusiness(businessId)
Dim list, rs, d
Set list = CreateObject("Scripting.Dictionary")
Set rs = Db_Query("SELECT a.id, a.name FROM business_areas ba INNER JOIN areas a ON a.id = ba.area_id WHERE ba.business_id = ? ORDER BY a.name", Array(Db_PI(businessId)))
Do While Not rs.EOF
Set d = CreateObject("Scripting.Dictionary")
d("id") = CLng(rs(0)) : d("name") = rs(1) & ""
list.Add list.Count, d
rs.MoveNext
Loop
rs.Close
Set ForBusiness = list
End Function

' Area names for many businesses at once: Dictionary CStr(business id) -> "Name, Name". ids is a comma-separated
' list of numeric ids (callers build it from CLng values) or "" for every business.
Public Function NamesByBusiness(ids)
Dim names, rs, sql, k
Set names = CreateObject("Scripting.Dictionary")
sql = "SELECT ba.business_id, a.name FROM business_areas ba INNER JOIN areas a ON a.id = ba.area_id"
If Len(ids) > 0 Then sql = sql & " WHERE ba.business_id IN (" & ids & ")"
Set rs = Db_Query(sql & " ORDER BY ba.business_id, a.name", Array())
Do While Not rs.EOF
k = CStr(rs(0))
If names.Exists(k) Then names(k) = names(k) & ", " & rs(1) Else names(k) = rs(1) & ""
rs.MoveNext
Loop
rs.Close
Set NamesByBusiness = names
End Function

' Replaces the areas of a business with areaIds (Dictionary whose keys are area ids). Unknown ids are ignored.
Public Sub SetForBusiness(businessId, areaIds)
Dim conn, known, rs, k, msg
Set known = CreateObject("Scripting.Dictionary")
Set rs = Db_Query("SELECT id FROM areas", Array())
Do While Not rs.EOF
known(CStr(rs(0))) = True
rs.MoveNext
Loop
rs.Close

Set conn = DAL().Connection
conn.BeginTrans
On Error Resume Next
Db_Exec "DELETE FROM business_areas WHERE business_id = ?", Array(Db_PI(businessId))
For Each k In areaIds.Keys
If Err.Number <> 0 Then Exit For
If known.Exists(CStr(k)) Then
Db_Exec "INSERT INTO business_areas (business_id, area_id) VALUES (?, ?)", Array(Db_PI(businessId), Db_PI(k))
End If
Next
If Err.Number <> 0 Then
msg = Err.Description
Err.Clear
conn.RollbackTrans
On Error GoTo 0
Err.Raise 5, "AreaRepository.SetForBusiness", msg
End If
conn.CommitTrans
On Error GoTo 0
End Sub
End Class

Dim AreaRepository_Class__Singleton
Function AreaRepository()
If IsEmpty(AreaRepository_Class__Singleton) Then
Set AreaRepository_Class__Singleton = New AreaRepository_Class
End If
Set AreaRepository = AreaRepository_Class__Singleton
End Function
%>

+ 39
- 7
app/repositories/BusinessRepository.asp 查看文件

@@ -7,11 +7,13 @@
' List filters (Scripting.Dictionary, all optional):
' q free text: every whitespace-separated term must match name, contact, email, city or phone
' industry "" = any, "0" = no industry, otherwise an industries.id
' area "" = any, "0" = no area, otherwise an areas.id (businesses linked to that area)
' status "active" (default, hides removed), "all", or new | contacted | follow_up | removed
' show "" = everyone, "prospects", "customers"
' contacted "never" = only businesses with no contact yet
' phone "1" = only businesses with a phone number
' sort name | city | industry | status | last_contacted | next_action | added (default name)
' sort name | city | industry | area | status | last_contacted | next_action | added (default name)
' area sorts by each business's alphabetically first area; businesses with none sort first
' dir asc | desc
'=======================================================================================================================
Class BusinessRepository_Class
@@ -38,8 +40,7 @@ Class BusinessRepository_Class
' Access has no OFFSET: read TOP (skip + perPage) rows and step past the first `skip` of them.
sql = "SELECT TOP " & CLng(skip + perPage) & " b.id, b.name, b.contact_name, b.phone, b.email, b.website, " & _
"b.city, b.state, b.status, b.is_customer, b.last_contacted_at, b.next_action_date, i.name AS industry_name " & _
"FROM businesses b LEFT JOIN industries i ON i.id = b.industry_id " & _
"WHERE " & m_where & " ORDER BY " & OrderByClause(f)
"FROM " & ListFrom() & " WHERE " & m_where & " ORDER BY " & OrderByClause(f)

Set rs = Run(sql)
For i = 1 To skip
@@ -49,6 +50,20 @@ Class BusinessRepository_Class
Set rows = ReadRows(rs)
rs.Close

' Each row gets "areas": its area names, comma-separated.
Dim ids, names, k
ids = ""
For i = 0 To rows.Count - 1
If Len(ids) > 0 Then ids = ids & ","
ids = ids & CLng(rows(i)("id"))
Next
Set names = CreateObject("Scripting.Dictionary")
If Len(ids) > 0 Then Set names = AreaRepository().NamesByBusiness(ids)
For i = 0 To rows.Count - 1
k = CStr(rows(i)("id"))
If names.Exists(k) Then rows(i)("areas") = names(k) Else rows(i)("areas") = ""
Next

Set result = CreateObject("Scripting.Dictionary")
Set result("rows") = rows
result("total") = total
@@ -58,10 +73,9 @@ Class BusinessRepository_Class
' Every business matching the filters (no paging), as a forward-only recordset for streaming to CSV.
Public Function ExportRows(f)
BuildWhere f
Set ExportRows = Run("SELECT b.name, b.contact_name, i.name AS industry_name, b.phone, b.email, b.website, " & _
Set ExportRows = Run("SELECT b.id, b.name, b.contact_name, i.name AS industry_name, b.phone, b.email, b.website, " & _
"b.address1, b.city, b.state, b.zip, b.status, b.is_customer, b.last_contacted_at, b.next_action_date " & _
"FROM businesses b LEFT JOIN industries i ON i.id = b.industry_id " & _
"WHERE " & m_where & " ORDER BY " & OrderByClause(f))
"FROM " & ListFrom() & " WHERE " & m_where & " ORDER BY " & OrderByClause(f))
End Function

' Businesses with a next-contact date on or before throughDate (removed ones excluded), oldest first,
@@ -296,7 +310,7 @@ Class BusinessRepository_Class
End Sub

Private Sub BuildWhere(f)
Dim terms, t, d, q, n, frag, ind, st
Dim terms, t, d, q, n, frag, ind, ar, st
m_where = "1=1"
Set m_params = CreateObject("Scripting.Dictionary")

@@ -331,6 +345,15 @@ Class BusinessRepository_Class
AddParam 3, CLng(ind)
End If

ar = Val_(f, "area")
If ar = "0" Then
m_where = m_where & " AND NOT EXISTS (SELECT ba.area_id FROM business_areas ba WHERE ba.business_id = b.id)"
ElseIf Valid_Id(ar) Then
' Inlined as a validated CLng, not a ? marker: Access binds markers inside a subquery ahead of the outer
' ones, so a parameter here would swap values with the search terms before it.
m_where = m_where & " AND EXISTS (SELECT ba.area_id FROM business_areas ba WHERE ba.business_id = b.id AND ba.area_id = " & CLng(ar) & ")"
End If

st = Val_(f, "status")
Select Case st
Case "all"
@@ -352,11 +375,20 @@ Class BusinessRepository_Class
If Val_(f, "phone") = "1" Then m_where = m_where & " AND b.phone_digits IS NOT NULL"
End Sub

' FROM clause for the list and export: the business, its industry, and fa.first_area (its alphabetically first
' area name) for sorting. Access won't take a subquery in ORDER BY, hence the derived table.
Private Function ListFrom()
ListFrom = "(businesses b LEFT JOIN industries i ON i.id = b.industry_id) " & _
"LEFT JOIN (SELECT ba.business_id, MIN(a.name) AS first_area FROM business_areas ba " & _
"INNER JOIN areas a ON a.id = ba.area_id GROUP BY ba.business_id) AS fa ON fa.business_id = b.id"
End Function

Private Function OrderByClause(f)
Dim col, dirSql
Select Case Val_(f, "sort")
Case "city": col = "b.city"
Case "industry": col = "i.name"
Case "area": col = "fa.first_area"
Case "status": col = "b.status"
Case "last_contacted": col = "b.last_contacted_at"
Case "next_action": col = "b.next_action_date"


+ 86
- 0
app/views/Areas/index.asp 查看文件

@@ -0,0 +1,86 @@
<% Flash().ShowErrorsIfPresent : Flash().ShowSuccessIfPresent %>

<div class="d-flex justify-content-between align-items-center mb-3">
<h1 class="h3 mb-0">Areas</h1>
<span class="text-muted small"><%= list.Count %> areas</span>
</div>

<form method="post" action="/areas/create" class="card shadow-sm mb-3">
<div class="card-body">
<div class="row g-2 align-items-end">
<div class="col-md-6">
<label for="newName" class="form-label small mb-1">Add an area <span class="text-muted">(city, county, region&hellip;)</span></label>
<input type="text" class="form-control form-control-sm" id="newName" name="name" maxlength="100" required />
</div>
<div class="col-md-3">
<input type="hidden" name="csrf" value="<%= H(csrf) %>" />
<button type="submit" class="btn btn-primary btn-sm">Add</button>
</div>
</div>
</div>
</form>

<div class="card shadow-sm mb-3">
<div class="table-responsive">
<table class="table table-sm align-middle mb-0">
<thead class="table-light">
<tr><th style="width:34%">Name</th><th class="text-end" style="width:8%">Businesses</th><th>Rename</th><th>Merge into&hellip;</th><th></th></tr>
</thead>
<tbody>
<% Dim ai, row, oi
For ai = 0 To list.Count - 1
Set row = list(ai)
%>
<tr>
<td class="fw-semibold"><%= H(row("name")) %></td>
<td class="text-end"><a href="/businesses?area=<%= row("id") %>&amp;status=all" class="text-decoration-none"><%= FormatNumber(row("n"), 0) %></a></td>
<td>
<form method="post" action="/areas/<%= row("id") %>/rename" class="d-flex gap-1">
<input type="hidden" name="csrf" value="<%= H(csrf) %>" />
<input type="text" class="form-control form-control-sm" name="name" value="<%= H(row("name")) %>" maxlength="100" aria-label="New name for <%= H(row("name")) %>" />
<button type="submit" class="btn btn-outline-secondary btn-sm">Save</button>
</form>
</td>
<td>
<form method="post" action="/areas/<%= row("id") %>/merge" class="d-flex gap-1 js-confirm" data-confirm="Merge &quot;<%= H(row("name")) %>&quot; into the selected area? This can't be undone.">
<input type="hidden" name="csrf" value="<%= H(csrf) %>" />
<select class="form-select form-select-sm" name="target_id" required aria-label="Merge <%= H(row("name")) %> into">
<option value="">Choose&hellip;</option>
<% For oi = 0 To list.Count - 1
If list(oi)("id") <> row("id") Then %>
<option value="<%= list(oi)("id") %>"><%= H(list(oi)("name")) %></option>
<% End If
Next %>
</select>
<button type="submit" class="btn btn-outline-warning btn-sm">Merge</button>
</form>
</td>
<td class="text-end">
<% If row("n") = 0 Then %>
<form method="post" action="/areas/<%= row("id") %>/delete" class="d-inline js-confirm" data-confirm="Delete &quot;<%= H(row("name")) %>&quot;?">
<input type="hidden" name="csrf" value="<%= H(csrf) %>" />
<button type="submit" class="btn btn-outline-danger btn-sm">Delete</button>
</form>
<% End If %>
</td>
</tr>
<% Next %>
<% If unassigned > 0 Then %>
<tr class="table-light">
<td class="fst-italic text-muted">(No area)</td>
<td class="text-end"><a href="/businesses?area=0&amp;status=all" class="text-decoration-none"><%= FormatNumber(unassigned, 0) %></a></td>
<td colspan="3"></td>
</tr>
<% End If %>
</tbody>
</table>
</div>
</div>

<script>
document.querySelectorAll('form.js-confirm').forEach(function (f) {
f.addEventListener('submit', function (e) {
if (!window.confirm(f.getAttribute('data-confirm'))) e.preventDefault();
});
});
</script>

+ 14
- 3
app/views/Businesses/index.asp 查看文件

@@ -11,7 +11,7 @@
<form method="get" action="/businesses" class="card shadow-sm mb-3">
<div class="card-body">
<div class="row g-2 align-items-end">
<div class="col-lg-4">
<div class="col-lg-3">
<label for="q" class="form-label small mb-1">Search</label>
<input type="text" class="form-control form-control-sm" id="q" name="q" value="<%= H(f("q")) %>" placeholder="Name, contact, email, city or phone" maxlength="100" />
</div>
@@ -25,6 +25,16 @@
<% Next %>
</select>
</div>
<div class="col-6 col-lg-2">
<label for="area" class="form-label small mb-1">Area</label>
<select class="form-select form-select-sm" id="area" name="area">
<option value="">Any</option>
<option value="0"<% If f("area") = "0" Then Response.Write " selected" %>>(No area)</option>
<% Dim ai : For ai = 0 To areas.Count - 1 %>
<option value="<%= areas(ai)("id") %>"<% If f("area") = CStr(areas(ai)("id")) Then Response.Write " selected" %>><%= H(areas(ai)("name")) %></option>
<% Next %>
</select>
</div>
<div class="col-6 col-lg-2">
<label for="status" class="form-label small mb-1">Status</label>
<select class="form-select form-select-sm" id="status" name="status">
@@ -65,7 +75,7 @@
<%
' Sort header helper values (functions cannot be declared in a view, so build the links inline)
Dim cols, ci, colKey, colLabel, nextDir, arrow
cols = Array(Array("name", "Business"), Array("industry", "Industry"), Array("city", "Location"), _
cols = Array(Array("name", "Business"), Array("industry", "Industry"), Array("area", "Areas"), Array("city", "Location"), _
Array("status", "Status"), Array("last_contacted", "Last contacted"), Array("next_action", "Next action"))
%>

@@ -106,6 +116,7 @@ cols = Array(Array("name", "Business"), Array("industry", "Industry"), Array("ci
<% If Len(r("contact_name") & "") > 0 Then %><div class="small text-muted"><%= H(r("contact_name")) %></div><% End If %>
</td>
<td><%= H(r("industry_name")) %></td>
<td class="small"><%= H(r("areas")) %></td>
<td><%= H(r("city")) %><% If Len(r("city") & "") > 0 And Len(r("state") & "") > 0 Then Response.Write ", " %><%= H(r("state")) %></td>
<td><span class="badge <%= Businesses_StatusClass(r("status")) %>"><%= Businesses_StatusLabel(r("status")) %></span></td>
<td class="small"><%= Date_Fmt(r("last_contacted_at")) %></td>
@@ -121,7 +132,7 @@ cols = Array(Array("name", "Business"), Array("industry", "Industry"), Array("ci
</tr>
<% Next %>
<% If rows.Count = 0 Then %>
<tr><td colspan="7" class="text-center text-muted py-4">Nothing to show. Try different filters, or <a href="/import">import a list</a>.</td></tr>
<tr><td colspan="8"class="text-center text-muted py-4">Nothing to show. Try different filters, or <a href="/import">import a list</a>.</td></tr>
<% End If %>
</tbody>
</table>


+ 16
- 0
app/views/Businesses/show.asp 查看文件

@@ -23,6 +23,7 @@ End If
<span class="badge <%= Businesses_StatusClass(b("status")) %>"><%= Businesses_StatusLabel(b("status")) %></span>
<% If isCustomer Then %><span class="badge text-bg-success">Customer</span><% End If %>
<% If Len(b("industry_name") & "") > 0 Then %><span class="badge text-bg-light border"><%= H(b("industry_name")) %></span><% End If %>
<% For ix = 0 To bizAreas.Count - 1 %><a href="/businesses?area=<%= bizAreas(ix)("id") %>" class="badge text-bg-primary bg-opacity-75 text-decoration-none"><i class="bi bi-geo"></i> <%= H(bizAreas(ix)("name")) %></a><% Next %>
</div>

<% If isRemoved Then %>
@@ -199,6 +200,21 @@ End If
<input type="text" class="form-control form-control-sm" id="f_indnew" name="industry_new" maxlength="100" value="<% If fv.Exists("_industry_new") Then Response.Write H(fv("_industry_new")) %>" />
</div>
</div>
<fieldset class="mb-2">
<legend class="form-label small mb-1">Areas served</legend>
<% If allAreas.Count > 0 Then %>
<div class="border rounded px-2 py-1 mb-1" style="max-height:9rem;overflow-y:auto">
<% For ix = 0 To allAreas.Count - 1 %>
<div class="form-check form-check-inline">
<input class="form-check-input" type="checkbox" id="f_area_<%= allAreas(ix)("id") %>" name="area_ids" value="<%= allAreas(ix)("id") %>"<% If areaSel.Exists(CStr(allAreas(ix)("id"))) Then Response.Write " checked" %> />
<label class="form-check-label small" for="f_area_<%= allAreas(ix)("id") %>"><%= H(allAreas(ix)("name")) %></label>
</div>
<% Next %>
</div>
<% End If %>
<label class="visually-hidden" for="f_areanew">Add new areas</label>
<input type="text" class="form-control form-control-sm" id="f_areanew" name="area_new" maxlength="500" placeholder="<% If allAreas.Count > 0 Then Response.Write "&hellip;or add new, comma-separated" Else Response.Write "e.g. Dallas, Fort Worth" %>" value="<% If fv.Exists("_area_new") Then Response.Write H(fv("_area_new")) %>" />
</fieldset>
<div class="row g-2 mb-2 align-items-end">
<div class="col-6">
<div class="form-check">


+ 3
- 0
app/views/shared/header.asp 查看文件

@@ -68,6 +68,9 @@ If Len(pageTitle) = 0 Then pageTitle = "Classic ASP Starter Template"
<li class="nav-item">
<a class="nav-link" href="/industries">Industries</a>
</li>
<li class="nav-item">
<a class="nav-link" href="/areas">Areas</a>
</li>
<li class="nav-item">
<a class="nav-link" href="/dashboard">Dashboard</a>
</li>


+ 1
- 0
core/lib.ControllerRegistry.asp 查看文件

@@ -19,6 +19,7 @@ Class ControllerRegistry_Class
RegisterController "businessescontroller"
RegisterController "todaycontroller"
RegisterController "industriescontroller"
RegisterController "areascontroller"
RegisterController "exportcontroller"
RegisterController "dashboardcontroller"
End Sub


+ 19
- 0
db/migrations/20261025120001_create_areas_tables.asp 查看文件

@@ -0,0 +1,19 @@
<%
'=======================================================================================================================
' MIGRATION: create_areas_tables
' Areas (cities, regions...) a business covers. A business can cover several areas, so the link is its own table.
'=======================================================================================================================

Sub Migration_Up(migration)
migration.CreateTable "areas", "id AUTOINCREMENT PRIMARY KEY, name VARCHAR(100) NOT NULL"
migration.ExecuteSQL "CREATE UNIQUE INDEX uq_areas_name ON areas (name)"
migration.CreateTable "business_areas", "business_id LONG NOT NULL, area_id LONG NOT NULL"
migration.ExecuteSQL "CREATE UNIQUE INDEX uq_business_areas ON business_areas (business_id, area_id)"
migration.CreateIndex "ix_business_areas_area_id", "business_areas", "area_id"
End Sub

Sub Migration_Down(migration)
migration.DropTable "business_areas"
migration.DropTable "areas"
End Sub
%>

+ 7
- 0
public/Default.asp 查看文件

@@ -28,6 +28,13 @@
router.AddRoute "POST", "/industries/:id/merge", "IndustriesController", "Merge"
router.AddRoute "POST", "/industries/:id/delete", "IndustriesController", "Delete"

' Areas (cities / regions a business covers)
router.AddRoute "GET", "/areas", "AreasController", "Index"
router.AddRoute "POST", "/areas/create", "AreasController", "Create"
router.AddRoute "POST", "/areas/:id/rename", "AreasController", "Rename"
router.AddRoute "POST", "/areas/:id/merge", "AreasController", "Merge"
router.AddRoute "POST", "/areas/:id/delete", "AreasController", "Delete"

' Export (CSV download)
router.AddRoute "GET", "/export/businesses", "ExportController", "Businesses"



+ 1
- 1
run_site.cmd 查看文件

@@ -1,4 +1,4 @@
@echo off
setlocal
set "ASPC_STARTER_ROOT=%~dp0"
"C:\Program Files (x86)\IIS Express\iisexpress.exe" /config:"%~dp0applicationhost.config"
"C:\Program Files\IIS Express\iisexpress.exe" /config:"%~dp0applicationhost.config"

正在加载...
取消
保存

Powered by TurnKey Linux.