Business prospecting tool for a 9x12 postcard business: - Import businesses from CSV/XLSX/XLS with column mapping and phone/email de-duplication - Searchable, filterable, sortable business list with CSV export - Business detail: log calls/emails/visits/mailings, follow-up dates, notes, edit, duplicate warning, remove/restore, previous-customer flag - Today follow-up queue (home page), dashboard of counts, industries management - Access (.accdb) database built by migrations; scripts for ADOX database creation and 32-bit migration runs - Core fixes: route parameters are no longer concatenated into executed code (mvc.asp); GetAntiCSRFToken returns the token on first use (lib.HTML.Security.asp) Co-Authored-By: Claude Sonnet 5.5 <noreply@anthropic.com>master
| @@ -0,0 +1,19 @@ | |||||
| /_bmad | |||||
| /_bmad* | |||||
| /.agents | |||||
| /.github | |||||
| # Business data and runtime output: never commit these. | |||||
| # Recreate an empty database with scripts\createDatabase.vbs + scripts\migrate.cmd up | |||||
| /db/*.accdb | |||||
| /db/*.laccdb | |||||
| /db/*.mdb | |||||
| /db/*.ldb | |||||
| /db/backups/ | |||||
| /uploads/ | |||||
| /logs/ | |||||
| # Editor / OS noise | |||||
| Thumbs.db | |||||
| .DS_Store | |||||
| *.bak | |||||
| @@ -0,0 +1,162 @@ | |||||
| # AGENTS.md — Classic ASP / VBScript Application Agent Instructions | |||||
| ## Mission and role | |||||
| You are the lead architect, implementer, reviewer, and debugger for this **Classic ASP (VBScript)** web application. Act as a deeply experienced specialist in Classic ASP, VBScript/VBS, IIS/IIS Express, ISAPI, ADO, SQL Server, Microsoft Access/ACE, COM/ActiveX/WSC, Windows scripting, HTTP, security, and the RouteKit MVC framework. Prefer robust, maintainable, idiomatic Classic ASP over fashionable rewrites. Do not suggest a migration to ASP.NET, PHP, or another stack unless explicitly requested. | |||||
| **Source starter framework:** | |||||
| `https://onefortheroadgit.sytes.net/dcovington/asp-classic-unified-framework` | |||||
| The framework's README describes it as **RouteKit Classic ASP — MVC Starter**. Treat the current checked-out source code and repository documentation as authoritative over assumptions in this document. | |||||
| ## Mandatory first-time project initialization | |||||
| **Only perform this initialization when this application directory has not yet been initialized. Never run these steps over an existing application's code or delete its `.git` history.** Confirm that the target directory is new/empty and that the target is not the framework's source checkout. | |||||
| 1. Clone the starter repository into the intended new application directory. Its documented primary branch is `master`, but verify the default branch rather than assuming it will stay that way. | |||||
| 2. Remove the cloned repository's `.git` directory **from the new application directory only**. This is intentional: the starter is a one-time copy, **not** a Git submodule or linked fork. Do not remove `.gitignore`, source files, or any other application data. If `.git` is a file rather than a directory, inspect it and stop before doing anything destructive. | |||||
| 3. Keep the copied starter application in its **default, working state**: preserve the initial welcome route/page, controller, view, configuration, helper libraries, and project layout. Do not rename or redesign it or add business-specific features without a task requesting that work. | |||||
| 4. Copy/save this `AGENTS.md` into the **root of the new application**. Never let a clone operation overwrite custom local instructions. | |||||
| 5. Confirm that the repo has no remaining Git linkage and that application files, including `public/Default.asp`, are present. | |||||
| 6. Unless the user requests otherwise, **do not automatically run `git init`**. If the user asks for version control, initialize a fresh, independent repository and obtain explicit approval before configuring a remote or pushing. | |||||
| 7. Do not deploy to production or modify an existing IIS site/app pool during initialization. If dependencies or access are missing, report the blocker and provide exact safe manual steps rather than claim setup succeeded. | |||||
| ### Example setup — PowerShell (Windows) | |||||
| Run from the *parent* directory; choose a **new** destination name: | |||||
| ```powershell | |||||
| $AppPath = 'C:\Sites\MyClassicAspApp' # CHANGE to the intended NEW path | |||||
| $RepoUrl = 'https://onefortheroadgit.sytes.net/dcovington/asp-classic-unified-framework.git' | |||||
| if (Test-Path -LiteralPath $AppPath) { | |||||
| throw "Destination already exists. Refusing to overwrite: $AppPath" | |||||
| } | |||||
| git clone $RepoUrl $AppPath | |||||
| if ($LASTEXITCODE -ne 0) { throw 'Clone failed; no cleanup attempted.' } | |||||
| $GitPath = Join-Path $AppPath '.git' | |||||
| if (-not (Test-Path -LiteralPath $GitPath -PathType Container)) { | |||||
| throw 'Expected cloned .git directory not found. Investigate rather than delete anything.' | |||||
| } | |||||
| Remove-Item -LiteralPath $GitPath -Recurse -Force | |||||
| if (-not (Test-Path -LiteralPath (Join-Path $AppPath 'public\Default.asp'))) { | |||||
| throw 'Expected framework entry point missing.' | |||||
| } | |||||
| Write-Host "Independent Classic ASP starter created at $AppPath" | |||||
| ``` | |||||
| This snippet demonstrates safe initialization but does **not** itself write `AGENTS.md` to the new folder. When implementing setup, ensure that this file accompanies the application. | |||||
| ## Read the project before writing code | |||||
| Before making any application changes: | |||||
| - Read `README.md`, `TESTING.md`, and relevant documentation in `docs/`. | |||||
| - Trace the specific code path being changed, including configuration, routing, controller registration, includes, database access, and error handling. | |||||
| - Search for existing utilities and patterns; **reuse them** rather than adding duplicate abstractions. | |||||
| - If documentation contradicts code, identify the discrepancy and follow the verified working behavior, documenting any decision. | |||||
| - Do not claim any test ran, server was configured, or application was deployed unless actually verified. | |||||
| ## Known RouteKit layout and conventions | |||||
| The starter README identifies this structure: | |||||
| ```text | |||||
| public/ | |||||
| Default.asp # IIS front controller; public site root is here | |||||
| web.config # IIS config, rewrite rules, app settings | |||||
| core/ # Framework internals; avoid modifying | |||||
| autoload_core.asp | |||||
| router.wsc | |||||
| mvc.asp | |||||
| lib.*.asp | |||||
| app/ | |||||
| controllers/ | |||||
| views/ | |||||
| shared/ | |||||
| models/ | |||||
| repositories/ | |||||
| db/ | |||||
| migrations/ | |||||
| webdata.accdb | |||||
| scripts/ | |||||
| generateController.vbs | |||||
| generateMigration.vbs | |||||
| GenerateRepo.vbs | |||||
| runMigrations.vbs | |||||
| tests/ # Separate ASPUnit testing harness | |||||
| README.md | |||||
| TESTING.md | |||||
| AGENTS.md # These instructions | |||||
| ``` | |||||
| **IIS site's physical root must normally point to `public/`, not the repository root.** Preserve the framework's routing entry point and startup conventions. Existing default pages include `HomeController` for `/` and `ErrorController` for `/404`. | |||||
| For adding MVC features, follow the actual source and README: generate a migration, POBO/model and repository, and controller when appropriate; place generated files under `app/`; wire controller registrations as required by `core/lib.ControllerRegistry.asp`, `app/controllers/autoload_controllers.asp`, and routes in `public/Default.asp`. Confirm exact APIs before using them; do not invent framework methods. | |||||
| ## Architecture rules | |||||
| 1. **Classic ASP + VBScript first.** Keep request processing server-side in VBScript and compatible with the application's Windows/IIS environment. Client-side JavaScript is fine for browser UI enhancements. | |||||
| 2. **Respect MVC.** Controllers coordinate requests; models represent data; repositories handle persistence; views handle rendering. Avoid SQL and business logic embedded directly in HTML views. | |||||
| 3. **Protect core.** Avoid editing `core/` unless an application-level extension cannot solve the problem. Explain necessary changes and get authorization before changing the framework core. | |||||
| 4. **Small, scoped changes.** Keep diffs focused and preserve existing behavior. Do not refactor unrelated files. | |||||
| 5. **Use established include, registration, session, error, and configuration patterns** instead of inventing a second application architecture. | |||||
| 6. **No undocumented dependencies.** Explain and document any new COM component, DLL, WSC registration, ODBC/OLE DB driver, IIS feature, or external program. | |||||
| 7. Maintain Windows path and file-encoding compatibility. Beware that VBScript and Classic ASP lack many modern language constructs. | |||||
| ## VBScript, Classic ASP, and COM expertise standards | |||||
| - Know `Option Explicit`, `Class`, `Property Get/Let/Set`, `Function`, `Sub`, `ByRef`/`ByVal`, `Set`, `Nothing`, `IsObject`, `IsNull`, `IsEmpty`, `Variant`, `Server.CreateObject`, `CreateObject`, `Scripting.Dictionary`, and `RegExp`. | |||||
| - Understand ASP built-ins: `Request`, `Response`, `Server`, `Session`, `Application`, and their lifetime/thread-safety implications. | |||||
| - Distinguish browser-side JavaScript from server-side VBScript. Do not use .NET/C# syntax or unsupported VBScript features. | |||||
| - Be precise with `On Error Resume Next`: restrict its scope, inspect `Err.Number` and `Err.Description` immediately, and restore normal error handling with `On Error GoTo 0`. | |||||
| - Dispose/release ADO objects, COM instances, file handles, and streams appropriately; close recordsets/connections deterministically. | |||||
| - Use `ADODB.Command` with parameters for database writes and filtered reads; handle database provider differences deliberately. Never concatenate untrusted input into SQL. | |||||
| - Validate and normalize input on the server; encode untrusted output for HTML context (for example `Server.HTMLEncode`) and handle URL/JS contexts correctly. | |||||
| - Account for 32-bit versus 64-bit application pools and COM component bitness, registration, identity, filesystem permissions, and provider availability. | |||||
| - Use `cscript.exe` for WSH-based scripts; do not confuse script host objects with Classic ASP objects. | |||||
| ## Security requirements | |||||
| - Do not store secrets in source control, embed credentials in code, expose connection strings or stack traces to end users, or write sensitive request data into logs. | |||||
| - Apply authentication/authorization checks to every protected route, not just links or views. Follow the existing app's session/auth model where present. | |||||
| - Parameterize SQL, use output encoding, enforce server-side validation, and implement anti-CSRF controls for state-changing forms where appropriate. | |||||
| - Validate uploaded files and paths; prevent traversal, arbitrary file access, open redirects, and unsafe command execution. | |||||
| - Follow least-privilege for application pools and database accounts. Never loosen entire-server settings to fix one application. | |||||
| - When using URL rewriting, preserve expected verbs, path behavior, error handling, and access restrictions. | |||||
| ## Running locally and testing | |||||
| Follow README/TESTING.md as current source of truth. The documented environment requires Windows/IIS, Classic ASP, IIS URL Rewrite, and the Access Database Engine when using the bundled `.accdb` database. | |||||
| - Point the **app site's** root to `public/`; enable only the Classic ASP/IIS features this app needs. | |||||
| - Configure `public/web.config` (including `ConnectionString` and `ErrorLogPath` as needed), keeping environment-specific secrets out of commits. | |||||
| - Verify the default `/` welcome page and expected `/404` behavior. | |||||
| - Use the separate ASPUnit test harness in `tests/`, not exposed inside the production site's `public/` root. Per the starter README, it runs under a separate IIS application rooted at `tests/` and may require Classic ASP parent paths enabled **for that application only**. | |||||
| - If editing `tests/web.config`, follow the framework's `tests/sync-webconfigs.vbs` procedure. | |||||
| - Add tests for meaningful changes and run the relevant tests if the environment supports them. Report exact commands and results, including any tests that could not run. | |||||
| - For database migrations, make backups and understand data loss risks before applying changes. Do not run migrations automatically on production. | |||||
| ## Deployment guardrails | |||||
| The source framework includes an isolated IIS deployment process documented in `docs/deployment-guide.md` and `docs/deployment-configuration.md`. Its repository-specific deployment defaults are **not** automatically appropriate for a new app. **Do not reuse its production site names, IP bindings, paths, application pools, or remote deployment targets without explicit approval.** | |||||
| Use local preflight checks when applicable before deployment. Never overwrite or adopt an existing IIS site/app pool. Make all app/site/pool/path/binding values explicit, verify isolation, and maintain a rollback plan. Production deployment requires user authorization. | |||||
| ## Workflow for every coding task | |||||
| 1. **Inspect:** Read relevant files and document expected behavior and dependencies. | |||||
| 2. **Plan:** State briefly which files and application behaviors will change. For a tiny change, a short plan is sufficient. | |||||
| 3. **Implement:** Make the smallest maintainable, idiomatic Classic ASP/VBScript change. | |||||
| 4. **Verify:** Run syntax/script checks, relevant ASPUnit tests, and IIS/browser checks where available; inspect errors/logs. | |||||
| 5. **Report:** Summarize changes, changed files, verification evidence, limitations, and any manual action required. | |||||
| If unsure of a RouteKit method, inspect its implementation rather than fabricate an API. If blocked by external dependencies or inaccessible servers, give an exact reproducible command and state what remains unverified. | |||||
| ## Definition of done | |||||
| Work is complete only when changes fit RouteKit conventions, do not unexpectedly modify the framework core, preserve the default application until a feature is specifically requested, meet applicable security requirements, and have verified behavior or clearly documented untested gaps. | |||||
| @@ -0,0 +1 @@ | |||||
| @AGENTS.MD | |||||
| @@ -0,0 +1,96 @@ | |||||
| # RouteKit Classic ASP - MVC Starter | |||||
| A clean starting point for building Classic ASP applications with the RouteKit MVC framework. | |||||
| ## Quick Setup | |||||
| 1. Copy this folder to your IIS server | |||||
| 2. Point your IIS site root to the `public/` folder | |||||
| 3. Update `public/web.config`: | |||||
| - Set `ConnectionString` to your database path | |||||
| - Set `ErrorLogPath` if you want file logging | |||||
| 4. Ensure the IIS URL Rewrite module is installed | |||||
| 5. Browse to `http://localhost/` — you should see the welcome page | |||||
| ## Project Structure | |||||
| ``` | |||||
| MVC-Starter/ | |||||
| public/ # IIS ROOT - point your IIS site here | |||||
| Default.asp # Front controller (entry point) | |||||
| web.config # IIS config, routes, connection strings | |||||
| core/ # Framework core (do not modify) | |||||
| autoload_core.asp # Loads all core libraries | |||||
| router.wsc # Route matching engine | |||||
| mvc.asp # MVC dispatcher | |||||
| lib.*.asp # Core libraries | |||||
| app/ | |||||
| controllers/ # Your controllers go here | |||||
| views/ # Your views go here | |||||
| shared/ # Shared layout (header, footer) | |||||
| models/ # POBOs go here | |||||
| repositories/ # Repository classes go here | |||||
| db/ | |||||
| migrations/ # Database migrations | |||||
| webdata.accdb # Access database | |||||
| scripts/ # Code generators | |||||
| generateController.vbs | |||||
| generateMigration.vbs | |||||
| GenerateRepo.vbs | |||||
| runMigrations.vbs | |||||
| ``` | |||||
| ## Adding a New Feature | |||||
| ### 1. Generate a migration | |||||
| ```bash | |||||
| cscript //nologo scripts\generateMigration.vbs create_my_table | |||||
| ``` | |||||
| ### 2. Generate POBO and Repository | |||||
| ```bash | |||||
| cscript //nologo scripts\GenerateRepo.vbs /table:my_table /pk:id | |||||
| ``` | |||||
| Move generated files to `app/models/` and `app/repositories/`. | |||||
| ### 3. Generate a controller | |||||
| ```bash | |||||
| cscript //nologo scripts\generateController.vbs MyController "Index;Show(id);Create;Store" | |||||
| ``` | |||||
| Move generated file to `app/controllers/`. | |||||
| ### 4. Wire it up | |||||
| - Register in `core/lib.ControllerRegistry.asp` | |||||
| - Include in `app/controllers/autoload_controllers.asp` | |||||
| - Add routes in `public/Default.asp` | |||||
| - Create views in `app/views/MyController/` | |||||
| ## Included Controllers | |||||
| - **HomeController** - Welcome page at `/` | |||||
| - **ErrorController** - 404 handler at `/404` | |||||
| ## Requirements | |||||
| - Windows Server with IIS | |||||
| - Classic ASP enabled | |||||
| - IIS URL Rewrite module | |||||
| - Microsoft Access Database Engine (for .accdb support) | |||||
| ## Deployment | |||||
| Production deployment owns an isolated IIS site and app pool; it never targets, adopts, or copies configuration from another site. Defaults are `SiteName=AspClassicUnifiedFramework`, `AppPoolName=AspClassicUnifiedFramework`, `DeployRoot=D:\Deployments\AspClassicUnifiedFramework`, and HTTP binding `100.97.39.23:8085` with an empty host header. Every value is explicitly overridable, while mismatched existing target state fails closed. | |||||
| The complete repository is retained in immutable release directories and IIS serves only each release's `public/` directory. First deployment initializes shared configuration from packaged `public/web.config` unless `-InitialWebConfigPath` is supplied. The target site/app pool is created only after the staged release validates; Classic ASP parent paths are enabled only at that site's location. Failure cleanup is limited to target resources created by the current invocation, or restoration of the prior valid target state. Migrations remain disabled by default. | |||||
| Run `scripts/deploy-iis-git.ps1 -LocalPreflightOnly` for local source/XML/package/safety validation with no network access. When host access is permitted, run `-PreflightOnly` for the complete check: it streams the installer without writing remote files and validates IIS features/modules, binding and shared-pool conflicts, drive/path, names, and target state without requiring the target to exist or making IIS/deployment changes. `-HostPreflightOnly` and `-RemotePreflightOnly` remain aliases. Gitea 1.11.4 has no Gitea Actions, so use a trusted external worker or operator workstation. See [docs/deployment-guide.md](docs/deployment-guide.md) and [docs/deployment-configuration.md](docs/deployment-configuration.md). | |||||
| ## Testing | |||||
| This repo now includes a dev-only `aspunit` harness under `tests/`. It is intentionally separate from the production app rooted at `public/`. | |||||
| - Configure a separate IIS application rooted at `tests/` | |||||
| - Ensure Classic ASP parent paths are enabled for that IIS app | |||||
| - If you change `tests/web.config`, refresh the nested test-folder copies with `cscript //nologo tests\sync-webconfigs.vbs` | |||||
| - Open `run-all.asp` inside that IIS app to execute the test suite | |||||
| - See `TESTING.md` for setup, manifest registration, and extension guidance | |||||
| @@ -0,0 +1,185 @@ | |||||
| # Testing MVC-Starter | |||||
| This project now supports a dev-only Classic ASP test harness built with `aspunit`. | |||||
| ## Scope | |||||
| - Production app: `public/` | |||||
| - Dev-only test app: `tests/` | |||||
| - Test framework: `tests/aspunit/` | |||||
| The `tests/` IIS application assumes the repository layout keeps `tests/`, `public/`, `core/`, and `app/` as sibling directories. | |||||
| ## File Inventory | |||||
| | Type | Path | Purpose | | |||||
| | ---- | ---- | ------- | | |||||
| | Create | `tests/web.config` | IIS/default-document config for the isolated test app | | |||||
| | Create | `tests/unit/web.config` | Mirrored config for nested unit pages that load config-aware code | | |||||
| | Create | `tests/component/web.config` | Mirrored config for nested component pages that load config-aware code | | |||||
| | Create | `tests/integration/web.config` | Mirrored config for nested integration pages that load config-aware code | | |||||
| | Create | `tests/sync-webconfigs.vbs` | Utility script to mirror `tests/web.config` into nested test folders | | |||||
| | Create | `tests/run-tests.cmd` | Windows helper to sync configs and open the test runner URL | | |||||
| | Create | `tests/bootstrap.asp` | Shared test bootstrap and runtime reset helpers | | |||||
| | Create | `tests/PlainRunnerTheme.asp` | Local runner theme that removes CDN dependence from the test UI | | |||||
| | Create | `tests/support/HttpCaptureHelpers.asp` | Shared HTTP capture helpers for rendered-page assertions | | |||||
| | Create | `tests/test-manifest.asp` | Single source of truth for registered test pages | | |||||
| | Create | `tests/run-all.asp` | Browser runner that aggregates all test pages | | |||||
| | Vendor | `tests/aspunit/Lib/*` | Upstream aspunit framework files | | |||||
| | Vendor | `tests/aspunit/LICENSE-MIT` | Upstream aspunit license for vendored third-party code | | |||||
| | Create | `tests/unit/TestHelpers.asp` | Deterministic helper-function unit tests | | |||||
| | Create | `tests/unit/TestControllerRegistry.asp` | Controller whitelist/format unit tests | | |||||
| | Create | `tests/component/TestHomeController.asp` | Controlled component-level controller test | | |||||
| | Create | `tests/integration/TestMvcDispatch.asp` | Narrow router/dispatch smoke test | | |||||
| | Create | `tests/integration/TestRoutes.asp` | Route-helper/config integration coverage | | |||||
| | Create | `tests/integration/TestConfigSettings.asp` | Nested config and fallback behavior coverage | | |||||
| | Create | `tests/integration/TestRenderedOutput.asp` | Production-page output assertions through safe HTTP capture | | |||||
| | Create | `tests/integration/TestSharedLayout.asp` | Shared header/footer/layout assertions against rendered production pages | | |||||
| | Reference | `public/web.config` | Source of mirrored config keys for the test app | | |||||
| | Reference | `core/helpers.asp` | Helper functions and config-loading behavior under test | | |||||
| | Reference | `core/mvc.asp` | Dispatcher behavior used by the smoke test | | |||||
| | Reference | `core/lib.ControllerRegistry.asp` | Whitelist behavior under test | | |||||
| | Verify | `public/` site | Confirm production app exposes no test routes/pages | | |||||
| ## IIS Setup | |||||
| 1. Keep the existing production IIS app rooted at `public/`. | |||||
| 2. Create a separate development-only IIS application rooted at `tests/`. | |||||
| 3. Enable Classic ASP for that IIS app. | |||||
| 4. Ensure parent paths are allowed for the `tests/` app. This repo ships `tests/web.config` with `enableParentPaths="true"` because the bootstrap and integration pages include sibling files from `../core/` and `../app/`. | |||||
| 5. Browse to the `tests/` app root or directly to `run-all.asp`. | |||||
| 6. If you change `tests/web.config`, run `cscript //nologo tests\sync-webconfigs.vbs` to refresh the nested copies used by the unit, component, and integration pages. | |||||
| 7. If your production app is not served from the same host root as the `tests/` app, set `ProductionAppBaseUrl` in `tests/web.config` and re-run the sync script so rendered-output tests know where to send HTTP requests. | |||||
| Example: `http://localhost/` for a root site, or `http://localhost/MyClassicApp/` for a virtual-directory app. | |||||
| 8. To sync configs and open the suite in one step on Windows, run `tests\run-tests.cmd` with an optional runner URL argument. | |||||
| Example layout: | |||||
| - Production: `http://localhost/` | |||||
| - Tests: `http://localhost/tests-dev/` | |||||
| ## How It Works | |||||
| - `tests/run-all.asp` includes the aspunit library and the manifest. | |||||
| - `tests/run-all.asp` also applies `PlainRunnerTheme.asp`, a local runner theme that avoids the upstream CDN dependency in aspunit’s default UI. | |||||
| - `tests/test-manifest.asp` explicitly registers each test page. | |||||
| - `tests/bootstrap.asp` provides the shared runtime setup: | |||||
| - helper/config access | |||||
| - controller registry access | |||||
| - router reset | |||||
| - `tests/support/HttpCaptureHelpers.asp` provides safe HTTP-based page capture for rendered output assertions against the production app. | |||||
| The integration test page includes `core/mvc.asp` directly because that is the only first-wave test that needs dispatcher behavior. | |||||
| Because `GetAppSetting()` uses `Server.MapPath("web.config")`, nested test folders also need a mirrored `web.config` alongside the executing test pages that rely on config-aware runtime files. Use `tests/sync-webconfigs.vbs` after changing `tests/web.config`. | |||||
| The manifest is manual by design. There is no filesystem auto-discovery. | |||||
| ## Running Tests | |||||
| Open the browser runner: | |||||
| Browse to `run-all.asp` within the `tests/` IIS application, for example: | |||||
| ```text | |||||
| http://localhost/tests-dev/run-all.asp | |||||
| ``` | |||||
| aspunit renders a UI in runner mode and loads each registered page with `?task=test` behind the scenes. | |||||
| On Windows you can also use: | |||||
| ```bat | |||||
| tests\run-tests.cmd | |||||
| ``` | |||||
| Or with an explicit runner URL: | |||||
| ```bat | |||||
| tests\run-tests.cmd http://localhost:8085/run-all.asp | |||||
| ``` | |||||
| ## Adding a New Test Page | |||||
| 1. Choose the right folder: | |||||
| - `tests/unit/` for deterministic helper or registry tests | |||||
| - `tests/component/` for direct controller/object tests with controlled setup | |||||
| - `tests/integration/` for narrow runtime smoke coverage, config behavior, or rendered-page capture | |||||
| - shared layout assertions belong here too, because they verify rendered production responses rather than isolated helper behavior | |||||
| 2. Create a new `.asp` file that: | |||||
| - includes `../aspunit/Lib/ASPUnit.asp` | |||||
| - includes `../bootstrap.asp` | |||||
| - registers one or more modules with `ASPUnit.AddModule(...)` | |||||
| - calls `ASPUnit.Run()` | |||||
| 3. Add the page path to `tests/test-manifest.asp`. | |||||
| 4. Reload `run-all.asp`. | |||||
| ## First-Pass Isolation Policy | |||||
| - Unit tests should avoid mutating globals. | |||||
| - Registry tests should inspect current behavior, not expand the production whitelist. | |||||
| - Component tests should reset touched singleton/controller state in setup/teardown. | |||||
| - Dispatch smoke tests should initialize fresh route state before each run. | |||||
| ## What Not To Unit Test | |||||
| - Full rendered page markup for shared-layout pages unless you add reliable output-capture support. | |||||
| - Production IIS rewrite behavior from `public/`. | |||||
| - Broad end-to-end request flows through the production site root. | |||||
| - Config-dependent behavior that requires machine-specific production values unless you first mirror safe test values into `tests/web.config`. | |||||
| - Internet access as a requirement for the runner UI. The local theme removes the upstream CDN dependency for first-wave execution. | |||||
| ## Validation Checklist | |||||
| - `run-all.asp` loads in the separate `tests/` IIS app. | |||||
| - All manifest pages appear in the runner. | |||||
| - Helper, registry, component, and integration suites all execute. | |||||
| - Route-helper/config integration assertions execute from the same isolated IIS app. | |||||
| - Rendered-page capture assertions can verify production HTML and status codes without polluting aspunit JSON responses. | |||||
| - Shared layout assertions can verify navbar, asset links, titles, and footer script presence across production-rendered pages. | |||||
| - Re-running the suite produces stable results. | |||||
| - The production site under `public/` still exposes no test runner pages or test routes. | |||||
| ## Deployment verification gate | |||||
| Before a production release: | |||||
| 1. Run the full ASPUnit suite in the isolated development IIS application. | |||||
| 2. Parse every repository `web.config` as XML. | |||||
| 3. Parse both deployment scripts with the Windows PowerShell parser on a Windows CI worker. | |||||
| 4. From a clean standalone checkout of the approved `master` branch, run the local/controller preflight: | |||||
| ```powershell | |||||
| .\scripts\deploy-iis-git.ps1 -LocalPreflightOnly | |||||
| ``` | |||||
| This validates source provenance, required files, `public/web.config` XML, package creation/extraction, release layout, and package safety without SSH/SCP or host changes. | |||||
| 5. When host connectivity is separately permitted, run the complete read-only preflight (the dedicated target need not exist): | |||||
| ```powershell | |||||
| .\scripts\deploy-iis-git.ps1 -PreflightOnly -RemoteTarget 'webserver-1' | |||||
| ``` | |||||
| It repeats the local/package checks, streams the installer without writing remote files, and validates IIS/Classic ASP and URL Rewrite, binding and shared-pool conflicts, the deployment drive/path, names, and exact existing-target state without changing IIS or the deployment root. | |||||
| 6. For an isolated Windows test deployment, override names/root/port together rather than reusing any existing site: | |||||
| ```powershell | |||||
| .\scripts\deploy-iis-git.ps1 ` | |||||
| -SiteName 'AspClassicUnifiedFramework-Test' ` | |||||
| -AppPoolName 'AspClassicUnifiedFramework-Test' ` | |||||
| -DeployRoot 'D:\Deployments\AspClassicUnifiedFramework-Test' ` | |||||
| -BindingIpAddress '100.97.39.23' ` | |||||
| -BindingPort 8185 ` | |||||
| -RemoteTarget 'webserver-1' | |||||
| ``` | |||||
| 7. Require the installer smoke test. Also induce a smoke-test failure in the isolated test target and verify that only resources created by that invocation are removed, or that an existing valid target's prior path and parent-path value are restored. Verify unrelated sites, pools, and bindings are unchanged. | |||||
| 8. Run production-safe HTTP checks and prove rollback to a prior immutable release. Never expose the `tests/` IIS application in production. | |||||
| Linux can validate XML and repository safety/source assertions, but cannot prove Windows PowerShell 5.1 parsing, WebAdministration behavior, installed IIS features/modules, binding behavior on the live host, elevation, app-pool identity/ACLs, Access/ACE, SSH transport, cleanup under real IIS failures, or live HTTP responses. Those remain Windows/IIS gates. | |||||
| ## Limitations | |||||
| - This harness runs only inside IIS/Classic ASP; it is not intended for Linux execution. | |||||
| - The repo’s production runtime is still configured via `public/web.config`; the test app uses a minimal mirrored config in `tests/web.config`. | |||||
| - If the narrow bootstrap is not sufficient for future smoke tests, broaden only the test bootstrap first before considering production runtime changes. | |||||
| @@ -0,0 +1,242 @@ | |||||
| <% | |||||
| Class BusinessesController_Class | |||||
| Private m_useLayout | |||||
| Private m_title | |||||
| Private Sub Class_Initialize() | |||||
| m_useLayout = True | |||||
| m_title = "Businesses" | |||||
| 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 /businesses : searchable, filterable, sortable, paged list | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub index() | |||||
| Const PER_PAGE = 50 | |||||
| Dim f, k, page, pageCount, result, rows, total, industries, sort, dir, firstRow, lastRow | |||||
| Set f = CreateObject("Scripting.Dictionary") | |||||
| For Each k In Array("q", "industry", "status", "show", "contacted", "phone", "sort", "dir") | |||||
| f(k) = Trim(CStr(Request.QueryString(k))) | |||||
| Next | |||||
| f("q") = Left(f("q"), 100) | |||||
| page = 1 | |||||
| Dim pageText : pageText = CStr(Request.QueryString("page")) | |||||
| If Len(pageText) > 0 And Len(pageText) <= 6 Then | |||||
| If IsNumeric(pageText) Then page = CLng(pageText) | |||||
| End If | |||||
| If page < 1 Then page = 1 | |||||
| Set result = BusinessRepository().Search(f, page, PER_PAGE) | |||||
| total = result("total") | |||||
| Set rows = result("rows") | |||||
| Set industries = BusinessRepository().Industries() | |||||
| pageCount = Int((total + PER_PAGE - 1) / PER_PAGE) | |||||
| If pageCount < 1 Then pageCount = 1 | |||||
| If page > pageCount Then | |||||
| page = pageCount | |||||
| Set result = BusinessRepository().Search(f, page, PER_PAGE) | |||||
| Set rows = result("rows") | |||||
| End If | |||||
| sort = f("sort") : dir = LCase(f("dir")) | |||||
| If dir <> "desc" Then dir = "asc" | |||||
| If total = 0 Then firstRow = 0 Else firstRow = (page - 1) * PER_PAGE + 1 | |||||
| lastRow = firstRow + rows.Count - 1 | |||||
| If total = 0 Then lastRow = 0 | |||||
| %> | |||||
| <!--#include file="../views/Businesses/index.asp" --> | |||||
| <% | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' GET /businesses/:id : detail, history and the "log a touch" form | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub show(id) | |||||
| Dim b | |||||
| If Not Valid_Id(id) Then Response.Redirect "/404" | |||||
| Set b = BusinessRepository().Find(CLng(id)) | |||||
| If b Is Nothing Then Response.Redirect "/404" | |||||
| RenderShow id, b, Nothing, Nothing | |||||
| End Sub | |||||
| ' 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 | |||||
| Set interactions = BusinessRepository().Interactions(CLng(id)) | |||||
| Set industries = BusinessRepository().Industries() | |||||
| csrf = Csrf_Token("business") | |||||
| today = Date_Iso(Date) | |||||
| m_title = b("name") | |||||
| %> | |||||
| <!--#include file="../views/Businesses/show.asp" --> | |||||
| <% | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' POST /businesses/:id/update : edit details | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub update(id) | |||||
| Dim d, email, phone, indName, indSel | |||||
| GuardPost id | |||||
| Set d = CreateObject("Scripting.Dictionary") | |||||
| d("name") = Left(Trim(F("name")), 255) | |||||
| If Len(d("name")) = 0 Then | |||||
| Flash().AddError "Business name is required." | |||||
| Response.Redirect "/businesses/" & id | |||||
| End If | |||||
| email = LCase(Left(Trim(F("email")), 255)) | |||||
| If Len(email) > 0 And InStr(email, "@") = 0 Then | |||||
| Flash().AddError "That email address doesn't look right, so nothing was saved." | |||||
| Response.Redirect "/businesses/" & id | |||||
| End If | |||||
| phone = Left(Trim(F("phone")), 40) | |||||
| d("contact_name") = Left(Trim(F("contact_name")), 150) | |||||
| d("phone") = phone | |||||
| d("phone_digits") = ImportFile_PhoneDigits(phone) | |||||
| d("email") = email | |||||
| d("website") = Left(Trim(F("website")), 255) | |||||
| d("address1") = Left(Trim(F("address1")), 255) | |||||
| d("city") = Left(Trim(F("city")), 100) | |||||
| d("state") = Left(Trim(F("state")), 50) | |||||
| d("zip") = Left(Trim(F("zip")), 20) | |||||
| d("notes") = Left(F("notes"), 10000) | |||||
| If F("is_customer") = "1" Then d("is_customer") = 1 Else d("is_customer") = 0 | |||||
| d("first_order_date") = Date_Parse(F("first_order_date")) | |||||
| indName = Trim(F("industry_new")) | |||||
| indSel = F("industry_id") | |||||
| If Valid_Id(indSel) Then d("industry_id") = CLng(indSel) Else d("industry_id") = Null | |||||
| ' 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 | |||||
| Set existing = BusinessRepository().Find(CLng(id)) | |||||
| chkPhone = "" : chkEmail = "" | |||||
| If d("phone_digits") <> existing("phone_digits") & "" Then chkPhone = d("phone_digits") | |||||
| If d("email") <> existing("email") & "" Then chkEmail = d("email") | |||||
| Set dupMatch = BusinessRepository().FindDuplicate(CLng(id), chkPhone, chkEmail) | |||||
| If Not dupMatch Is Nothing Then | |||||
| Set fv = CreateObject("Scripting.Dictionary") | |||||
| Dim k | |||||
| For Each k In d.Keys | |||||
| fv(k) = d(k) | |||||
| Next | |||||
| fv("_industry_new") = indName | |||||
| RenderShow id, existing, dupMatch, fv | |||||
| Exit Sub | |||||
| End If | |||||
| End If | |||||
| ' 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) | |||||
| BusinessRepository().Update CLng(id), d | |||||
| Flash().Success = "Saved." | |||||
| Response.Redirect "/businesses/" & id | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' POST /businesses/:id/log : record a call / email / visit / mailing | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub log(id) | |||||
| Dim method, outcome, notes, contactedAt, followUp, removing, reason | |||||
| GuardPost id | |||||
| method = F("method") | |||||
| outcome = F("outcome") | |||||
| If Not Businesses_IsKey(Businesses_Methods(), method) Then | |||||
| Flash().AddError "Choose how you contacted them." | |||||
| Response.Redirect "/businesses/" & id | |||||
| End If | |||||
| If Len(outcome) > 0 And Not Businesses_IsKey(Businesses_Outcomes(), outcome) Then outcome = "" | |||||
| contactedAt = Date_Parse(F("contacted_at")) | |||||
| If IsNull(contactedAt) Then contactedAt = Date | |||||
| If contactedAt > Date + 1 Then | |||||
| Flash().AddError "The contact date can't be in the future." | |||||
| Response.Redirect "/businesses/" & id | |||||
| End If | |||||
| followUp = Date_Parse(F("follow_up_date")) | |||||
| notes = Left(F("notes"), 10000) | |||||
| removing = (outcome = "remove") | |||||
| reason = Businesses_Label(Businesses_Outcomes(), outcome) | |||||
| If removing And Len(Trim(notes)) > 0 Then reason = Left(Trim(notes), 255) | |||||
| BusinessRepository().LogInteraction CLng(id), method, outcome, notes, contactedAt, followUp, removing, reason | |||||
| If removing Then | |||||
| Flash().Success = "Logged and removed from the list." | |||||
| ElseIf Not IsNull(followUp) Then | |||||
| Flash().Success = "Logged. Follow-up set for " & Date_Fmt(followUp) & "." | |||||
| Else | |||||
| Flash().Success = "Logged." | |||||
| End If | |||||
| Response.Redirect "/businesses/" & id | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' POST /businesses/:id/remove and /restore | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub remove(id) | |||||
| GuardPost id | |||||
| BusinessRepository().Remove CLng(id), Left(Trim(F("reason")), 255) | |||||
| Flash().Success = "Removed from the list." | |||||
| Response.Redirect "/businesses/" & id | |||||
| End Sub | |||||
| Public Sub restore(id) | |||||
| GuardPost id | |||||
| BusinessRepository().Restore CLng(id) | |||||
| Flash().Success = "Restored." | |||||
| Response.Redirect "/businesses/" & id | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' Shared checks and helpers | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Private Sub GuardPost(id) | |||||
| If Not Valid_Id(id) Then Response.Redirect "/404" | |||||
| If BusinessRepository().Find(CLng(id)) Is Nothing Then Response.Redirect "/404" | |||||
| If Not Csrf_Valid("business", F("csrf")) Then | |||||
| Flash().AddError "Invalid form state. Please try again." | |||||
| Response.Redirect "/businesses/" & id | |||||
| End If | |||||
| End Sub | |||||
| Private Function F(name) | |||||
| F = CStr(Request.Form(name)) | |||||
| End Function | |||||
| End Class | |||||
| Dim BusinessesController_Class__Singleton | |||||
| Function BusinessesController() | |||||
| If IsEmpty(BusinessesController_Class__Singleton) Then | |||||
| Set BusinessesController_Class__Singleton = New BusinessesController_Class | |||||
| End If | |||||
| Set BusinessesController = BusinessesController_Class__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,58 @@ | |||||
| <% | |||||
| Class DashboardController_Class | |||||
| Private m_useLayout | |||||
| Private m_title | |||||
| Private Sub Class_Initialize() | |||||
| m_useLayout = True | |||||
| m_title = "Dashboard" | |||||
| 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 /dashboard : simple counts | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub index() | |||||
| Dim counts, activity, daily, byMethod, byOutcome, industries, imports, maxDaily, i | |||||
| Set counts = StatsRepository().ListCounts() | |||||
| Set activity = StatsRepository().ActivityCounts() | |||||
| Set daily = StatsRepository().DailyActivity(14) | |||||
| Set byMethod = StatsRepository().ActivityBy("method") | |||||
| Set byOutcome = StatsRepository().ActivityBy("outcome") | |||||
| Set industries = StatsRepository().TopIndustries(10) | |||||
| Set imports = StatsRepository().RecentImports(5) | |||||
| maxDaily = 1 | |||||
| For i = 0 To daily.Count - 1 | |||||
| If daily(i)(1) > maxDaily Then maxDaily = daily(i)(1) | |||||
| Next | |||||
| %> | |||||
| <!--#include file="../views/Dashboard/index.asp" --> | |||||
| <% | |||||
| End Sub | |||||
| End Class | |||||
| Dim DashboardController_Class__Singleton | |||||
| Function DashboardController() | |||||
| If IsEmpty(DashboardController_Class__Singleton) Then | |||||
| Set DashboardController_Class__Singleton = New DashboardController_Class | |||||
| End If | |||||
| Set DashboardController = DashboardController_Class__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,37 @@ | |||||
| <% | |||||
| Class ErrorController_Class | |||||
| Private m_useLayout | |||||
| Private Sub Class_Initialize() | |||||
| m_useLayout = True | |||||
| End Sub | |||||
| Public Property Get useLayout | |||||
| useLayout = m_useLayout | |||||
| End Property | |||||
| Public Property Let useLayout(v) | |||||
| m_useLayout = v | |||||
| End Property | |||||
| Public Sub Index() | |||||
| Response.Write "Index called" | |||||
| End Sub | |||||
| Public Sub NotFound() | |||||
| Response.Status = "404 Not Found" | |||||
| %> | |||||
| <!--#include file="../Views/Error/NotFound.asp" --> | |||||
| <% | |||||
| End Sub | |||||
| End Class | |||||
| Dim ErrorController_Class__Singleton | |||||
| Function ErrorController() | |||||
| If IsEmpty(ErrorController_Class__Singleton) Then | |||||
| Set ErrorController_Class__Singleton = New ErrorController_Class | |||||
| End If | |||||
| Set ErrorController = ErrorController_Class__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,83 @@ | |||||
| <% | |||||
| Class ExportController_Class | |||||
| Private m_useLayout | |||||
| Private m_title | |||||
| Private Sub Class_Initialize() | |||||
| m_useLayout = False ' streams a file, not a page | |||||
| m_title = "Export" | |||||
| 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 /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 | |||||
| Set f = CreateObject("Scripting.Dictionary") | |||||
| For Each k In Array("q", "industry", "status", "show", "contacted", "phone", "sort", "dir") | |||||
| f(k) = Trim(CStr(Request.QueryString(k))) | |||||
| Next | |||||
| f("q") = Left(f("q"), 100) | |||||
| Server.ScriptTimeout = 600 | |||||
| fileName = "businesses-" & Year(Date) & Right("0" & Month(Date), 2) & Right("0" & Day(Date), 2) & ".csv" | |||||
| Response.Clear | |||||
| Response.Buffer = True | |||||
| Response.CodePage = 65001 | |||||
| Response.Charset = "utf-8" | |||||
| Response.ContentType = "text/csv" | |||||
| 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 | |||||
| Set rs = BusinessRepository().ExportRows(f) | |||||
| n = 0 | |||||
| Do While Not rs.EOF | |||||
| line = Csv_Cell(rs("name")) & "," & Csv_Cell(rs("contact_name")) & "," & Csv_Cell(rs("industry_name")) & "," & _ | |||||
| 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"))) & "," & _ | |||||
| Csv_Cell(CustomerText(rs("is_customer"))) & "," & Csv_Cell(Date_Fmt(rs("last_contacted_at"))) & "," & _ | |||||
| Csv_Cell(Date_Fmt(rs("next_action_date"))) | |||||
| Response.Write line & vbCrLf | |||||
| n = n + 1 | |||||
| If n Mod 2000 = 0 Then Response.Flush | |||||
| rs.MoveNext | |||||
| Loop | |||||
| rs.Close | |||||
| Response.End | |||||
| End Sub | |||||
| Private Function CustomerText(v) | |||||
| If v & "" = "1" Then CustomerText = "Yes" Else CustomerText = "" | |||||
| End Function | |||||
| End Class | |||||
| Dim ExportController_Class__Singleton | |||||
| Function ExportController() | |||||
| If IsEmpty(ExportController_Class__Singleton) Then | |||||
| Set ExportController_Class__Singleton = New ExportController_Class | |||||
| End If | |||||
| Set ExportController = ExportController_Class__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,42 @@ | |||||
| <% | |||||
| Class HomeController_Class | |||||
| Private m_useLayout | |||||
| Private m_title | |||||
| Private Sub Class_Initialize() | |||||
| m_useLayout = True | |||||
| m_title = "Home" | |||||
| 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 | |||||
| Public Sub index() | |||||
| %> | |||||
| <!--#include file="../views/Home/index.asp" --> | |||||
| <% | |||||
| End Sub | |||||
| End Class | |||||
| Dim HomeController_Class__Singleton | |||||
| Function HomeController() | |||||
| If IsEmpty(HomeController_Class__Singleton) Then | |||||
| Set HomeController_Class__Singleton = New HomeController_Class | |||||
| End If | |||||
| Set HomeController = HomeController_Class__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,174 @@ | |||||
| <% | |||||
| Class ImportController_Class | |||||
| Private m_useLayout | |||||
| Private m_title | |||||
| Private Sub Class_Initialize() | |||||
| m_useLayout = True | |||||
| m_title = "Import" | |||||
| 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 /import : upload form | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub index() | |||||
| Dim csrf : csrf = Csrf_Token("import") | |||||
| %> | |||||
| <!--#include file="../views/Import/index.asp" --> | |||||
| <% | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' POST /import/upload : store the file, show the column-mapping step | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub upload() | |||||
| Dim up, outName, outLocal, ext, token, saved, target, fso, tbl, csrf | |||||
| Dim headers, rows, sampleCount, fields | |||||
| Set fso = CreateObject("Scripting.FileSystemObject") | |||||
| Set up = New FreeASPUpload | |||||
| up.chunkSize = 1048576 | |||||
| up.Upload | |||||
| If Not Csrf_Valid("import", up.Form("csrf")) Then | |||||
| Flash().AddError "Invalid form state. Please try again." | |||||
| Response.Redirect "/import" | |||||
| End If | |||||
| If up.UploadedFiles.Count = 0 Then | |||||
| Flash().AddError "Choose a .csv, .xlsx or .xls file to import." | |||||
| Response.Redirect "/import" | |||||
| End If | |||||
| up.SaveOne ImportFile_UploadDir(), 0, outName, outLocal | |||||
| saved = ImportFile_UploadDir() & "\" & outLocal | |||||
| ext = LCase(Mid(outName, InStrRev(outName, ".") + 1)) | |||||
| If ext <> "csv" And ext <> "xlsx" And ext <> "xls" Then | |||||
| If fso.FileExists(saved) Then fso.DeleteFile saved, True | |||||
| Flash().AddError "Only .csv, .xlsx and .xls files can be imported." | |||||
| Response.Redirect "/import" | |||||
| End If | |||||
| token = ImportFile_NewToken() | |||||
| target = ImportFile_UploadDir() & "\" & token & "." & ext | |||||
| fso.MoveFile saved, target | |||||
| Dim readError : readError = "" | |||||
| On Error Resume Next | |||||
| Set tbl = ImportFile_Read(target, 5) | |||||
| If Err.Number <> 0 Then | |||||
| readError = Err.Description | |||||
| Err.Clear | |||||
| End If | |||||
| On Error GoTo 0 | |||||
| If Len(readError) = 0 Then | |||||
| If UBound(tbl("headers")) < 0 Then readError = "No columns were found in the first row." | |||||
| End If | |||||
| If Len(readError) > 0 Then | |||||
| If fso.FileExists(target) Then fso.DeleteFile target, True | |||||
| Flash().AddError "Could not read " & outName & ": " & readError | |||||
| Response.Redirect "/import" | |||||
| End If | |||||
| fields = ImportFile_Fields() | |||||
| headers = tbl("headers") | |||||
| Set rows = tbl("rows") | |||||
| csrf = Csrf_Token("import") | |||||
| Dim originalName : originalName = outName | |||||
| %> | |||||
| <!--#include file="../views/Import/map.asp" --> | |||||
| <% | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' POST /import/run : import every row using the chosen column mapping | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub run() | |||||
| Dim token, path, fso, tbl, colOf, i, fieldKey, ncols, fields, res | |||||
| Dim defaultIndustry, markCustomers, originalName | |||||
| If Not Csrf_Valid("import", CStr(Request.Form("csrf"))) Then | |||||
| Flash().AddError "Invalid form state. Please try again." | |||||
| Response.Redirect "/import" | |||||
| End If | |||||
| token = CStr(Request.Form("token")) | |||||
| path = ImportFile_PathForToken(token) | |||||
| If Len(path) = 0 Then | |||||
| Flash().AddError "The uploaded file is no longer available. Please upload it again." | |||||
| Response.Redirect "/import" | |||||
| End If | |||||
| Set colOf = CreateObject("Scripting.Dictionary") | |||||
| ncols = 0 | |||||
| If IsNumeric(CStr(Request.Form("ncols"))) Then ncols = CLng(CStr(Request.Form("ncols"))) | |||||
| For i = 0 To ncols - 1 | |||||
| fieldKey = CStr(Request.Form("map_" & i)) | |||||
| If Len(fieldKey) > 0 Then | |||||
| If Not colOf.Exists(fieldKey) Then colOf.Add fieldKey, i | |||||
| End If | |||||
| Next | |||||
| ' Only accept known field keys | |||||
| Dim valid, f, known | |||||
| fields = ImportFile_Fields() | |||||
| For Each fieldKey In colOf.Keys | |||||
| known = False | |||||
| For Each f In fields | |||||
| If f(0) = fieldKey Then known = True | |||||
| Next | |||||
| If Not known Then colOf.Remove fieldKey | |||||
| Next | |||||
| If Not colOf.Exists("name") Then | |||||
| Flash().AddError "Map one column to ""Business name"" before importing." | |||||
| Response.Redirect "/import" | |||||
| End If | |||||
| defaultIndustry = Left(Trim(CStr(Request.Form("default_industry"))), 100) | |||||
| markCustomers = (CStr(Request.Form("mark_customers")) = "1") | |||||
| originalName = Left(CStr(Request.Form("original_name")), 255) | |||||
| Server.ScriptTimeout = 1800 | |||||
| Set fso = CreateObject("Scripting.FileSystemObject") | |||||
| Set tbl = ImportFile_Read(path, 0) | |||||
| Set res = ImportService_Run(tbl, colOf, defaultIndustry, markCustomers, originalName) | |||||
| If Not res("failed") Then | |||||
| fso.DeleteFile path, True | |||||
| HTMLSecurity().ClearAntiCSRFToken "import" | |||||
| End If | |||||
| %> | |||||
| <!--#include file="../views/Import/result.asp" --> | |||||
| <% | |||||
| End Sub | |||||
| End Class | |||||
| Dim ImportController_Class__Singleton | |||||
| Function ImportController() | |||||
| If IsEmpty(ImportController_Class__Singleton) Then | |||||
| Set ImportController_Class__Singleton = New ImportController_Class | |||||
| End If | |||||
| Set ImportController = ImportController_Class__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,128 @@ | |||||
| <% | |||||
| Class IndustriesController_Class | |||||
| Private m_useLayout | |||||
| Private m_title | |||||
| Private Sub Class_Initialize() | |||||
| m_useLayout = True | |||||
| m_title = "Industries" | |||||
| 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 /industries | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub index() | |||||
| Dim list, uncategorized, csrf | |||||
| Set list = IndustryRepository().All() | |||||
| uncategorized = IndustryRepository().UncategorizedCount() | |||||
| csrf = Csrf_Token("industries") | |||||
| %> | |||||
| <!--#include file="../views/Industries/index.asp" --> | |||||
| <% | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' POST /industries/create | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub create() | |||||
| Dim name | |||||
| GuardCsrf | |||||
| name = Left(Trim(F("name")), 100) | |||||
| If Len(name) = 0 Then Fail "Enter an industry name." | |||||
| If IndustryRepository().NameTaken(name, 0) Then Fail """" & name & """ already exists." | |||||
| IndustryRepository().Create name | |||||
| Flash().Success = "Added """ & name & """." | |||||
| Response.Redirect "/industries" | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' POST /industries/:id/rename | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub rename(id) | |||||
| Dim ind, name | |||||
| Set ind = Load(id) | |||||
| name = Left(Trim(F("name")), 100) | |||||
| If Len(name) = 0 Then Fail "The name can't be blank." | |||||
| If IndustryRepository().NameTaken(name, ind("id")) Then | |||||
| Fail """" & name & """ already exists. Use Merge to combine them." | |||||
| End If | |||||
| IndustryRepository().Rename ind("id"), name | |||||
| Flash().Success = "Renamed to """ & name & """." | |||||
| Response.Redirect "/industries" | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' POST /industries/:id/merge : move everything from this industry into another one, then delete this one | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub merge(id) | |||||
| Dim ind, target, moved | |||||
| Set ind = Load(id) | |||||
| If Not Valid_Id(F("target_id")) Then Fail "Choose the industry to merge into." | |||||
| If CLng(F("target_id")) = ind("id") Then Fail "Choose a different industry to merge into." | |||||
| Set target = IndustryRepository().Find(CLng(F("target_id"))) | |||||
| If target Is Nothing Then Fail "That industry no longer exists." | |||||
| moved = IndustryRepository().Merge(ind("id"), target("id")) | |||||
| Flash().Success = "Merged """ & ind("name") & """ into """ & target("name") & """ (" & moved & " businesses moved)." | |||||
| Response.Redirect "/industries" | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' POST /industries/:id/delete : only when no business uses it | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub delete(id) | |||||
| Dim ind | |||||
| Set ind = Load(id) | |||||
| If ind("n") > 0 Then Fail "Can't delete """ & ind("name") & """ while " & ind("n") & " businesses use it. Merge it instead." | |||||
| IndustryRepository().Delete ind("id") | |||||
| Flash().Success = "Deleted """ & ind("name") & """." | |||||
| Response.Redirect "/industries" | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Private Function Load(id) | |||||
| GuardCsrf | |||||
| If Not Valid_Id(id) Then Response.Redirect "/404" | |||||
| Dim ind : Set ind = IndustryRepository().Find(CLng(id)) | |||||
| If ind Is Nothing Then Response.Redirect "/404" | |||||
| Set Load = ind | |||||
| End Function | |||||
| Private Sub GuardCsrf() | |||||
| If Not Csrf_Valid("industries", F("csrf")) Then Fail "Invalid form state. Please try again." | |||||
| End Sub | |||||
| Private Sub Fail(msg) | |||||
| Flash().AddError msg | |||||
| Response.Redirect "/industries" | |||||
| End Sub | |||||
| Private Function F(name) | |||||
| F = CStr(Request.Form(name)) | |||||
| End Function | |||||
| End Class | |||||
| Dim IndustriesController_Class__Singleton | |||||
| Function IndustriesController() | |||||
| If IsEmpty(IndustriesController_Class__Singleton) Then | |||||
| Set IndustriesController_Class__Singleton = New IndustriesController_Class | |||||
| End If | |||||
| Set IndustriesController = IndustriesController_Class__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,64 @@ | |||||
| <% | |||||
| Class TodayController_Class | |||||
| Private m_useLayout | |||||
| Private m_title | |||||
| Private Sub Class_Initialize() | |||||
| m_useLayout = True | |||||
| m_title = "Today" | |||||
| 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 /today : follow-ups that are overdue, due today, and coming up this week | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub index() | |||||
| Const LOOKAHEAD_DAYS = 7 | |||||
| Dim all, i, r, nextDate, overdue, dueToday, upcoming | |||||
| Set all = BusinessRepository().DueThrough(Date + LOOKAHEAD_DAYS) | |||||
| Set overdue = CreateObject("Scripting.Dictionary") | |||||
| Set dueToday = CreateObject("Scripting.Dictionary") | |||||
| Set upcoming = CreateObject("Scripting.Dictionary") | |||||
| For i = 0 To all.Count - 1 | |||||
| Set r = all(i) | |||||
| nextDate = CDate(r("next_action_date")) | |||||
| If nextDate < Date Then | |||||
| overdue.Add overdue.Count, r | |||||
| ElseIf nextDate = Date Then | |||||
| dueToday.Add dueToday.Count, r | |||||
| Else | |||||
| upcoming.Add upcoming.Count, r | |||||
| End If | |||||
| Next | |||||
| %> | |||||
| <!--#include file="../views/Today/index.asp" --> | |||||
| <% | |||||
| End Sub | |||||
| End Class | |||||
| Dim TodayController_Class__Singleton | |||||
| Function TodayController() | |||||
| If IsEmpty(TodayController_Class__Singleton) Then | |||||
| Set TodayController_Class__Singleton = New TodayController_Class | |||||
| End If | |||||
| Set TodayController = TodayController_Class__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,17 @@ | |||||
| <!--#include file="../lib/lib.Format.asp" --> | |||||
| <!--#include file="../lib/lib.Csrf.asp" --> | |||||
| <!--#include file="../lib/lib.Db.asp" --> | |||||
| <!--#include file="../lib/lib.BusinessHelpers.asp" --> | |||||
| <!--#include file="../lib/lib.ImportFile.asp" --> | |||||
| <!--#include file="../lib/lib.ImportService.asp" --> | |||||
| <!--#include file="../repositories/BusinessRepository.asp" --> | |||||
| <!--#include file="../repositories/IndustryRepository.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="ImportController.asp" --> | |||||
| <!--#include file="ExportController.asp" --> | |||||
| <!--#include file="DashboardController.asp" --> | |||||
| @@ -0,0 +1,75 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' BUSINESS HELPERS: domain vocabulary (touch methods, outcomes, statuses) and list query-string building | |||||
| '======================================================================================================================= | |||||
| ' Touch methods and outcomes: Array(key, label) | |||||
| Function Businesses_Methods() | |||||
| Businesses_Methods = Array(Array("call", "Call"), Array("email", "Email"), Array("visit", "Visit"), Array("mail", "Mailed")) | |||||
| End Function | |||||
| Function Businesses_Outcomes() | |||||
| Businesses_Outcomes = Array( _ | |||||
| Array("no_answer", "No answer"), _ | |||||
| Array("left_voicemail", "Left voicemail"), _ | |||||
| Array("spoke_with_someone", "Spoke with someone"), _ | |||||
| Array("interested", "Interested"), _ | |||||
| Array("follow_up_later", "Follow up later"), _ | |||||
| Array("not_interested", "Not interested"), _ | |||||
| Array("wrong_number", "Wrong number"), _ | |||||
| Array("remove", "Remove from list") _ | |||||
| ) | |||||
| End Function | |||||
| ' Label for a key in one of the Array(key, label) lists above (the key itself when unknown). | |||||
| Function Businesses_Label(list, key) | |||||
| Dim item | |||||
| Businesses_Label = key & "" | |||||
| For Each item In list | |||||
| If item(0) = key Then Businesses_Label = item(1) | |||||
| Next | |||||
| End Function | |||||
| Function Businesses_IsKey(list, key) | |||||
| Dim item | |||||
| Businesses_IsKey = False | |||||
| For Each item In list | |||||
| If item(0) = key Then Businesses_IsKey = True | |||||
| Next | |||||
| End Function | |||||
| Function Businesses_StatusLabel(s) | |||||
| Select Case s | |||||
| Case "new": Businesses_StatusLabel = "New" | |||||
| Case "contacted": Businesses_StatusLabel = "Contacted" | |||||
| Case "follow_up": Businesses_StatusLabel = "Follow-up" | |||||
| Case "removed": Businesses_StatusLabel = "Removed" | |||||
| Case Else: Businesses_StatusLabel = s & "" | |||||
| End Select | |||||
| End Function | |||||
| Function Businesses_StatusClass(s) | |||||
| Select Case s | |||||
| Case "new": Businesses_StatusClass = "text-bg-secondary" | |||||
| Case "contacted": Businesses_StatusClass = "text-bg-info" | |||||
| Case "follow_up": Businesses_StatusClass = "text-bg-warning" | |||||
| Case "removed": Businesses_StatusClass = "text-bg-dark" | |||||
| Case Else: Businesses_StatusClass = "text-bg-light" | |||||
| End Select | |||||
| End Function | |||||
| ' Query string for the list: current filters with optional page / sort overrides. | |||||
| Function Businesses_QS(f, page, sort, dir) | |||||
| Dim k, s | |||||
| s = "" | |||||
| For Each k In Array("q", "industry", "status", "show", "contacted", "phone") | |||||
| If f.Exists(k) Then | |||||
| If Len(f(k)) > 0 Then s = s & "&" & k & "=" & Server.URLEncode(f(k)) | |||||
| End If | |||||
| Next | |||||
| If Len(sort) > 0 Then s = s & "&sort=" & Server.URLEncode(sort) | |||||
| If Len(dir) > 0 Then s = s & "&dir=" & Server.URLEncode(dir) | |||||
| If page > 1 Then s = s & "&page=" & page | |||||
| If Len(s) > 0 Then Businesses_QS = "?" & Mid(s, 2) Else Businesses_QS = "" | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,13 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' CSRF helpers: thin wrappers over the core HTMLSecurity token (one token per form family name, stored in the session) | |||||
| '======================================================================================================================= | |||||
| Function Csrf_Token(name) | |||||
| Csrf_Token = HTMLSecurity().GetAntiCSRFToken(name) | |||||
| End Function | |||||
| ' True only for a non-empty token that matches the session's token for this form family. | |||||
| Function Csrf_Valid(name, token) | |||||
| Csrf_Valid = (Len(token) > 0 And HTMLSecurity().IsValidAntiCSRFToken(name, token)) | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,67 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' DB HELPERS | |||||
| ' Parameterized query/execute on the shared DAL connection. Parameters are built with the typed helpers below: | |||||
| ' Db_Query "SELECT ... WHERE id = ?", Array(Db_PI(5)) | |||||
| '======================================================================================================================= | |||||
| Function Db_PS(v) | |||||
| If IsNull(v) Then | |||||
| Db_PS = Array(202, Null) | |||||
| ElseIf Len(v & "") = 0 Then | |||||
| Db_PS = Array(202, Null) | |||||
| Else | |||||
| Db_PS = Array(202, CStr(v)) | |||||
| End If | |||||
| End Function | |||||
| Function Db_PI(v) | |||||
| If IsNull(v) Or IsEmpty(v) Then | |||||
| Db_PI = Array(3, Null) | |||||
| ElseIf IsNumeric(v) Then | |||||
| Db_PI = Array(3, CLng(v)) | |||||
| Else | |||||
| Db_PI = Array(3, Null) | |||||
| End If | |||||
| End Function | |||||
| Function Db_PD(v) | |||||
| If IsNull(v) Or IsEmpty(v) Then | |||||
| Db_PD = Array(7, Null) | |||||
| ElseIf IsDate(v) Then | |||||
| Db_PD = Array(7, CDate(v)) | |||||
| Else | |||||
| Db_PD = Array(7, Null) | |||||
| End If | |||||
| End Function | |||||
| Function Db_Command(sql, params) | |||||
| Dim cmd, i, p | |||||
| Set cmd = Server.CreateObject("ADODB.Command") | |||||
| Set cmd.ActiveConnection = DAL().Connection | |||||
| cmd.CommandType = 1 | |||||
| cmd.CommandText = sql | |||||
| For i = 0 To UBound(params) | |||||
| p = params(i) | |||||
| If p(0) = 202 Then | |||||
| If IsNull(p(1)) Then | |||||
| cmd.Parameters.Append cmd.CreateParameter(, 202, 1, 1, Null) | |||||
| ElseIf Len(p(1)) > 255 Then | |||||
| cmd.Parameters.Append cmd.CreateParameter(, 203, 1, Len(p(1)), p(1)) | |||||
| Else | |||||
| cmd.Parameters.Append cmd.CreateParameter(, 202, 1, Len(p(1)), p(1)) | |||||
| End If | |||||
| Else | |||||
| cmd.Parameters.Append cmd.CreateParameter(, p(0), 1, , p(1)) | |||||
| End If | |||||
| Next | |||||
| Set Db_Command = cmd | |||||
| End Function | |||||
| Function Db_Query(sql, params) | |||||
| Set Db_Query = Db_Command(sql, params).Execute | |||||
| End Function | |||||
| Sub Db_Exec(sql, params) | |||||
| Db_Command(sql, params).Execute , , 128 | |||||
| End Sub | |||||
| %> | |||||
| @@ -0,0 +1,83 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' FORMAT / PARSE HELPERS (generic, not tied to a table) | |||||
| '======================================================================================================================= | |||||
| ' VBScript has no IIf; this evaluates both branches, so only use it with plain values. | |||||
| Function Iif_(cond, whenTrue, whenFalse) | |||||
| If cond Then Iif_ = whenTrue Else Iif_ = whenFalse | |||||
| End Function | |||||
| ' True for a plain positive integer id (1-9 digits); use before trusting a route/form id. | |||||
| Function Valid_Id(s) | |||||
| Dim re : Set re = New RegExp | |||||
| re.Pattern = "^[0-9]{1,9}$" | |||||
| Valid_Id = re.Test(s & "") | |||||
| End Function | |||||
| ' Date -> "mm/dd/yyyy" for display ("" for null / invalid). | |||||
| Function Date_Fmt(d) | |||||
| If IsNull(d) Or IsEmpty(d) Then | |||||
| Date_Fmt = "" | |||||
| ElseIf IsDate(d) Then | |||||
| Date_Fmt = Right("0" & Month(d), 2) & "/" & Right("0" & Day(d), 2) & "/" & Year(d) | |||||
| Else | |||||
| Date_Fmt = "" | |||||
| End If | |||||
| End Function | |||||
| ' Date -> "yyyy-mm-dd" for HTML date inputs. | |||||
| Function Date_Iso(d) | |||||
| If IsNull(d) Or IsEmpty(d) Then | |||||
| Date_Iso = "" | |||||
| ElseIf IsDate(d) Then | |||||
| Date_Iso = Year(d) & "-" & Right("0" & Month(d), 2) & "-" & Right("0" & Day(d), 2) | |||||
| Else | |||||
| Date_Iso = "" | |||||
| End If | |||||
| End Function | |||||
| ' "yyyy-mm-dd" (HTML date input) -> Date, or Null when blank/invalid. | |||||
| Function Date_Parse(s) | |||||
| Dim re, m, y, mo, d | |||||
| Date_Parse = Null | |||||
| Set re = New RegExp | |||||
| re.Pattern = "^(\d{4})-(\d{2})-(\d{2})$" | |||||
| If Not re.Test(s & "") Then Exit Function | |||||
| Set m = re.Execute(s)(0) | |||||
| y = CInt(m.SubMatches(0)) : mo = CInt(m.SubMatches(1)) : d = CInt(m.SubMatches(2)) | |||||
| If y < 2000 Or y > 2100 Or mo < 1 Or mo > 12 Or d < 1 Or d > 31 Then Exit Function | |||||
| If Month(DateSerial(y, mo, d)) <> mo Then Exit Function | |||||
| Date_Parse = DateSerial(y, mo, d) | |||||
| End Function | |||||
| ' HTML-encodes text and turns line breaks into <br>. | |||||
| Function Html_Nl2Br(s) | |||||
| Html_Nl2Br = Replace(Replace(Replace(Server.HTMLEncode(s & ""), vbCrLf, "<br>"), vbLf, "<br>"), vbCr, "<br>") | |||||
| End Function | |||||
| ' Quotes a value for CSV. Values that a spreadsheet would treat as a formula are prefixed with an apostrophe | |||||
| ' (CSV injection), except ordinary phone numbers like +1 (555) 123-4567. | |||||
| Function Csv_Cell(v) | |||||
| Dim s, first, re | |||||
| If IsNull(v) Or IsEmpty(v) Then | |||||
| Csv_Cell = "" | |||||
| Exit Function | |||||
| End If | |||||
| s = CStr(v) | |||||
| If Len(s) > 0 Then | |||||
| first = Left(s, 1) | |||||
| If first = "=" Or first = "@" Or first = vbTab Or first = vbCr Then | |||||
| s = "'" & s | |||||
| ElseIf first = "+" Or first = "-" Then | |||||
| Set re = New RegExp | |||||
| re.Pattern = "^[+\-][0-9 ().\-]*$" | |||||
| If Not re.Test(s) Then s = "'" & s | |||||
| End If | |||||
| End If | |||||
| If InStr(s, ",") > 0 Or InStr(s, """") > 0 Or InStr(s, vbCr) > 0 Or InStr(s, vbLf) > 0 Or Left(s, 1) = " " Or Right(s, 1) = " " Then | |||||
| s = """" & Replace(s, """", """""") & """" | |||||
| End If | |||||
| Csv_Cell = s | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,304 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' IMPORT FILE HELPERS | |||||
| ' Reads CSV / XLSX / XLS uploads into a header array + rows dictionary, and normalizes values for the businesses table. | |||||
| ' | |||||
| ' ImportFile_Read(path, maxRows) returns a Scripting.Dictionary: | |||||
| ' "headers" -> Array of column names | |||||
| ' "rows" -> Scripting.Dictionary (0-based index -> Array of string values), at most maxRows rows (0 = all) | |||||
| '======================================================================================================================= | |||||
| Function ImportFile_UploadDir() | |||||
| Dim fso : Set fso = CreateObject("Scripting.FileSystemObject") | |||||
| Dim dir : dir = fso.GetAbsolutePathName(Server.MapPath("/") & "\..\uploads") | |||||
| If Not fso.FolderExists(dir) Then fso.CreateFolder dir | |||||
| ImportFile_UploadDir = dir | |||||
| End Function | |||||
| ' Returns the full path of the stored upload for a token, or "" when the token is malformed or the file is missing. | |||||
| Function ImportFile_PathForToken(token) | |||||
| Dim re : Set re = New RegExp | |||||
| re.Pattern = "^[0-9A-Fa-f]{32}$" | |||||
| ImportFile_PathForToken = "" | |||||
| If Not re.Test(token) Then Exit Function | |||||
| Dim fso, ext, p | |||||
| Set fso = CreateObject("Scripting.FileSystemObject") | |||||
| For Each ext In Array("csv", "xlsx", "xls") | |||||
| p = ImportFile_UploadDir() & "\" & token & "." & ext | |||||
| If fso.FileExists(p) Then | |||||
| ImportFile_PathForToken = p | |||||
| Exit Function | |||||
| End If | |||||
| Next | |||||
| End Function | |||||
| Function ImportFile_NewToken() | |||||
| Dim tl : Set tl = CreateObject("Scriptlet.TypeLib") | |||||
| ImportFile_NewToken = Replace(Replace(Replace(Left(CStr(tl.Guid), 38), "{", ""), "}", ""), "-", "") | |||||
| Set tl = Nothing | |||||
| End Function | |||||
| Function ImportFile_Read(path, maxRows) | |||||
| Dim ext : ext = LCase(Mid(path, InStrRev(path, ".") + 1)) | |||||
| If ext = "csv" Then | |||||
| Set ImportFile_Read = ImportFile_ReadCsv(path, maxRows) | |||||
| Else | |||||
| Set ImportFile_Read = ImportFile_ReadExcel(path, ext, maxRows) | |||||
| End If | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' CSV | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Function ImportFile_ReadCsv(path, maxRows) | |||||
| Dim stm, text | |||||
| Set stm = Server.CreateObject("ADODB.Stream") | |||||
| stm.Type = 2 | |||||
| stm.Charset = "utf-8" | |||||
| stm.Open | |||||
| stm.LoadFromFile path | |||||
| text = stm.ReadText | |||||
| stm.Close | |||||
| ' Not valid UTF-8 (replacement character present): re-read as Windows-1252, which is what Excel "CSV" exports use. | |||||
| If InStr(text, ChrW(65533)) > 0 Then | |||||
| stm.Charset = "windows-1252" | |||||
| stm.Open | |||||
| stm.LoadFromFile path | |||||
| text = stm.ReadText | |||||
| stm.Close | |||||
| End If | |||||
| Set stm = Nothing | |||||
| text = Replace(text, vbCrLf, vbLf) | |||||
| text = Replace(text, vbCr, vbLf) | |||||
| ' Pick the delimiter that appears most in the first line. | |||||
| Dim firstLine, delim, best, cand, c | |||||
| firstLine = Left(text, InStr(text & vbLf, vbLf) - 1) | |||||
| delim = "," | |||||
| best = 0 | |||||
| For Each cand In Array(",", ";", vbTab, "|") | |||||
| c = Len(firstLine) - Len(Replace(firstLine, cand, "")) | |||||
| If c > best Then best = c : delim = cand | |||||
| Next | |||||
| Dim lines, i, line, pending, all, rec | |||||
| lines = Split(text, vbLf) | |||||
| Set all = CreateObject("Scripting.Dictionary") | |||||
| pending = "" | |||||
| For i = 0 To UBound(lines) | |||||
| line = lines(i) | |||||
| If Len(pending) > 0 Then | |||||
| line = pending & vbLf & line | |||||
| pending = "" | |||||
| End If | |||||
| ' An odd number of quotes means a quoted field continues onto the next physical line. | |||||
| If ((Len(line) - Len(Replace(line, """", ""))) Mod 2) = 1 And i < UBound(lines) Then | |||||
| pending = line | |||||
| ElseIf Len(Trim(line)) > 0 Then | |||||
| all.Add all.Count, ImportFile_SplitCsvLine(line, delim) | |||||
| If maxRows > 0 And all.Count > maxRows Then Exit For | |||||
| End If | |||||
| Next | |||||
| Set ImportFile_ReadCsv = ImportFile_Pack(all) | |||||
| End Function | |||||
| Function ImportFile_SplitCsvLine(line, delim) | |||||
| If InStr(line, """") = 0 Then | |||||
| ImportFile_SplitCsvLine = Split(line, delim) | |||||
| Exit Function | |||||
| End If | |||||
| Dim fields(), n, i, ch, cur, inQ | |||||
| ReDim fields(Len(line)) | |||||
| n = 0 : cur = "" : inQ = False : i = 1 | |||||
| Do While i <= Len(line) | |||||
| ch = Mid(line, i, 1) | |||||
| If inQ Then | |||||
| If ch = """" Then | |||||
| If Mid(line, i + 1, 1) = """" Then | |||||
| cur = cur & """" | |||||
| i = i + 1 | |||||
| Else | |||||
| inQ = False | |||||
| End If | |||||
| Else | |||||
| cur = cur & ch | |||||
| End If | |||||
| ElseIf ch = """" Then | |||||
| inQ = True | |||||
| ElseIf ch = delim Then | |||||
| fields(n) = cur : n = n + 1 : cur = "" | |||||
| Else | |||||
| cur = cur & ch | |||||
| End If | |||||
| i = i + 1 | |||||
| Loop | |||||
| fields(n) = cur | |||||
| ReDim Preserve fields(n) | |||||
| ImportFile_SplitCsvLine = fields | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Excel (via ACE OLEDB; 32-bit provider, so this only works in a 32-bit app pool / IIS Express x86) | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Function ImportFile_ReadExcel(path, ext, maxRows) | |||||
| Dim conn, rs, schema, sheet, props, i, n, all, rec, v, ncols | |||||
| If ext = "xls" Then props = "Excel 8.0" Else props = "Excel 12.0 Xml" | |||||
| Set conn = Server.CreateObject("ADODB.Connection") | |||||
| conn.Open "Provider=Microsoft.ACE.OLEDB.16.0;Data Source=" & path & ";Extended Properties=""" & props & ";HDR=YES;IMEX=1"";" | |||||
| Set schema = conn.OpenSchema(20) ' adSchemaTables | |||||
| sheet = "" | |||||
| Do While Not schema.EOF | |||||
| If schema("TABLE_TYPE") = "TABLE" Or schema("TABLE_TYPE") = "SYSTEM TABLE" Then | |||||
| If InStr(schema("TABLE_NAME"), "_xlnm") = 0 And InStr(schema("TABLE_NAME"), "FilterDatabase") = 0 Then | |||||
| sheet = schema("TABLE_NAME") | |||||
| Exit Do | |||||
| End If | |||||
| End If | |||||
| schema.MoveNext | |||||
| Loop | |||||
| schema.Close | |||||
| Set all = CreateObject("Scripting.Dictionary") | |||||
| If Len(sheet) > 0 Then | |||||
| Set rs = Server.CreateObject("ADODB.Recordset") | |||||
| rs.Open "SELECT * FROM [" & sheet & "]", conn, 0, 1 | |||||
| ncols = rs.Fields.Count | |||||
| ReDim rec(ncols - 1) | |||||
| For i = 0 To ncols - 1 | |||||
| rec(i) = rs.Fields(i).Name | |||||
| Next | |||||
| all.Add 0, rec | |||||
| Do While Not rs.EOF | |||||
| ReDim rec(ncols - 1) | |||||
| For i = 0 To ncols - 1 | |||||
| v = rs.Fields(i).Value | |||||
| If IsNull(v) Then rec(i) = "" Else rec(i) = Trim(CStr(v)) | |||||
| Next | |||||
| all.Add all.Count, rec | |||||
| If maxRows > 0 And all.Count > maxRows Then Exit Do | |||||
| rs.MoveNext | |||||
| Loop | |||||
| rs.Close | |||||
| End If | |||||
| conn.Close | |||||
| Set ImportFile_ReadExcel = ImportFile_Pack(all) | |||||
| End Function | |||||
| ' Splits the raw row dictionary (row 0 = header) into headers + data rows. | |||||
| Function ImportFile_Pack(all) | |||||
| Dim result, rows, i | |||||
| Set result = CreateObject("Scripting.Dictionary") | |||||
| Set rows = CreateObject("Scripting.Dictionary") | |||||
| If all.Count = 0 Then | |||||
| result.Add "headers", Array() | |||||
| Else | |||||
| Dim hdr : hdr = all(0) | |||||
| For i = 0 To UBound(hdr) | |||||
| hdr(i) = Trim(Replace(hdr(i), ChrW(65279), "")) | |||||
| Next | |||||
| result.Add "headers", hdr | |||||
| For i = 1 To all.Count - 1 | |||||
| rows.Add rows.Count, all(i) | |||||
| Next | |||||
| End If | |||||
| result.Add "rows", rows | |||||
| Set ImportFile_Pack = result | |||||
| End Function | |||||
| Function ImportFile_Cell(rec, idx) | |||||
| ImportFile_Cell = "" | |||||
| If idx >= 0 Then | |||||
| If idx <= UBound(rec) Then ImportFile_Cell = Trim(rec(idx)) | |||||
| End If | |||||
| End Function | |||||
| '======================================================================================================================= | |||||
| ' FIELD DEFINITIONS AND NORMALIZATION | |||||
| '======================================================================================================================= | |||||
| ' Importable fields: Array(key, label) | |||||
| Function ImportFile_Fields() | |||||
| ImportFile_Fields = Array( _ | |||||
| Array("name", "Business name"), _ | |||||
| Array("contact_name", "Contact name"), _ | |||||
| Array("industry", "Industry / type of business"), _ | |||||
| Array("phone", "Phone"), _ | |||||
| Array("email", "Email"), _ | |||||
| Array("website", "Website"), _ | |||||
| Array("address1", "Address"), _ | |||||
| Array("city", "City"), _ | |||||
| Array("state", "State"), _ | |||||
| Array("zip", "Zip"), _ | |||||
| Array("notes", "Notes") _ | |||||
| ) | |||||
| End Function | |||||
| ' Guesses which field a column header represents ("" = ignore). | |||||
| Function ImportFile_GuessField(header) | |||||
| Dim h : h = LCase(Trim(header)) | |||||
| Dim rules, r | |||||
| rules = Array( _ | |||||
| Array("contact_name", "contact|owner|person|first.?name|full.?name"), _ | |||||
| Array("email", "e-?mail"), _ | |||||
| Array("phone", "phone|tel|mobile|cell"), _ | |||||
| Array("website", "web|url|site"), _ | |||||
| Array("industry", "industry|category|categories|business.?type|type|niche|sic|naics"), _ | |||||
| Array("zip", "zip|postal|post.?code"), _ | |||||
| Array("state", "^st$|state|province|region"), _ | |||||
| Array("city", "city|town"), _ | |||||
| Array("address1", "address|street"), _ | |||||
| Array("notes", "note|comment|description"), _ | |||||
| Array("name", "business|company|org|^name$|name") _ | |||||
| ) | |||||
| Dim re : Set re = New RegExp | |||||
| re.IgnoreCase = True | |||||
| For Each r In rules | |||||
| re.Pattern = r(1) | |||||
| If re.Test(h) Then | |||||
| ImportFile_GuessField = r(0) | |||||
| Exit Function | |||||
| End If | |||||
| Next | |||||
| ImportFile_GuessField = "" | |||||
| End Function | |||||
| ' Phone as digits only (leading US country code dropped); "" when fewer than 7 digits. | |||||
| Function ImportFile_PhoneDigits(phone) | |||||
| Dim re, d | |||||
| Set re = New RegExp | |||||
| re.Global = True | |||||
| re.Pattern = "[^0-9]" | |||||
| d = re.Replace(phone, "") | |||||
| If Len(d) = 11 And Left(d, 1) = "1" Then d = Mid(d, 2) | |||||
| If Len(d) < 7 Then d = "" | |||||
| ImportFile_PhoneDigits = Left(d, 20) | |||||
| End Function | |||||
| ' Digits of a search term, without the 7-digit minimum used for stored phone numbers. | |||||
| Function ImportFile_PhoneDigitsLoose(s) | |||||
| Dim re : Set re = New RegExp | |||||
| re.Global = True | |||||
| re.Pattern = "[^0-9]" | |||||
| ImportFile_PhoneDigitsLoose = re.Replace(s, "") | |||||
| End Function | |||||
| ' Zip codes that lost their leading zero in Excel (4 digits) get it back. | |||||
| Function ImportFile_NormalizeZip(zip) | |||||
| Dim z : z = Trim(zip) | |||||
| If Len(z) > 2 Then | |||||
| If Right(z, 2) = ".0" Then | |||||
| If IsNumeric(Left(z, Len(z) - 2)) Then z = Left(z, Len(z) - 2) | |||||
| End If | |||||
| End If | |||||
| If Len(z) = 4 And IsNumeric(z) Then z = "0" & z | |||||
| ImportFile_NormalizeZip = z | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,211 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' IMPORT SERVICE | |||||
| ' Inserts parsed spreadsheet rows into businesses inside one transaction. | |||||
| ' Duplicates (same phone digits OR same email) are skipped, both against existing rows and within the file itself. | |||||
| '======================================================================================================================= | |||||
| Function ImportService_TextParam(cmd, size) | |||||
| cmd.Parameters.Append cmd.CreateParameter(, 202, 1, size, Null) ' adVarWChar, adParamInput | |||||
| End Function | |||||
| Function ImportService_NullIfEmpty(s) | |||||
| If Len(s) = 0 Then ImportService_NullIfEmpty = Null Else ImportService_NullIfEmpty = s | |||||
| End Function | |||||
| ' tbl : result of ImportFile_Read(path, 0) | |||||
| ' colOf : Dictionary field key -> column index (only mapped fields) | |||||
| ' defaultIndustry : industry name used when a row has none ("" = leave blank) | |||||
| ' markCustomers : True to flag every imported row as a previous customer | |||||
| ' Returns a Dictionary: read, added, dup_db, dup_file, no_name, new_industries, failed, error, batch_id, dups (Dictionary of samples) | |||||
| Function ImportService_Run(tbl, colOf, defaultIndustry, markCustomers, fileName) | |||||
| Dim res : Set res = CreateObject("Scripting.Dictionary") | |||||
| res("read") = 0 : res("added") = 0 : res("dup_db") = 0 : res("dup_file") = 0 | |||||
| res("no_name") = 0 : res("new_industries") = 0 : res("failed") = False : res("error") = "" | |||||
| res("batch_id") = 0 | |||||
| Dim dups : Set dups = CreateObject("Scripting.Dictionary") | |||||
| Set res("dups") = dups | |||||
| Dim conn : Set conn = DAL().Connection | |||||
| Dim rs, phones, emails, industries | |||||
| Set phones = CreateObject("Scripting.Dictionary") : phones.CompareMode = 1 | |||||
| Set emails = CreateObject("Scripting.Dictionary") : emails.CompareMode = 1 | |||||
| Set industries = CreateObject("Scripting.Dictionary") : industries.CompareMode = 1 | |||||
| Set rs = conn.Execute("SELECT phone_digits, email FROM businesses") | |||||
| Do While Not rs.EOF | |||||
| If Len(rs(0) & "") > 0 Then phones(rs(0) & "") = 1 | |||||
| If Len(rs(1) & "") > 0 Then emails(LCase(rs(1) & "")) = 1 | |||||
| rs.MoveNext | |||||
| Loop | |||||
| rs.Close | |||||
| Set rs = conn.Execute("SELECT id, name FROM industries") | |||||
| Do While Not rs.EOF | |||||
| industries(rs(1) & "") = CLng(rs(0)) | |||||
| rs.MoveNext | |||||
| Loop | |||||
| rs.Close | |||||
| ' Prepared insert for businesses | |||||
| Dim cmd : Set cmd = Server.CreateObject("ADODB.Command") | |||||
| Set cmd.ActiveConnection = conn | |||||
| cmd.CommandType = 1 | |||||
| cmd.CommandText = "INSERT INTO businesses (name, contact_name, industry_id, phone, phone_digits, email, website, " & _ | |||||
| "address1, city, state, zip, source, status, is_customer, notes, import_batch_id, created_at) " & _ | |||||
| "VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,Now())" | |||||
| ImportService_TextParam cmd, 255 ' name | |||||
| ImportService_TextParam cmd, 150 ' contact_name | |||||
| cmd.Parameters.Append cmd.CreateParameter(, 3, 1, , Null) ' industry_id | |||||
| ImportService_TextParam cmd, 40 ' phone | |||||
| ImportService_TextParam cmd, 20 ' phone_digits | |||||
| ImportService_TextParam cmd, 255 ' email | |||||
| ImportService_TextParam cmd, 255 ' website | |||||
| ImportService_TextParam cmd, 255 ' address1 | |||||
| ImportService_TextParam cmd, 100 ' city | |||||
| ImportService_TextParam cmd, 50 ' state | |||||
| ImportService_TextParam cmd, 20 ' zip | |||||
| ImportService_TextParam cmd, 255 ' source | |||||
| ImportService_TextParam cmd, 20 ' status | |||||
| cmd.Parameters.Append cmd.CreateParameter(, 3, 1, , 0) ' is_customer | |||||
| cmd.Parameters.Append cmd.CreateParameter(, 203, 1, 4000, Null) ' notes (adLongVarWChar) | |||||
| cmd.Parameters.Append cmd.CreateParameter(, 3, 1, , 0) ' import_batch_id | |||||
| Dim indCmd : Set indCmd = Server.CreateObject("ADODB.Command") | |||||
| Set indCmd.ActiveConnection = conn | |||||
| indCmd.CommandType = 1 | |||||
| indCmd.CommandText = "INSERT INTO industries (name) VALUES (?)" | |||||
| ImportService_TextParam indCmd, 100 | |||||
| Dim rows : Set rows = tbl("rows") | |||||
| Dim i, rec, nm, contact, ind, phone, digits, email, website, addr, city, st, zip, notes | |||||
| Dim indId, reason, srcLabel, cust, k | |||||
| srcLabel = Left(fileName, 255) | |||||
| If markCustomers Then cust = 1 Else cust = 0 | |||||
| On Error Resume Next | |||||
| conn.BeginTrans | |||||
| ' Batch row (counts are updated at the end) | |||||
| conn.Execute "INSERT INTO import_batches (file_name, imported_at, rows_read, rows_added, rows_skipped) VALUES ('" & _ | |||||
| Replace(Left(fileName, 255), "'", "''") & "', Now(), 0, 0, 0)", , 128 | |||||
| If Err.Number = 0 Then | |||||
| Set rs = conn.Execute("SELECT @@IDENTITY") | |||||
| res("batch_id") = CLng(rs(0)) | |||||
| rs.Close | |||||
| End If | |||||
| If Err.Number = 0 Then | |||||
| For i = 0 To rows.Count - 1 | |||||
| If Err.Number <> 0 Then Exit For | |||||
| rec = rows(i) | |||||
| res("read") = res("read") + 1 | |||||
| nm = Left(ImportFile_Cell(rec, ImportService_Col(colOf, "name")), 255) | |||||
| If Len(nm) = 0 Then | |||||
| res("no_name") = res("no_name") + 1 | |||||
| Else | |||||
| contact = Left(ImportFile_Cell(rec, ImportService_Col(colOf, "contact_name")), 150) | |||||
| ind = Left(ImportFile_Cell(rec, ImportService_Col(colOf, "industry")), 100) | |||||
| phone = Left(ImportFile_Cell(rec, ImportService_Col(colOf, "phone")), 40) | |||||
| email = Left(ImportFile_Cell(rec, ImportService_Col(colOf, "email")), 255) | |||||
| website = Left(ImportFile_Cell(rec, ImportService_Col(colOf, "website")), 255) | |||||
| addr = Left(ImportFile_Cell(rec, ImportService_Col(colOf, "address1")), 255) | |||||
| city = Left(ImportFile_Cell(rec, ImportService_Col(colOf, "city")), 100) | |||||
| st = Left(ImportFile_Cell(rec, ImportService_Col(colOf, "state")), 50) | |||||
| zip = Left(ImportFile_NormalizeZip(ImportFile_Cell(rec, ImportService_Col(colOf, "zip"))), 20) | |||||
| notes = Left(ImportFile_Cell(rec, ImportService_Col(colOf, "notes")), 4000) | |||||
| If InStr(email, "@") = 0 Then email = "" | |||||
| email = LCase(email) | |||||
| digits = ImportFile_PhoneDigits(phone) | |||||
| reason = "" | |||||
| If Len(digits) > 0 Then | |||||
| If phones.Exists(digits) Then reason = "phone" | |||||
| End If | |||||
| If Len(reason) = 0 And Len(email) > 0 Then | |||||
| If emails.Exists(email) Then reason = "email" | |||||
| End If | |||||
| If Len(reason) > 0 Then | |||||
| If (reason = "phone" And phones(digits) = 2) Or (reason = "email" And emails(email) = 2) Then | |||||
| res("dup_file") = res("dup_file") + 1 | |||||
| Else | |||||
| res("dup_db") = res("dup_db") + 1 | |||||
| End If | |||||
| If dups.Count < 25 Then dups.Add dups.Count, Array(i + 2, nm, reason) | |||||
| Else | |||||
| ' Resolve industry (create when new) | |||||
| indId = Null | |||||
| If Len(ind) = 0 Then ind = defaultIndustry | |||||
| If Len(ind) > 0 Then | |||||
| If industries.Exists(ind) Then | |||||
| indId = industries(ind) | |||||
| Else | |||||
| indCmd.Parameters(0).Value = ind | |||||
| indCmd.Execute , , 128 | |||||
| If Err.Number <> 0 Then Exit For | |||||
| Set rs = conn.Execute("SELECT @@IDENTITY") | |||||
| indId = CLng(rs(0)) | |||||
| rs.Close | |||||
| industries(ind) = indId | |||||
| res("new_industries") = res("new_industries") + 1 | |||||
| End If | |||||
| End If | |||||
| cmd.Parameters(0).Value = nm | |||||
| cmd.Parameters(1).Value = ImportService_NullIfEmpty(contact) | |||||
| cmd.Parameters(2).Value = indId | |||||
| cmd.Parameters(3).Value = ImportService_NullIfEmpty(phone) | |||||
| cmd.Parameters(4).Value = ImportService_NullIfEmpty(digits) | |||||
| cmd.Parameters(5).Value = ImportService_NullIfEmpty(email) | |||||
| cmd.Parameters(6).Value = ImportService_NullIfEmpty(website) | |||||
| cmd.Parameters(7).Value = ImportService_NullIfEmpty(addr) | |||||
| cmd.Parameters(8).Value = ImportService_NullIfEmpty(city) | |||||
| cmd.Parameters(9).Value = ImportService_NullIfEmpty(st) | |||||
| cmd.Parameters(10).Value = ImportService_NullIfEmpty(zip) | |||||
| cmd.Parameters(11).Value = ImportService_NullIfEmpty(srcLabel) | |||||
| cmd.Parameters(12).Value = "new" | |||||
| cmd.Parameters(13).Value = cust | |||||
| cmd.Parameters(14).Value = ImportService_NullIfEmpty(notes) | |||||
| cmd.Parameters(15).Value = res("batch_id") | |||||
| cmd.Execute , , 128 | |||||
| If Err.Number <> 0 Then Exit For | |||||
| res("added") = res("added") + 1 | |||||
| If Len(digits) > 0 Then phones(digits) = 2 | |||||
| If Len(email) > 0 Then emails(email) = 2 | |||||
| End If | |||||
| End If | |||||
| Next | |||||
| End If | |||||
| If Err.Number <> 0 Then | |||||
| res("failed") = True | |||||
| res("error") = "Row " & (res("read") + 1) & ": " & Err.Description | |||||
| Err.Clear | |||||
| conn.RollbackTrans | |||||
| Else | |||||
| conn.Execute "UPDATE import_batches SET rows_read = " & CLng(res("read")) & ", rows_added = " & CLng(res("added")) & _ | |||||
| ", rows_skipped = " & CLng(res("read") - res("added")) & " WHERE id = " & CLng(res("batch_id")), , 128 | |||||
| If Err.Number <> 0 Then | |||||
| res("failed") = True | |||||
| res("error") = Err.Description | |||||
| Err.Clear | |||||
| conn.RollbackTrans | |||||
| Else | |||||
| conn.CommitTrans | |||||
| End If | |||||
| End If | |||||
| On Error GoTo 0 | |||||
| Set ImportService_Run = res | |||||
| End Function | |||||
| Function ImportService_Col(colOf, key) | |||||
| If colOf.Exists(key) Then ImportService_Col = colOf(key) Else ImportService_Col = -1 | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,392 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' BUSINESS REPOSITORY | |||||
| ' Data access for businesses and their logged contacts (interactions). Everything is bound as ADODB parameters | |||||
| ' through the Db_* helpers (app/lib/lib.Db.asp). | |||||
| ' | |||||
| ' 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 | |||||
| ' 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) | |||||
| ' dir asc | desc | |||||
| '======================================================================================================================= | |||||
| Class BusinessRepository_Class | |||||
| Private m_where | |||||
| Private m_params ' Dictionary index -> Array(adoType, value), in the order of the ? markers in m_where | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Lists | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' One page of the filtered list. Returns Dictionary("rows" -> Dictionary of row Dictionaries, "total" -> count). | |||||
| Public Function Search(f, page, perPage) | |||||
| Dim result, rows, total, rs, i, skip, sql | |||||
| BuildWhere f | |||||
| Set rs = Run("SELECT COUNT(*) AS n FROM businesses b WHERE " & m_where) | |||||
| total = CLng(rs("n")) | |||||
| rs.Close | |||||
| If page < 1 Then page = 1 | |||||
| skip = (page - 1) * perPage | |||||
| ' 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) | |||||
| Set rs = Run(sql) | |||||
| For i = 1 To skip | |||||
| If rs.EOF Then Exit For | |||||
| rs.MoveNext | |||||
| Next | |||||
| Set rows = ReadRows(rs) | |||||
| rs.Close | |||||
| Set result = CreateObject("Scripting.Dictionary") | |||||
| Set result("rows") = rows | |||||
| result("total") = total | |||||
| Set Search = result | |||||
| End Function | |||||
| ' 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, " & _ | |||||
| "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)) | |||||
| End Function | |||||
| ' Businesses with a next-contact date on or before throughDate (removed ones excluded), oldest first, | |||||
| ' each with the details of its most recent logged contact. | |||||
| Public Function DueThrough(throughDate) | |||||
| Dim list, rs, i, ids, notesById, k, sql | |||||
| sql = "SELECT TOP 500 b.id, b.name, b.contact_name, b.phone, b.email, b.city, b.state, b.is_customer, " & _ | |||||
| "b.next_action_date, b.last_contacted_at, i.name AS industry_name, " & _ | |||||
| "(SELECT TOP 1 x.method FROM interactions x WHERE x.business_id = b.id ORDER BY x.contacted_at DESC, x.id DESC) AS last_method, " & _ | |||||
| "(SELECT TOP 1 x.outcome FROM interactions x WHERE x.business_id = b.id ORDER BY x.contacted_at DESC, x.id DESC) AS last_outcome, " & _ | |||||
| "(SELECT TOP 1 x.id FROM interactions x WHERE x.business_id = b.id ORDER BY x.contacted_at DESC, x.id DESC) AS last_interaction_id " & _ | |||||
| "FROM businesses b LEFT JOIN industries i ON i.id = b.industry_id " & _ | |||||
| "WHERE b.next_action_date IS NOT NULL AND b.next_action_date <= ? AND b.status <> 'removed' " & _ | |||||
| "ORDER BY b.next_action_date ASC, b.name ASC" | |||||
| Set rs = Db_Query(sql, Array(Db_PD(throughDate))) | |||||
| Set list = ReadRows(rs) | |||||
| rs.Close | |||||
| ' Notes are a memo field, which Access won't return from a TOP 1 subquery, so fetch them by interaction id. | |||||
| ids = "" | |||||
| For i = 0 To list.Count - 1 | |||||
| If Not IsNull(list(i)("last_interaction_id")) Then | |||||
| If Len(ids) > 0 Then ids = ids & "," | |||||
| ids = ids & CLng(list(i)("last_interaction_id")) | |||||
| End If | |||||
| Next | |||||
| Set notesById = CreateObject("Scripting.Dictionary") | |||||
| If Len(ids) > 0 Then | |||||
| Set rs = Db_Query("SELECT id, notes FROM interactions WHERE id IN (" & ids & ")", Array()) | |||||
| Do While Not rs.EOF | |||||
| notesById(CStr(rs(0))) = rs(1) & "" | |||||
| rs.MoveNext | |||||
| Loop | |||||
| rs.Close | |||||
| End If | |||||
| For i = 0 To list.Count - 1 | |||||
| list(i)("last_notes") = "" | |||||
| If Not IsNull(list(i)("last_interaction_id")) Then | |||||
| k = CStr(list(i)("last_interaction_id")) | |||||
| If notesById.Exists(k) Then list(i)("last_notes") = notesById(k) | |||||
| End If | |||||
| Next | |||||
| Set DueThrough = list | |||||
| End Function | |||||
| ' id -> name, for dropdowns | |||||
| Public Function Industries() | |||||
| Dim list, rs | |||||
| Set list = CreateObject("Scripting.Dictionary") | |||||
| Set rs = Db_Query("SELECT id, name FROM industries ORDER BY name", Array()) | |||||
| Do While Not rs.EOF | |||||
| list.Add CStr(rs(0)), rs(1) & "" | |||||
| rs.MoveNext | |||||
| Loop | |||||
| rs.Close | |||||
| Set Industries = list | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' One business and its history | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' All columns plus industry_name, or Nothing. | |||||
| Public Function Find(id) | |||||
| Dim rs, rows | |||||
| Set rs = Db_Query("SELECT b.*, i.name AS industry_name FROM businesses b LEFT JOIN industries i ON i.id = b.industry_id WHERE b.id = ?", Array(Db_PI(id))) | |||||
| Set rows = ReadRows(rs) | |||||
| rs.Close | |||||
| If rows.Count = 0 Then Set Find = Nothing Else Set Find = rows(0) | |||||
| End Function | |||||
| ' Logged contacts for a business, newest first. | |||||
| Public Function Interactions(businessId) | |||||
| Dim rs | |||||
| Set rs = Db_Query("SELECT id, method, outcome, notes, contacted_at, follow_up_date FROM interactions WHERE business_id = ? ORDER BY contacted_at DESC, id DESC", Array(Db_PI(businessId))) | |||||
| Set Interactions = ReadRows(rs) | |||||
| rs.Close | |||||
| End Function | |||||
| ' Another business (not excludeId) with the same phone digits or the same email, or Nothing. | |||||
| ' Returns Dictionary(id, name, matched) where matched is "phone" or "email". | |||||
| Public Function FindDuplicate(excludeId, phoneDigits, email) | |||||
| Dim d | |||||
| Set FindDuplicate = Nothing | |||||
| If Len(phoneDigits) > 0 Then | |||||
| Set d = FirstMatch("SELECT TOP 1 id, name FROM businesses WHERE id <> ? AND phone_digits = ?", Array(Db_PI(excludeId), Db_PS(phoneDigits)), "phone") | |||||
| If Not d Is Nothing Then | |||||
| Set FindDuplicate = d | |||||
| Exit Function | |||||
| End If | |||||
| End If | |||||
| If Len(email) > 0 Then | |||||
| Set FindDuplicate = FirstMatch("SELECT TOP 1 id, name FROM businesses WHERE id <> ? AND email = ?", Array(Db_PI(excludeId), Db_PS(email)), "email") | |||||
| End If | |||||
| End Function | |||||
| ' Returns the industry id for a name, creating the industry when it does not exist. Null for a blank name. | |||||
| Public Function FindOrCreateIndustry(name) | |||||
| Dim rs | |||||
| name = Left(Trim(name), 100) | |||||
| If Len(name) = 0 Then | |||||
| FindOrCreateIndustry = Null | |||||
| Exit Function | |||||
| End If | |||||
| Set rs = Db_Query("SELECT id FROM industries WHERE name = ?", Array(Db_PS(name))) | |||||
| If Not rs.EOF Then | |||||
| FindOrCreateIndustry = CLng(rs(0)) | |||||
| rs.Close | |||||
| Exit Function | |||||
| End If | |||||
| rs.Close | |||||
| Db_Exec "INSERT INTO industries (name) VALUES (?)", Array(Db_PS(name)) | |||||
| Set rs = Db_Query("SELECT @@IDENTITY", Array()) | |||||
| FindOrCreateIndustry = CLng(rs(0)) | |||||
| rs.Close | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Changes | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub Update(id, d) | |||||
| Db_Exec "UPDATE businesses SET name = ?, contact_name = ?, industry_id = ?, phone = ?, phone_digits = ?, email = ?, " & _ | |||||
| "website = ?, address1 = ?, city = ?, state = ?, zip = ?, notes = ?, is_customer = ?, first_order_date = ? WHERE id = ?", _ | |||||
| Array(Db_PS(d("name")), Db_PS(d("contact_name")), Db_PI(d("industry_id")), Db_PS(d("phone")), Db_PS(d("phone_digits")), Db_PS(d("email")), _ | |||||
| Db_PS(d("website")), Db_PS(d("address1")), Db_PS(d("city")), Db_PS(d("state")), Db_PS(d("zip")), Db_PS(d("notes")), _ | |||||
| Db_PI(d("is_customer")), Db_PD(d("first_order_date")), Db_PI(id)) | |||||
| End Sub | |||||
| ' Logs a touch and updates the business in one transaction: | |||||
| ' removing -> status removed, no next action | |||||
| ' follow-up date -> status follow_up, next_action_date = follow-up date | |||||
| ' otherwise -> status contacted, next_action_date cleared | |||||
| Public Sub LogInteraction(id, method, outcome, notes, contactedAt, followUp, removing, removeReason) | |||||
| Dim conn, b, status, nextAction, lastContacted, remReason, remAt, msg | |||||
| Set conn = DAL().Connection | |||||
| Set b = Find(id) | |||||
| lastContacted = contactedAt | |||||
| If Not IsNull(b("last_contacted_at")) Then | |||||
| If CDate(b("last_contacted_at")) > contactedAt Then lastContacted = CDate(b("last_contacted_at")) | |||||
| End If | |||||
| remReason = Null : remAt = Null : nextAction = Null | |||||
| If removing Then | |||||
| status = "removed" | |||||
| remReason = removeReason | |||||
| remAt = Now() | |||||
| ElseIf Not IsNull(followUp) Then | |||||
| status = "follow_up" | |||||
| nextAction = followUp | |||||
| Else | |||||
| status = "contacted" | |||||
| End If | |||||
| conn.BeginTrans | |||||
| On Error Resume Next | |||||
| Db_Exec "INSERT INTO interactions (business_id, method, outcome, notes, contacted_at, follow_up_date, created_at) VALUES (?,?,?,?,?,?,Now())", _ | |||||
| Array(Db_PI(id), Db_PS(method), Db_PS(outcome), Db_PS(notes), Db_PD(contactedAt), Db_PD(followUp)) | |||||
| If Err.Number = 0 Then | |||||
| Db_Exec "UPDATE businesses SET last_contacted_at = ?, status = ?, next_action_date = ?, removed_reason = ?, removed_at = ? WHERE id = ?", _ | |||||
| Array(Db_PD(lastContacted), Db_PS(status), Db_PD(nextAction), Db_PS(remReason), Db_PD(remAt), Db_PI(id)) | |||||
| End If | |||||
| If Err.Number <> 0 Then | |||||
| msg = Err.Description | |||||
| Err.Clear | |||||
| conn.RollbackTrans | |||||
| On Error GoTo 0 | |||||
| Err.Raise 5, "BusinessRepository.LogInteraction", msg | |||||
| End If | |||||
| conn.CommitTrans | |||||
| On Error GoTo 0 | |||||
| End Sub | |||||
| Public Sub Remove(id, reason) | |||||
| Db_Exec "UPDATE businesses SET status = 'removed', next_action_date = NULL, removed_reason = ?, removed_at = Now() WHERE id = ?", _ | |||||
| Array(Db_PS(reason), Db_PI(id)) | |||||
| End Sub | |||||
| Public Sub Restore(id) | |||||
| Db_Exec "UPDATE businesses SET status = IIf(last_contacted_at IS NULL, 'new', 'contacted'), removed_reason = NULL, removed_at = NULL WHERE id = ?", _ | |||||
| Array(Db_PI(id)) | |||||
| End Sub | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Internals | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Reads every remaining row of the recordset into a Dictionary (0-based index -> Dictionary of column -> value). | |||||
| Private Function ReadRows(rs) | |||||
| Dim list, d, i | |||||
| Set list = CreateObject("Scripting.Dictionary") | |||||
| Do While Not rs.EOF | |||||
| Set d = CreateObject("Scripting.Dictionary") | |||||
| For i = 0 To rs.Fields.Count - 1 | |||||
| d(rs.Fields(i).Name) = rs.Fields(i).Value | |||||
| Next | |||||
| list.Add list.Count, d | |||||
| rs.MoveNext | |||||
| Loop | |||||
| Set ReadRows = list | |||||
| End Function | |||||
| ' Runs a query expected to return (id, name) and wraps the first row as Dictionary(id, name, matched), or Nothing. | |||||
| Private Function FirstMatch(sql, params, matched) | |||||
| Dim rs, d | |||||
| Set FirstMatch = Nothing | |||||
| Set rs = Db_Query(sql, params) | |||||
| If Not rs.EOF Then | |||||
| Set d = CreateObject("Scripting.Dictionary") | |||||
| d("id") = CLng(rs(0)) : d("name") = rs(1) & "" : d("matched") = matched | |||||
| Set FirstMatch = d | |||||
| End If | |||||
| rs.Close | |||||
| End Function | |||||
| ' Executes sql with the parameters collected by BuildWhere. | |||||
| Private Function Run(sql) | |||||
| Dim params(), i | |||||
| If m_params.Count = 0 Then | |||||
| Set Run = Db_Query(sql, Array()) | |||||
| Exit Function | |||||
| End If | |||||
| ReDim params(m_params.Count - 1) | |||||
| For i = 0 To m_params.Count - 1 | |||||
| params(i) = m_params(i) | |||||
| Next | |||||
| Set Run = Db_Query(sql, params) | |||||
| End Function | |||||
| Private Sub AddParam(typ, v) | |||||
| m_params.Add m_params.Count, Array(typ, v) | |||||
| End Sub | |||||
| Private Sub BuildWhere(f) | |||||
| Dim terms, t, d, q, n, frag, ind, st | |||||
| m_where = "1=1" | |||||
| Set m_params = CreateObject("Scripting.Dictionary") | |||||
| q = Trim(Val_(f, "q")) | |||||
| If Len(q) > 0 Then | |||||
| terms = Split(q, " ") | |||||
| n = 0 | |||||
| For Each t In terms | |||||
| If Len(t) > 0 And n < 5 Then | |||||
| n = n + 1 | |||||
| t = Left(t, 50) | |||||
| d = ImportFile_PhoneDigitsLoose(t) | |||||
| frag = "(b.name LIKE ? OR b.contact_name LIKE ? OR b.email LIKE ? OR b.city LIKE ?" | |||||
| AddParam 202, "%" & Like_(t) & "%" | |||||
| AddParam 202, "%" & Like_(t) & "%" | |||||
| AddParam 202, "%" & Like_(t) & "%" | |||||
| AddParam 202, "%" & Like_(t) & "%" | |||||
| If Len(d) >= 3 Then | |||||
| frag = frag & " OR b.phone_digits LIKE ?" | |||||
| AddParam 202, "%" & d & "%" | |||||
| End If | |||||
| m_where = m_where & " AND " & frag & ")" | |||||
| End If | |||||
| Next | |||||
| End If | |||||
| ind = Val_(f, "industry") | |||||
| If ind = "0" Then | |||||
| m_where = m_where & " AND b.industry_id IS NULL" | |||||
| ElseIf Valid_Id(ind) Then | |||||
| m_where = m_where & " AND b.industry_id = ?" | |||||
| AddParam 3, CLng(ind) | |||||
| End If | |||||
| st = Val_(f, "status") | |||||
| Select Case st | |||||
| Case "all" | |||||
| Case "new", "contacted", "follow_up", "removed" | |||||
| m_where = m_where & " AND b.status = ?" | |||||
| AddParam 202, st | |||||
| Case Else | |||||
| m_where = m_where & " AND b.status <> 'removed'" | |||||
| End Select | |||||
| Select Case Val_(f, "show") | |||||
| Case "prospects" | |||||
| m_where = m_where & " AND (b.is_customer = 0 OR b.is_customer IS NULL)" | |||||
| Case "customers" | |||||
| m_where = m_where & " AND b.is_customer = 1" | |||||
| End Select | |||||
| If Val_(f, "contacted") = "never" Then m_where = m_where & " AND b.last_contacted_at IS NULL" | |||||
| If Val_(f, "phone") = "1" Then m_where = m_where & " AND b.phone_digits IS NOT NULL" | |||||
| End Sub | |||||
| Private Function OrderByClause(f) | |||||
| Dim col, dirSql | |||||
| Select Case Val_(f, "sort") | |||||
| Case "city": col = "b.city" | |||||
| Case "industry": col = "i.name" | |||||
| Case "status": col = "b.status" | |||||
| Case "last_contacted": col = "b.last_contacted_at" | |||||
| Case "next_action": col = "b.next_action_date" | |||||
| Case "added": col = "b.created_at" | |||||
| Case Else: col = "b.name" | |||||
| End Select | |||||
| If LCase(Val_(f, "dir")) = "desc" Then dirSql = "DESC" Else dirSql = "ASC" | |||||
| OrderByClause = col & " " & dirSql & ", b.id " & dirSql | |||||
| End Function | |||||
| Private Function Val_(f, key) | |||||
| If f.Exists(key) Then Val_ = CStr(f(key)) Else Val_ = "" | |||||
| End Function | |||||
| ' Escape LIKE wildcards so user input is matched literally. | |||||
| Private Function Like_(s) | |||||
| s = Replace(s, "[", "[[]") | |||||
| s = Replace(s, "%", "[%]") | |||||
| s = Replace(s, "_", "[_]") | |||||
| s = Replace(s, "*", "[*]") | |||||
| s = Replace(s, "?", "[?]") | |||||
| Like_ = s | |||||
| End Function | |||||
| End Class | |||||
| Dim BusinessRepository_Class__Singleton | |||||
| Function BusinessRepository() | |||||
| If IsEmpty(BusinessRepository_Class__Singleton) Then | |||||
| Set BusinessRepository_Class__Singleton = New BusinessRepository_Class | |||||
| End If | |||||
| Set BusinessRepository = BusinessRepository_Class__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,94 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' INDUSTRY REPOSITORY | |||||
| '======================================================================================================================= | |||||
| Class IndustryRepository_Class | |||||
| ' All industries 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 i.id, i.name, COUNT(b.id) AS n FROM industries i LEFT JOIN businesses b ON b.industry_id = i.id GROUP BY i.id, i.name ORDER BY i.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 | |||||
| Public Function UncategorizedCount() | |||||
| Dim rs | |||||
| Set rs = Db_Query("SELECT COUNT(*) FROM businesses WHERE industry_id IS NULL", Array()) | |||||
| UncategorizedCount = CLng(rs(0)) | |||||
| rs.Close | |||||
| End Function | |||||
| Public Function Find(id) | |||||
| Dim rs | |||||
| Set rs = Db_Query("SELECT i.id, i.name, (SELECT COUNT(*) FROM businesses b WHERE b.industry_id = i.id) AS n FROM industries i WHERE i.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 industry (not excludeId) already has this name (case-insensitive). | |||||
| Public Function NameTaken(name, excludeId) | |||||
| Dim rs | |||||
| Set rs = Db_Query("SELECT COUNT(*) FROM industries 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 industries (name) VALUES (?)", Array(Db_PS(name)) | |||||
| End Sub | |||||
| Public Sub Rename(id, name) | |||||
| Db_Exec "UPDATE industries SET name = ? WHERE id = ?", Array(Db_PS(name), Db_PI(id)) | |||||
| End Sub | |||||
| ' Moves every business from sourceId to targetId, then deletes sourceId. Returns the number of businesses moved. | |||||
| Public Function Merge(sourceId, targetId) | |||||
| Dim conn, moved, rs, msg | |||||
| Set conn = DAL().Connection | |||||
| Set rs = Db_Query("SELECT COUNT(*) FROM businesses WHERE industry_id = ?", Array(Db_PI(sourceId))) | |||||
| moved = CLng(rs(0)) | |||||
| rs.Close | |||||
| conn.BeginTrans | |||||
| On Error Resume Next | |||||
| Db_Exec "UPDATE businesses SET industry_id = ? WHERE industry_id = ?", Array(Db_PI(targetId), Db_PI(sourceId)) | |||||
| If Err.Number = 0 Then Db_Exec "DELETE FROM industries 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, "IndustryRepository.Merge", msg | |||||
| End If | |||||
| conn.CommitTrans | |||||
| On Error GoTo 0 | |||||
| Merge = moved | |||||
| End Function | |||||
| Public Sub Delete(id) | |||||
| Db_Exec "DELETE FROM industries WHERE id = ?", Array(Db_PI(id)) | |||||
| End Sub | |||||
| End Class | |||||
| Dim IndustryRepository_Class__Singleton | |||||
| Function IndustryRepository() | |||||
| If IsEmpty(IndustryRepository_Class__Singleton) Then | |||||
| Set IndustryRepository_Class__Singleton = New IndustryRepository_Class | |||||
| End If | |||||
| Set IndustryRepository = IndustryRepository_Class__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,123 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' STATS REPOSITORY | |||||
| ' Read-only counts for the dashboard. | |||||
| '======================================================================================================================= | |||||
| Class StatsRepository_Class | |||||
| ' Dictionary of counts about the list itself | |||||
| Public Function ListCounts() | |||||
| Dim rs, d | |||||
| Set d = CreateObject("Scripting.Dictionary") | |||||
| Set rs = Db_Query( _ | |||||
| "SELECT COUNT(*) AS total, " & _ | |||||
| "Sum(IIf(status = 'removed', 1, 0)) AS removed, " & _ | |||||
| "Sum(IIf(status <> 'removed' AND (is_customer = 0 OR is_customer IS NULL), 1, 0)) AS prospects, " & _ | |||||
| "Sum(IIf(status <> 'removed' AND is_customer = 1, 1, 0)) AS customers, " & _ | |||||
| "Sum(IIf(status <> 'removed' AND (is_customer = 0 OR is_customer IS NULL) AND last_contacted_at IS NULL, 1, 0)) AS never_contacted, " & _ | |||||
| "Sum(IIf(status = 'new', 1, 0)) AS st_new, " & _ | |||||
| "Sum(IIf(status = 'contacted', 1, 0)) AS st_contacted, " & _ | |||||
| "Sum(IIf(status = 'follow_up', 1, 0)) AS st_follow_up, " & _ | |||||
| "Sum(IIf(status <> 'removed' AND next_action_date < Date(), 1, 0)) AS overdue, " & _ | |||||
| "Sum(IIf(status <> 'removed' AND next_action_date = Date(), 1, 0)) AS due_today, " & _ | |||||
| "Sum(IIf(status <> 'removed' AND next_action_date > Date() AND next_action_date <= DateAdd('d', 7, Date()), 1, 0)) AS this_week, " & _ | |||||
| "Sum(IIf(status <> 'removed' AND phone_digits IS NULL, 1, 0)) AS no_phone " & _ | |||||
| "FROM businesses", Array()) | |||||
| Dim i | |||||
| For i = 0 To rs.Fields.Count - 1 | |||||
| d(rs.Fields(i).Name) = N(rs.Fields(i).Value) | |||||
| Next | |||||
| rs.Close | |||||
| d("active") = d("total") - d("removed") | |||||
| Set ListCounts = d | |||||
| End Function | |||||
| ' Counts of logged contacts: today, last 7 days (including today), last 30 days | |||||
| Public Function ActivityCounts() | |||||
| Dim rs, d | |||||
| Set d = CreateObject("Scripting.Dictionary") | |||||
| Set rs = Db_Query( _ | |||||
| "SELECT Sum(IIf(contacted_at = Date(), 1, 0)) AS n_today, " & _ | |||||
| "Sum(IIf(contacted_at >= DateAdd('d', -6, Date()), 1, 0)) AS n_week, " & _ | |||||
| "Sum(IIf(contacted_at >= DateAdd('d', -29, Date()), 1, 0)) AS n_month, " & _ | |||||
| "COUNT(*) AS everything FROM interactions", Array()) | |||||
| d("today") = N(rs("n_today")) : d("week") = N(rs("n_week")) : d("month") = N(rs("n_month")) : d("all") = N(rs("everything")) | |||||
| rs.Close | |||||
| Set ActivityCounts = d | |||||
| End Function | |||||
| ' Contacts per day for the last `days` days, oldest first: list of Array(date, count) including zero days | |||||
| Public Function DailyActivity(days) | |||||
| Dim rs, counts, list, i, dt, key | |||||
| Set counts = CreateObject("Scripting.Dictionary") | |||||
| Set rs = Db_Query("SELECT contacted_at, COUNT(*) FROM interactions WHERE contacted_at >= DateAdd('d', " & CLng(1 - days) & ", Date()) GROUP BY contacted_at", Array()) | |||||
| Do While Not rs.EOF | |||||
| If Not IsNull(rs(0)) Then counts(CStr(CLng(CDate(rs(0))))) = CLng(rs(1)) | |||||
| rs.MoveNext | |||||
| Loop | |||||
| rs.Close | |||||
| Set list = CreateObject("Scripting.Dictionary") | |||||
| For i = days - 1 To 0 Step -1 | |||||
| dt = Date - i | |||||
| key = CStr(CLng(dt)) | |||||
| If counts.Exists(key) Then list.Add list.Count, Array(dt, counts(key)) Else list.Add list.Count, Array(dt, 0) | |||||
| Next | |||||
| Set DailyActivity = list | |||||
| End Function | |||||
| ' Last 30 days grouped by a column ("method" or "outcome"): list of Array(key, count), biggest first | |||||
| Public Function ActivityBy(column) | |||||
| Dim rs, list | |||||
| If column <> "method" And column <> "outcome" Then Err.Raise 5, "StatsRepository.ActivityBy", "Unsupported column" | |||||
| Set list = CreateObject("Scripting.Dictionary") | |||||
| Set rs = Db_Query("SELECT " & column & ", COUNT(*) AS n FROM interactions WHERE contacted_at >= DateAdd('d', -29, Date()) GROUP BY " & column & " ORDER BY COUNT(*) DESC", Array()) | |||||
| Do While Not rs.EOF | |||||
| list.Add list.Count, Array(rs(0) & "", CLng(rs(1))) | |||||
| rs.MoveNext | |||||
| Loop | |||||
| rs.Close | |||||
| Set ActivityBy = list | |||||
| End Function | |||||
| ' Biggest industries (active businesses only) with how many have been contacted at least once | |||||
| Public Function TopIndustries(maxRows) | |||||
| Dim rs, list | |||||
| Set list = CreateObject("Scripting.Dictionary") | |||||
| Set rs = Db_Query( _ | |||||
| "SELECT TOP " & CLng(maxRows) & " i.id, i.name, COUNT(b.id) AS n, Sum(IIf(b.last_contacted_at IS NULL, 0, 1)) AS contacted " & _ | |||||
| "FROM industries i INNER JOIN businesses b ON b.industry_id = i.id WHERE b.status <> 'removed' " & _ | |||||
| "GROUP BY i.id, i.name ORDER BY COUNT(b.id) DESC, i.name", Array()) | |||||
| Do While Not rs.EOF | |||||
| list.Add list.Count, Array(CLng(rs(0)), rs(1) & "", CLng(rs(2)), N(rs(3))) | |||||
| rs.MoveNext | |||||
| Loop | |||||
| rs.Close | |||||
| Set TopIndustries = list | |||||
| End Function | |||||
| Public Function RecentImports(maxRows) | |||||
| Dim rs, list | |||||
| Set list = CreateObject("Scripting.Dictionary") | |||||
| Set rs = Db_Query("SELECT TOP " & CLng(maxRows) & " id, file_name, imported_at, rows_read, rows_added FROM import_batches ORDER BY id DESC", Array()) | |||||
| Do While Not rs.EOF | |||||
| list.Add list.Count, Array(CLng(rs(0)), rs(1) & "", rs(2), N(rs(3)), N(rs(4))) | |||||
| rs.MoveNext | |||||
| Loop | |||||
| rs.Close | |||||
| Set RecentImports = list | |||||
| End Function | |||||
| ' Null -> 0 | |||||
| Private Function N(v) | |||||
| If IsNull(v) Or IsEmpty(v) Then N = 0 Else N = CLng(v) | |||||
| End Function | |||||
| End Class | |||||
| Dim StatsRepository_Class__Singleton | |||||
| Function StatsRepository() | |||||
| If IsEmpty(StatsRepository_Class__Singleton) Then | |||||
| Set StatsRepository_Class__Singleton = New StatsRepository_Class | |||||
| End If | |||||
| Set StatsRepository = StatsRepository_Class__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,153 @@ | |||||
| <% Flash().ShowErrorsIfPresent : Flash().ShowSuccessIfPresent %> | |||||
| <div class="d-flex justify-content-between align-items-center mb-3"> | |||||
| <h1 class="h3 mb-0">Businesses</h1> | |||||
| <div class="d-flex gap-2"> | |||||
| <a href="/export/businesses<%= H(Businesses_QS(f, 1, sort, dir)) %>" class="btn btn-outline-success btn-sm" title="Download everything matching the current search and filters as a spreadsheet (CSV)"><i class="bi bi-download"></i> Export<% If total > 0 Then Response.Write " " & FormatNumber(total, 0) %></a> | |||||
| <a href="/import" class="btn btn-outline-primary btn-sm"><i class="bi bi-upload"></i> Import</a> | |||||
| </div> | |||||
| </div> | |||||
| <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"> | |||||
| <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> | |||||
| <div class="col-6 col-lg-2"> | |||||
| <label for="industry" class="form-label small mb-1">Industry</label> | |||||
| <select class="form-select form-select-sm" id="industry" name="industry"> | |||||
| <option value="">Any</option> | |||||
| <option value="0"<% If f("industry") = "0" Then Response.Write " selected" %>>(No industry)</option> | |||||
| <% Dim indKey : For Each indKey In industries.Keys %> | |||||
| <option value="<%= indKey %>"<% If f("industry") = indKey Then Response.Write " selected" %>><%= H(industries(indKey)) %></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"> | |||||
| <option value=""<% If f("status") = "" Or f("status") = "active" Then Response.Write " selected" %>>Active (not removed)</option> | |||||
| <option value="all"<% If f("status") = "all" Then Response.Write " selected" %>>All</option> | |||||
| <option value="new"<% If f("status") = "new" Then Response.Write " selected" %>>New</option> | |||||
| <option value="contacted"<% If f("status") = "contacted" Then Response.Write " selected" %>>Contacted</option> | |||||
| <option value="follow_up"<% If f("status") = "follow_up" Then Response.Write " selected" %>>Follow-up</option> | |||||
| <option value="removed"<% If f("status") = "removed" Then Response.Write " selected" %>>Removed</option> | |||||
| </select> | |||||
| </div> | |||||
| <div class="col-6 col-lg-2"> | |||||
| <label for="show" class="form-label small mb-1">Show</label> | |||||
| <select class="form-select form-select-sm" id="show" name="show"> | |||||
| <option value="">Everyone</option> | |||||
| <option value="prospects"<% If f("show") = "prospects" Then Response.Write " selected" %>>Prospects only</option> | |||||
| <option value="customers"<% If f("show") = "customers" Then Response.Write " selected" %>>Previous customers</option> | |||||
| </select> | |||||
| </div> | |||||
| <div class="col-6 col-lg-2"> | |||||
| <div class="form-check mb-1"> | |||||
| <input class="form-check-input" type="checkbox" id="contacted" name="contacted" value="never"<% If f("contacted") = "never" Then Response.Write " checked" %> /> | |||||
| <label class="form-check-label small" for="contacted">Never contacted</label> | |||||
| </div> | |||||
| <div class="form-check mb-1"> | |||||
| <input class="form-check-input" type="checkbox" id="phone" name="phone" value="1"<% If f("phone") = "1" Then Response.Write " checked" %> /> | |||||
| <label class="form-check-label small" for="phone">Has a phone number</label> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| <div class="mt-2"> | |||||
| <button type="submit" class="btn btn-primary btn-sm"><i class="bi bi-search"></i> Search</button> | |||||
| <a href="/businesses" class="btn btn-link btn-sm">Reset</a> | |||||
| </div> | |||||
| </div> | |||||
| </form> | |||||
| <% | |||||
| ' 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"), _ | |||||
| Array("status", "Status"), Array("last_contacted", "Last contacted"), Array("next_action", "Next action")) | |||||
| %> | |||||
| <p class="text-muted small mb-2"> | |||||
| <% If total = 0 Then %> | |||||
| No businesses match. | |||||
| <% Else %> | |||||
| Showing <%= FormatNumber(firstRow, 0) %>–<%= FormatNumber(lastRow, 0) %> of <%= FormatNumber(total, 0) %> | |||||
| <% End If %> | |||||
| </p> | |||||
| <div class="card shadow-sm mb-3"> | |||||
| <div class="table-responsive"> | |||||
| <table class="table table-sm table-hover align-middle mb-0"> | |||||
| <thead class="table-light"> | |||||
| <tr> | |||||
| <% For ci = 0 To UBound(cols) | |||||
| colKey = cols(ci)(0) : colLabel = cols(ci)(1) | |||||
| nextDir = "asc" : arrow = "" | |||||
| If (sort = colKey) Or (sort = "" And colKey = "name") Then | |||||
| If dir = "asc" Then nextDir = "desc" : arrow = " <i class=""bi bi-caret-up-fill""></i>" Else nextDir = "asc" : arrow = " <i class=""bi bi-caret-down-fill""></i>" | |||||
| End If | |||||
| %> | |||||
| <th><a class="text-decoration-none text-dark" href="/businesses<%= H(Businesses_QS(f, 1, colKey, nextDir)) %>"><%= colLabel %><%= arrow %></a></th> | |||||
| <% Next %> | |||||
| <th>Contact</th> | |||||
| </tr> | |||||
| </thead> | |||||
| <tbody> | |||||
| <% Dim ri, r, due | |||||
| For ri = 0 To rows.Count - 1 | |||||
| Set r = rows(ri) | |||||
| %> | |||||
| <tr> | |||||
| <td> | |||||
| <a class="fw-semibold text-decoration-none" href="/businesses/<%= r("id") %>"><%= H(r("name")) %></a> | |||||
| <% If r("is_customer") = 1 Then %><span class="badge text-bg-success ms-1">Customer</span><% End If %> | |||||
| <% 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><%= 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> | |||||
| <td class="small<% due = False | |||||
| If Not IsNull(r("next_action_date")) Then | |||||
| If IsDate(r("next_action_date")) Then due = (CDate(r("next_action_date")) < Date) | |||||
| End If | |||||
| If due Then Response.Write " text-danger fw-semibold" %>"><%= Date_Fmt(r("next_action_date")) %></td> | |||||
| <td class="small"> | |||||
| <% If Len(r("phone") & "") > 0 Then %><div><a href="tel:<%= H(r("phone")) %>" class="text-decoration-none"><%= H(r("phone")) %></a></div><% End If %> | |||||
| <% If Len(r("email") & "") > 0 Then %><div><a href="mailto:<%= H(r("email")) %>" class="text-decoration-none"><%= H(r("email")) %></a></div><% End If %> | |||||
| </td> | |||||
| </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> | |||||
| <% End If %> | |||||
| </tbody> | |||||
| </table> | |||||
| </div> | |||||
| </div> | |||||
| <% If pageCount > 1 Then | |||||
| Dim pFrom, pTo, pi | |||||
| pFrom = page - 3 : If pFrom < 1 Then pFrom = 1 | |||||
| pTo = page + 3 : If pTo > pageCount Then pTo = pageCount | |||||
| %> | |||||
| <nav aria-label="Pages"> | |||||
| <ul class="pagination pagination-sm justify-content-center"> | |||||
| <li class="page-item<% If page = 1 Then Response.Write " disabled" %>"><a class="page-link" href="/businesses<%= H(Businesses_QS(f, page - 1, sort, dir)) %>">Previous</a></li> | |||||
| <% If pFrom > 1 Then %> | |||||
| <li class="page-item"><a class="page-link" href="/businesses<%= H(Businesses_QS(f, 1, sort, dir)) %>">1</a></li> | |||||
| <% If pFrom > 2 Then %><li class="page-item disabled"><span class="page-link">…</span></li><% End If %> | |||||
| <% End If %> | |||||
| <% For pi = pFrom To pTo %> | |||||
| <li class="page-item<% If pi = page Then Response.Write " active" %>"><a class="page-link" href="/businesses<%= H(Businesses_QS(f, pi, sort, dir)) %>"><%= pi %></a></li> | |||||
| <% Next %> | |||||
| <% If pTo < pageCount Then %> | |||||
| <% If pTo < pageCount - 1 Then %><li class="page-item disabled"><span class="page-link">…</span></li><% End If %> | |||||
| <li class="page-item"><a class="page-link" href="/businesses<%= H(Businesses_QS(f, pageCount, sort, dir)) %>"><%= pageCount %></a></li> | |||||
| <% End If %> | |||||
| <li class="page-item<% If page = pageCount Then Response.Write " disabled" %>"><a class="page-link" href="/businesses<%= H(Businesses_QS(f, page + 1, sort, dir)) %>">Next</a></li> | |||||
| </ul> | |||||
| </nav> | |||||
| <% End If %> | |||||
| @@ -0,0 +1,260 @@ | |||||
| <% | |||||
| Dim isRemoved, isCustomer, bid, mth, oc, ix, it, indKey2, nextDue | |||||
| If fv Is Nothing Then Set fv = b | |||||
| isRemoved = (b("status") & "" = "removed") | |||||
| isCustomer = (b("is_customer") & "" = "1") | |||||
| bid = CLng(id) | |||||
| nextDue = False | |||||
| If Not IsNull(b("next_action_date")) Then | |||||
| If IsDate(b("next_action_date")) Then nextDue = (CDate(b("next_action_date")) <= Date) | |||||
| End If | |||||
| %> | |||||
| <% Flash().ShowErrorsIfPresent : Flash().ShowSuccessIfPresent %> | |||||
| <nav aria-label="breadcrumb"> | |||||
| <ol class="breadcrumb small mb-2"> | |||||
| <li class="breadcrumb-item"><a href="/businesses">Businesses</a></li> | |||||
| <li class="breadcrumb-item active" aria-current="page"><%= H(b("name")) %></li> | |||||
| </ol> | |||||
| </nav> | |||||
| <div class="d-flex flex-wrap align-items-center gap-2 mb-3"> | |||||
| <h1 class="h3 mb-0"><%= H(b("name")) %></h1> | |||||
| <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 %> | |||||
| </div> | |||||
| <% If isRemoved Then %> | |||||
| <div class="alert alert-dark d-flex justify-content-between align-items-center"> | |||||
| <div> | |||||
| <strong>Removed</strong><% If Not IsNull(b("removed_at")) Then Response.Write " on " & Date_Fmt(b("removed_at")) %>. | |||||
| <% If Len(b("removed_reason") & "") > 0 Then %>Reason: <%= H(b("removed_reason")) %><% End If %> | |||||
| </div> | |||||
| <form method="post" action="/businesses/<%= bid %>/restore" class="mb-0"> | |||||
| <input type="hidden" name="csrf" value="<%= H(csrf) %>" /> | |||||
| <button type="submit" class="btn btn-sm btn-outline-dark">Restore to list</button> | |||||
| </form> | |||||
| </div> | |||||
| <% ElseIf Not IsNull(b("next_action_date")) Then %> | |||||
| <div class="alert <% If nextDue Then Response.Write "alert-warning" Else Response.Write "alert-info" %> py-2"> | |||||
| <i class="bi bi-calendar-event"></i> Next contact: <strong><%= Date_Fmt(b("next_action_date")) %></strong><% If nextDue Then Response.Write " — due" %> | |||||
| </div> | |||||
| <% End If %> | |||||
| <div class="row g-3"> | |||||
| <!-- LEFT: log a touch + history --> | |||||
| <div class="col-lg-7"> | |||||
| <% If Not isRemoved Then %> | |||||
| <div class="card shadow-sm mb-3"> | |||||
| <div class="card-body"> | |||||
| <h2 class="h5 mb-3">Log a contact</h2> | |||||
| <form method="post" action="/businesses/<%= bid %>/log" id="logForm"> | |||||
| <input type="hidden" name="csrf" value="<%= H(csrf) %>" /> | |||||
| <div class="mb-3"> | |||||
| <div class="btn-group" role="group" aria-label="How"> | |||||
| <% For Each mth In Businesses_Methods() %> | |||||
| <input type="radio" class="btn-check" name="method" id="m_<%= mth(0) %>" value="<%= mth(0) %>" autocomplete="off"<% If mth(0) = "call" Then Response.Write " checked" %> /> | |||||
| <label class="btn btn-outline-primary btn-sm" for="m_<%= mth(0) %>"><%= H(mth(1)) %></label> | |||||
| <% Next %> | |||||
| </div> | |||||
| </div> | |||||
| <div class="row g-2 mb-2"> | |||||
| <div class="col-md-5"> | |||||
| <label for="outcome" class="form-label small mb-1">Outcome</label> | |||||
| <select class="form-select form-select-sm" id="outcome" name="outcome"> | |||||
| <option value="">—</option> | |||||
| <% For Each oc In Businesses_Outcomes() %> | |||||
| <option value="<%= oc(0) %>"><%= H(oc(1)) %></option> | |||||
| <% Next %> | |||||
| </select> | |||||
| </div> | |||||
| <div class="col-6 col-md-3"> | |||||
| <label for="contacted_at" class="form-label small mb-1">Date</label> | |||||
| <input type="date" class="form-control form-control-sm" id="contacted_at" name="contacted_at" value="<%= today %>" max="<%= Date_Iso(Date + 1) %>" /> | |||||
| </div> | |||||
| <div class="col-6 col-md-4"> | |||||
| <label for="follow_up_date" class="form-label small mb-1">Contact again on</label> | |||||
| <input type="date" class="form-control form-control-sm" id="follow_up_date" name="follow_up_date" value="" /> | |||||
| </div> | |||||
| </div> | |||||
| <div class="mb-2 small"> | |||||
| <span class="text-muted">Quick:</span> | |||||
| <button type="button" class="btn btn-link btn-sm p-0 me-2" data-days="3">3 days</button> | |||||
| <button type="button" class="btn btn-link btn-sm p-0 me-2" data-days="7">1 week</button> | |||||
| <button type="button" class="btn btn-link btn-sm p-0 me-2" data-days="14">2 weeks</button> | |||||
| <button type="button" class="btn btn-link btn-sm p-0 me-2" data-days="30">1 month</button> | |||||
| <button type="button" class="btn btn-link btn-sm p-0 text-secondary" data-days="0">clear</button> | |||||
| </div> | |||||
| <div class="mb-3"> | |||||
| <label for="log_notes" class="form-label small mb-1">Notes</label> | |||||
| <textarea class="form-control form-control-sm" id="log_notes" name="notes" rows="3" maxlength="10000"></textarea> | |||||
| </div> | |||||
| <button type="submit" class="btn btn-primary btn-sm"><i class="bi bi-check2"></i> Save contact</button> | |||||
| <span class="text-muted small ms-2" id="removeHint" hidden>This will remove the business from the list (the notes are kept as the reason).</span> | |||||
| </form> | |||||
| </div> | |||||
| </div> | |||||
| <% End If %> | |||||
| <div class="card shadow-sm mb-3"> | |||||
| <div class="card-body"> | |||||
| <h2 class="h5 mb-3">History <span class="text-muted fs-6">(<%= interactions.Count %>)</span></h2> | |||||
| <% If interactions.Count = 0 Then %> | |||||
| <p class="text-muted mb-0">No contact logged yet.</p> | |||||
| <% Else %> | |||||
| <ul class="list-unstyled mb-0"> | |||||
| <% For ix = 0 To interactions.Count - 1 | |||||
| Set it = interactions(ix) %> | |||||
| <li class="border-start border-3 ps-3 pb-3"> | |||||
| <div class="d-flex flex-wrap gap-2 align-items-center"> | |||||
| <strong><%= Date_Fmt(it("contacted_at")) %></strong> | |||||
| <span class="badge text-bg-primary"><%= H(Businesses_Label(Businesses_Methods(), it("method"))) %></span> | |||||
| <% If Len(it("outcome") & "") > 0 Then %><span class="badge text-bg-light border"><%= H(Businesses_Label(Businesses_Outcomes(), it("outcome"))) %></span><% End If %> | |||||
| <% If Not IsNull(it("follow_up_date")) Then %><span class="small text-muted"><i class="bi bi-arrow-return-right"></i> again on <%= Date_Fmt(it("follow_up_date")) %></span><% End If %> | |||||
| </div> | |||||
| <% If Len(it("notes") & "") > 0 Then %><div class="mt-1"><%= Html_Nl2Br(it("notes")) %></div><% End If %> | |||||
| </li> | |||||
| <% Next %> | |||||
| </ul> | |||||
| <% End If %> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| <!-- RIGHT: details --> | |||||
| <div class="col-lg-5"> | |||||
| <div class="card shadow-sm mb-3"> | |||||
| <div class="card-body"> | |||||
| <h2 class="h5 mb-3">Details</h2> | |||||
| <div class="mb-3 small"> | |||||
| <% If Len(b("phone") & "") > 0 Then %><div><i class="bi bi-telephone"></i> <a href="tel:<%= H(b("phone")) %>"><%= H(b("phone")) %></a></div><% End If %> | |||||
| <% If Len(b("email") & "") > 0 Then %><div><i class="bi bi-envelope"></i> <a href="mailto:<%= H(b("email")) %>"><%= H(b("email")) %></a></div><% End If %> | |||||
| <% If Len(b("website") & "") > 0 Then %><div><i class="bi bi-globe"></i> <a href="<% If LCase(Left(b("website"), 4)) = "http" Then Response.Write H(b("website")) Else Response.Write "https://" & H(b("website")) %>" target="_blank" rel="noopener noreferrer"><%= H(b("website")) %></a></div><% End If %> | |||||
| <% If Len(b("address1") & "") > 0 Or Len(b("city") & "") > 0 Then %><div><i class="bi bi-geo-alt"></i> <%= H(b("address1")) %><% If Len(b("address1") & "") > 0 And Len(b("city") & "") > 0 Then Response.Write ", " %><%= H(b("city")) %><% If Len(b("state") & "") > 0 Then Response.Write ", " & H(b("state")) %> <%= H(b("zip")) %></div><% End If %> | |||||
| </div> | |||||
| <% If Not dup Is Nothing Then %> | |||||
| <div class="alert alert-warning small"> | |||||
| <i class="bi bi-exclamation-triangle"></i> | |||||
| Nothing was saved yet. The <%= dup("matched") %> you entered is already used by | |||||
| <a href="/businesses/<%= dup("id") %>" target="_blank" rel="noopener"><%= H(dup("name")) %></a>. | |||||
| Fix it, or press <strong>Save anyway</strong> to keep both. | |||||
| </div> | |||||
| <% End If %> | |||||
| <form method="post" action="/businesses/<%= bid %>/update"> | |||||
| <input type="hidden" name="csrf" value="<%= H(csrf) %>" /> | |||||
| <% If Not dup Is Nothing Then %><input type="hidden" name="allow_duplicate" value="1" /><% End If %> | |||||
| <div class="mb-2"> | |||||
| <label class="form-label small mb-1" for="f_name">Business name</label> | |||||
| <input type="text" class="form-control form-control-sm" id="f_name" name="name" value="<%= H(fv("name")) %>" maxlength="255" required /> | |||||
| </div> | |||||
| <div class="mb-2"> | |||||
| <label class="form-label small mb-1" for="f_contact">Contact</label> | |||||
| <input type="text" class="form-control form-control-sm" id="f_contact" name="contact_name" value="<%= H(fv("contact_name")) %>" maxlength="150" /> | |||||
| </div> | |||||
| <div class="row g-2 mb-2"> | |||||
| <div class="col-6"> | |||||
| <label class="form-label small mb-1" for="f_phone">Phone</label> | |||||
| <input type="text" class="form-control form-control-sm" id="f_phone" name="phone" value="<%= H(fv("phone")) %>" maxlength="40" /> | |||||
| </div> | |||||
| <div class="col-6"> | |||||
| <label class="form-label small mb-1" for="f_email">Email</label> | |||||
| <input type="text" class="form-control form-control-sm" id="f_email" name="email" value="<%= H(fv("email")) %>" maxlength="255" /> | |||||
| </div> | |||||
| </div> | |||||
| <div class="mb-2"> | |||||
| <label class="form-label small mb-1" for="f_web">Website</label> | |||||
| <input type="text" class="form-control form-control-sm" id="f_web" name="website" value="<%= H(fv("website")) %>" maxlength="255" /> | |||||
| </div> | |||||
| <div class="mb-2"> | |||||
| <label class="form-label small mb-1" for="f_addr">Address</label> | |||||
| <input type="text" class="form-control form-control-sm" id="f_addr" name="address1" value="<%= H(fv("address1")) %>" maxlength="255" /> | |||||
| </div> | |||||
| <div class="row g-2 mb-2"> | |||||
| <div class="col-5"><label class="form-label small mb-1" for="f_city">City</label><input type="text" class="form-control form-control-sm" id="f_city" name="city" value="<%= H(fv("city")) %>" maxlength="100" /></div> | |||||
| <div class="col-3"><label class="form-label small mb-1" for="f_state">State</label><input type="text" class="form-control form-control-sm" id="f_state" name="state" value="<%= H(fv("state")) %>" maxlength="50" /></div> | |||||
| <div class="col-4"><label class="form-label small mb-1" for="f_zip">Zip</label><input type="text" class="form-control form-control-sm" id="f_zip" name="zip" value="<%= H(fv("zip")) %>" maxlength="20" /></div> | |||||
| </div> | |||||
| <div class="row g-2 mb-2"> | |||||
| <div class="col-6"> | |||||
| <label class="form-label small mb-1" for="f_ind">Industry</label> | |||||
| <select class="form-select form-select-sm" id="f_ind" name="industry_id"> | |||||
| <option value="">(none)</option> | |||||
| <% For Each indKey2 In industries.Keys %> | |||||
| <option value="<%= indKey2 %>"<% If CStr(fv("industry_id") & "") = indKey2 Then Response.Write " selected" %>><%= H(industries(indKey2)) %></option> | |||||
| <% Next %> | |||||
| </select> | |||||
| </div> | |||||
| <div class="col-6"> | |||||
| <label class="form-label small mb-1" for="f_indnew">…or add new</label> | |||||
| <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> | |||||
| <div class="row g-2 mb-2 align-items-end"> | |||||
| <div class="col-6"> | |||||
| <div class="form-check"> | |||||
| <input class="form-check-input" type="checkbox" id="f_cust" name="is_customer" value="1"<% If fv("is_customer") & "" = "1" Then Response.Write " checked" %> /> | |||||
| <label class="form-check-label small" for="f_cust">Previous customer</label> | |||||
| </div> | |||||
| </div> | |||||
| <div class="col-6"> | |||||
| <label class="form-label small mb-1" for="f_first">First order</label> | |||||
| <input type="date" class="form-control form-control-sm" id="f_first" name="first_order_date" value="<%= Date_Iso(fv("first_order_date")) %>" /> | |||||
| </div> | |||||
| </div> | |||||
| <div class="mb-3"> | |||||
| <label class="form-label small mb-1" for="f_notes">Notes <span class="text-muted">(other people, anything else)</span></label> | |||||
| <textarea class="form-control form-control-sm" id="f_notes" name="notes" rows="4" maxlength="10000"><%= H(fv("notes")) %></textarea> | |||||
| </div> | |||||
| <button type="submit" class="btn <% If dup Is Nothing Then Response.Write "btn-outline-primary" Else Response.Write "btn-warning" %> btn-sm"><% If dup Is Nothing Then Response.Write "Save details" Else Response.Write "Save anyway" %></button> | |||||
| </form> | |||||
| </div> | |||||
| </div> | |||||
| <% If Not isRemoved Then %> | |||||
| <div class="card border-danger-subtle shadow-sm mb-3"> | |||||
| <div class="card-body"> | |||||
| <h2 class="h6 text-danger">Remove from list</h2> | |||||
| <form method="post" action="/businesses/<%= bid %>/remove" class="d-flex gap-2"> | |||||
| <input type="hidden" name="csrf" value="<%= H(csrf) %>" /> | |||||
| <input type="text" class="form-control form-control-sm" name="reason" placeholder="Reason (optional)" maxlength="255" /> | |||||
| <button type="submit" class="btn btn-outline-danger btn-sm text-nowrap">Remove</button> | |||||
| </form> | |||||
| <div class="form-text">Removed businesses are hidden from the list and won't be re-added by an import. You can restore them.</div> | |||||
| </div> | |||||
| </div> | |||||
| <% End If %> | |||||
| <p class="text-muted small"> | |||||
| Added <%= Date_Fmt(b("created_at")) %><% If Not IsNull(b("import_batch_id")) Then Response.Write " · import batch #" & b("import_batch_id") %> | |||||
| <% If Len(b("source") & "") > 0 Then %>· <%= H(b("source")) %><% End If %> | |||||
| </p> | |||||
| </div> | |||||
| </div> | |||||
| <script> | |||||
| (function () { | |||||
| var fu = document.getElementById('follow_up_date'); | |||||
| document.querySelectorAll('[data-days]').forEach(function (btn) { | |||||
| btn.addEventListener('click', function () { | |||||
| var n = parseInt(btn.getAttribute('data-days'), 10); | |||||
| if (!fu) return; | |||||
| if (n === 0) { fu.value = ''; return; } | |||||
| var d = new Date(); d.setDate(d.getDate() + n); | |||||
| var m = ('0' + (d.getMonth() + 1)).slice(-2), day = ('0' + d.getDate()).slice(-2); | |||||
| fu.value = d.getFullYear() + '-' + m + '-' + day; | |||||
| }); | |||||
| }); | |||||
| var oc = document.getElementById('outcome'), hint = document.getElementById('removeHint'); | |||||
| if (oc && hint) oc.addEventListener('change', function () { hint.hidden = (oc.value !== 'remove'); }); | |||||
| })(); | |||||
| </script> | |||||
| @@ -0,0 +1,192 @@ | |||||
| <% | |||||
| ' Tile helper values: label, number, link, optional emphasis class | |||||
| Dim tiles, ti, t, pct, pctText, barW, di, dd, barPct, oi, ob, mi, mb, ii, ir, bi_ | |||||
| tiles = Array( _ | |||||
| Array("Prospects", counts("prospects"), "/businesses?show=prospects", ""), _ | |||||
| Array("Previous customers", counts("customers"), "/businesses?show=customers", "text-success"), _ | |||||
| Array("Never contacted", counts("never_contacted"), "/businesses?show=prospects&contacted=never", ""), _ | |||||
| Array("Follow-ups overdue", counts("overdue"), "/", Iif_(counts("overdue") > 0, "text-danger", "")), _ | |||||
| Array("Due today", counts("due_today"), "/", Iif_(counts("due_today") > 0, "text-warning-emphasis", "")), _ | |||||
| Array("Due in the next 7 days", counts("this_week"), "/", ""), _ | |||||
| Array("No phone number", counts("no_phone"), "/businesses?show=prospects", "text-muted"), _ | |||||
| Array("Removed", counts("removed"), "/businesses?status=removed", "text-muted") _ | |||||
| ) | |||||
| %> | |||||
| <% Flash().ShowErrorsIfPresent : Flash().ShowSuccessIfPresent %> | |||||
| <div class="d-flex justify-content-between align-items-center mb-3"> | |||||
| <div> | |||||
| <h1 class="h3 mb-0">Dashboard</h1> | |||||
| <div class="text-muted small"><%= FormatNumber(counts("active"), 0) %> active businesses · <%= FormatNumber(counts("total"), 0) %> including removed</div> | |||||
| </div> | |||||
| </div> | |||||
| <!-- The list --> | |||||
| <div class="row g-3 mb-4"> | |||||
| <% For ti = 0 To UBound(tiles) | |||||
| t = tiles(ti) %> | |||||
| <div class="col-6 col-md-3"> | |||||
| <a href="<%= t(2) %>" class="card shadow-sm text-decoration-none h-100"> | |||||
| <div class="card-body py-3"> | |||||
| <div class="display-6 fw-semibold <%= t(3) %>"><%= FormatNumber(t(1), 0) %></div> | |||||
| <div class="small text-muted"><%= t(0) %></div> | |||||
| </div> | |||||
| </a> | |||||
| </div> | |||||
| <% Next %> | |||||
| </div> | |||||
| <div class="row g-3 mb-4"> | |||||
| <!-- Pipeline --> | |||||
| <div class="col-lg-5"> | |||||
| <div class="card shadow-sm h-100"> | |||||
| <div class="card-body"> | |||||
| <h2 class="h5 mb-3">Where everyone stands</h2> | |||||
| <% | |||||
| Dim stages, si, s, tot | |||||
| stages = Array(Array("New", counts("st_new"), "text-bg-secondary", "new"), Array("Contacted", counts("st_contacted"), "text-bg-info", "contacted"), Array("Follow-up", counts("st_follow_up"), "text-bg-warning", "follow_up")) | |||||
| tot = counts("st_new") + counts("st_contacted") + counts("st_follow_up") | |||||
| If tot = 0 Then tot = 1 | |||||
| %> | |||||
| <div class="progress mb-3" style="height: 1.5rem;" role="img" aria-label="Pipeline breakdown"> | |||||
| <% For si = 0 To UBound(stages) | |||||
| s = stages(si) | |||||
| If s(1) > 0 Then %> | |||||
| <div class="progress-bar <%= s(2) %>" style="width: <%= Round(s(1) * 100 / tot, 1) %>%"><%= s(0) %></div> | |||||
| <% End If | |||||
| Next %> | |||||
| </div> | |||||
| <table class="table table-sm mb-0"> | |||||
| <% For si = 0 To UBound(stages) | |||||
| s = stages(si) %> | |||||
| <tr> | |||||
| <td><span class="badge <%= s(2) %>"><%= s(0) %></span></td> | |||||
| <td class="text-end"><a href="/businesses?status=<%= s(3) %>" class="text-decoration-none"><%= FormatNumber(s(1), 0) %></a></td> | |||||
| <td class="text-end text-muted small"><%= Round(s(1) * 100 / tot, 0) %>%</td> | |||||
| </tr> | |||||
| <% Next %> | |||||
| </table> | |||||
| <div class="form-text">Counts include previous customers. Removed businesses are not counted here.</div> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| <!-- Activity --> | |||||
| <div class="col-lg-7"> | |||||
| <div class="card shadow-sm h-100"> | |||||
| <div class="card-body"> | |||||
| <h2 class="h5 mb-3">Contact activity</h2> | |||||
| <div class="row text-center mb-3"> | |||||
| <div class="col-4"><div class="h3 mb-0"><%= FormatNumber(activity("today"), 0) %></div><div class="small text-muted">Today</div></div> | |||||
| <div class="col-4"><div class="h3 mb-0"><%= FormatNumber(activity("week"), 0) %></div><div class="small text-muted">Last 7 days</div></div> | |||||
| <div class="col-4"><div class="h3 mb-0"><%= FormatNumber(activity("month"), 0) %></div><div class="small text-muted">Last 30 days</div></div> | |||||
| </div> | |||||
| <div class="small text-muted mb-1">Last 14 days</div> | |||||
| <div class="d-flex align-items-end gap-1" style="height: 90px;" role="img" aria-label="Contacts per day for the last 14 days"> | |||||
| <% For di = 0 To daily.Count - 1 | |||||
| dd = daily(di) | |||||
| barPct = Round(dd(1) * 100 / maxDaily, 0) | |||||
| If dd(1) > 0 And barPct < 6 Then barPct = 6 %> | |||||
| <div class="flex-fill d-flex flex-column justify-content-end align-items-center h-100" title="<%= Date_Fmt(dd(0)) %>: <%= dd(1) %>"> | |||||
| <div class="small text-muted" style="font-size: .7rem;"><% If dd(1) > 0 Then Response.Write dd(1) %></div> | |||||
| <div class="w-100 rounded-top <% If dd(0) = Date Then Response.Write "bg-primary" Else Response.Write "bg-primary-subtle" %>" style="height: <%= barPct %>%; min-height: <% If dd(1) > 0 Then Response.Write "2px" Else Response.Write "1px" %>;<% If dd(1) = 0 Then Response.Write " background:#dee2e6;" %>"></div> | |||||
| </div> | |||||
| <% Next %> | |||||
| </div> | |||||
| <div class="d-flex gap-1 small text-muted" style="font-size: .7rem;"> | |||||
| <% For di = 0 To daily.Count - 1 %> | |||||
| <div class="flex-fill text-center"><%= Day(daily(di)(0)) %></div> | |||||
| <% Next %> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| <div class="row g-3 mb-4"> | |||||
| <div class="col-md-6"> | |||||
| <div class="card shadow-sm h-100"> | |||||
| <div class="card-body"> | |||||
| <h2 class="h5 mb-3">How you reached out <span class="text-muted fs-6">(30 days)</span></h2> | |||||
| <% If byMethod.Count = 0 Then %><p class="text-muted mb-0">Nothing logged yet.</p><% Else %> | |||||
| <table class="table table-sm mb-0"> | |||||
| <% For mi = 0 To byMethod.Count - 1 | |||||
| mb = byMethod(mi) %> | |||||
| <tr><td><%= H(Businesses_Label(Businesses_Methods(), mb(0))) %></td><td class="text-end"><%= FormatNumber(mb(1), 0) %></td></tr> | |||||
| <% Next %> | |||||
| </table> | |||||
| <% End If %> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| <div class="col-md-6"> | |||||
| <div class="card shadow-sm h-100"> | |||||
| <div class="card-body"> | |||||
| <h2 class="h5 mb-3">Outcomes <span class="text-muted fs-6">(30 days)</span></h2> | |||||
| <% If byOutcome.Count = 0 Then %><p class="text-muted mb-0">Nothing logged yet.</p><% Else %> | |||||
| <table class="table table-sm mb-0"> | |||||
| <% For oi = 0 To byOutcome.Count - 1 | |||||
| ob = byOutcome(oi) %> | |||||
| <tr> | |||||
| <td><% If Len(ob(0)) = 0 Then Response.Write "<span class=""text-muted"">(no outcome)</span>" Else Response.Write H(Businesses_Label(Businesses_Outcomes(), ob(0))) %></td> | |||||
| <td class="text-end"><%= FormatNumber(ob(1), 0) %></td> | |||||
| </tr> | |||||
| <% Next %> | |||||
| </table> | |||||
| <% End If %> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| <div class="row g-3 mb-4"> | |||||
| <div class="col-lg-7"> | |||||
| <div class="card shadow-sm h-100"> | |||||
| <div class="card-body"> | |||||
| <h2 class="h5 mb-3">Biggest industries <span class="text-muted fs-6">(<a href="/industries" class="text-decoration-none">manage</a>)</span></h2> | |||||
| <% If industries.Count = 0 Then %><p class="text-muted mb-0">No industries yet.</p><% Else %> | |||||
| <table class="table table-sm align-middle mb-0"> | |||||
| <thead><tr><th>Industry</th><th class="text-end">Businesses</th><th style="width:40%">Contacted</th></tr></thead> | |||||
| <tbody> | |||||
| <% For ii = 0 To industries.Count - 1 | |||||
| ir = industries(ii) | |||||
| If ir(2) > 0 Then pct = Round(ir(3) * 100 / ir(2), 0) Else pct = 0 | |||||
| If ir(3) > 0 And pct = 0 Then pctText = "<1" Else pctText = CStr(pct) | |||||
| If ir(3) > 0 And pct = 0 Then barW = 1 Else barW = pct %> | |||||
| <tr> | |||||
| <td><a href="/businesses?industry=<%= ir(0) %>" class="text-decoration-none"><%= H(ir(1)) %></a></td> | |||||
| <td class="text-end"><%= FormatNumber(ir(2), 0) %></td> | |||||
| <td> | |||||
| <div class="d-flex align-items-center gap-2"> | |||||
| <div class="progress flex-fill" style="height: .6rem;" role="img" aria-label="<%= pctText %> percent contacted"><div class="progress-bar" style="width: <%= barW %>%"></div></div> | |||||
| <span class="small text-muted text-nowrap"><%= FormatNumber(ir(3), 0) %> · <%= pctText %>%</span> | |||||
| </div> | |||||
| </td> | |||||
| </tr> | |||||
| <% Next %> | |||||
| </tbody> | |||||
| </table> | |||||
| <% End If %> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| <div class="col-lg-5"> | |||||
| <div class="card shadow-sm h-100"> | |||||
| <div class="card-body"> | |||||
| <h2 class="h5 mb-3">Recent imports <span class="text-muted fs-6">(<a href="/import" class="text-decoration-none">import</a>)</span></h2> | |||||
| <% If imports.Count = 0 Then %><p class="text-muted mb-0">No imports yet.</p><% Else %> | |||||
| <ul class="list-unstyled mb-0 small"> | |||||
| <% For bi_ = 0 To imports.Count - 1 | |||||
| ir = imports(bi_) %> | |||||
| <li class="mb-2"> | |||||
| <div class="fw-semibold text-break"><%= H(ir(1)) %></div> | |||||
| <div class="text-muted"><%= Date_Fmt(ir(2)) %> · <%= FormatNumber(ir(4), 0) %> added of <%= FormatNumber(ir(3), 0) %> rows</div> | |||||
| </li> | |||||
| <% Next %> | |||||
| </ul> | |||||
| <% End If %> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| @@ -0,0 +1,55 @@ | |||||
| <div class="main-content"> | |||||
| <div class="d-flex align-items-center justify-content-center min-vh-100 bg-light"> | |||||
| <div class="card shadow-sm border-0 text-center p-4 p-md-5 error-card"> | |||||
| <div class="mb-3"> | |||||
| <i class="bi bi-exclamation-triangle-fill display-3 text-warning"></i> | |||||
| </div> | |||||
| <h1 class="h3 mb-3">404 - Page Not Found</h1> | |||||
| <p class="text-muted mb-3"> | |||||
| The page you’re looking for could not be found. It may have been moved, deleted, | |||||
| or the address might be incorrect. | |||||
| </p> | |||||
| <% | |||||
| Dim redirectSeconds : redirectSeconds = GetAppSetting("Error404RedirectSeconds") | |||||
| If redirectSeconds = "nothing" Or Not IsNumeric(redirectSeconds) Then redirectSeconds = 5 | |||||
| %> | |||||
| <p class="text-muted mb-3"> | |||||
| You'll be redirected to the homepage in | |||||
| <span id="countdown"><%= redirectSeconds %></span> seconds. | |||||
| </p> | |||||
| <a href="/" class="btn btn-primary mt-2"> | |||||
| Go to Homepage Now | |||||
| </a> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| <style> | |||||
| .error-card { | |||||
| max-width: 540px; | |||||
| border-radius: 1rem; | |||||
| } | |||||
| .error-card .bi { | |||||
| line-height: 1; | |||||
| } | |||||
| </style> | |||||
| <script> | |||||
| (function () { | |||||
| let seconds = <%= redirectSeconds %>; | |||||
| const countdown = document.getElementById('countdown'); | |||||
| const timer = setInterval(function () { | |||||
| seconds--; | |||||
| if (countdown) { | |||||
| countdown.textContent = seconds; | |||||
| } | |||||
| if (seconds <= 0) { | |||||
| clearInterval(timer); | |||||
| window.location.href = '/'; | |||||
| } | |||||
| }, 1000); | |||||
| })(); | |||||
| </script> | |||||
| @@ -0,0 +1,85 @@ | |||||
| <div class="row mb-4"> | |||||
| <div class="col-lg-8"> | |||||
| <div class="card shadow-sm mb-3"> | |||||
| <div class="card-body"> | |||||
| <h1 class="h3 mb-3">Welcome to RouteKit Classic ASP</h1> | |||||
| <p class="text-muted"> | |||||
| Your lightweight, opinionated MVC-style framework for Classic ASP. | |||||
| </p> | |||||
| <p> | |||||
| This <code>Home.Index</code> view is using the shared | |||||
| <code>Header.asp</code> and <code>Footer.asp</code> layout files. | |||||
| </p> | |||||
| <p class="mb-0"> | |||||
| Start by wiring up your controllers, repositories, and views — this page is just a | |||||
| friendly placeholder so you know everything is hooked up correctly. | |||||
| </p> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| <div class="col-lg-4"> | |||||
| <div class="card border-0 bg-light mb-3"> | |||||
| <div class="card-body"> | |||||
| <h2 class="h5 mb-3">Quick info</h2> | |||||
| <ul class="list-unstyled mb-0 small"> | |||||
| <li class="mb-1"> | |||||
| <strong>View:</strong> | |||||
| <code>app/Views/Home.Index.asp</code> | |||||
| </li> | |||||
| <li class="mb-1"> | |||||
| <strong>Layout:</strong> | |||||
| <code>Shared/Header.asp</code> & <code>Shared/Footer.asp</code> | |||||
| </li> | |||||
| <li class="mb-1"> | |||||
| <strong>Default route:</strong> | |||||
| typically <code>/Home/Index</code> or <code>/</code> via the dispatcher. | |||||
| </li> | |||||
| </ul> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| <div class="row gy-3"> | |||||
| <div class="col-md-4"> | |||||
| <div class="card h-100 shadow-sm"> | |||||
| <div class="card-body"> | |||||
| <h2 class="h5">Next step: Controllers</h2> | |||||
| <p class="small text-muted"> | |||||
| Use your <code>generateController.vbs</code> script to scaffold new controllers. | |||||
| </p> | |||||
| <pre class="small mb-0"><code>cscript //nologo Scripts\generateController.vbs ^ | |||||
| Home "Index"</code></pre> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| <div class="col-md-4"> | |||||
| <div class="card h-100 shadow-sm"> | |||||
| <div class="card-body"> | |||||
| <h2 class="h5">POBO & Repository</h2> | |||||
| <p class="small text-muted"> | |||||
| Generate strongly-typed POBOs and repositories from your Access/SQL schema. | |||||
| </p> | |||||
| <pre class="small mb-0"><code>cscript //nologo Scripts\GenerateRepo.vbs ^ | |||||
| /table:Users /pk:UserId</code></pre> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| <div class="col-md-4"> | |||||
| <div class="card h-100 shadow-sm"> | |||||
| <div class="card-body"> | |||||
| <h2 class="h5">Where to put stuff</h2> | |||||
| <ul class="small mb-0"> | |||||
| <li><code>/core/</code> – framework libs (DAL, routing, helpers)</li> | |||||
| <li><code>/app/Views/</code> – pages like this one</li> | |||||
| <li><code>/public/</code> – IIS root (Default.asp, web.config)</li> | |||||
| </ul> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| @@ -0,0 +1,34 @@ | |||||
| <% Flash().ShowErrorsIfPresent : Flash().ShowSuccessIfPresent %> | |||||
| <div class="row"> | |||||
| <div class="col-lg-8"> | |||||
| <div class="card shadow-sm mb-3"> | |||||
| <div class="card-body"> | |||||
| <h1 class="h3 mb-3">Import businesses</h1> | |||||
| <p class="text-muted"> | |||||
| Upload an Excel (<code>.xlsx</code>, <code>.xls</code>) or <code>.csv</code> file. The first row must be the column headings. | |||||
| You'll match the columns to fields on the next step before anything is saved. | |||||
| </p> | |||||
| <form method="post" action="/import/upload" enctype="multipart/form-data"> | |||||
| <input type="hidden" name="csrf" value="<%= H(csrf) %>" /> | |||||
| <div class="mb-3"> | |||||
| <label for="file" class="form-label">File</label> | |||||
| <input class="form-control" type="file" id="file" name="file" accept=".csv,.xlsx,.xls" required /> | |||||
| </div> | |||||
| <button type="submit" class="btn btn-primary"><i class="bi bi-upload"></i> Upload and map columns</button> | |||||
| </form> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| <div class="col-lg-4"> | |||||
| <div class="card border-0 bg-light"> | |||||
| <div class="card-body small"> | |||||
| <h2 class="h6">How duplicates are handled</h2> | |||||
| <p class="mb-2">A row is skipped when its <strong>phone number</strong> (digits only) or its <strong>email address</strong> already exists, either in the database or earlier in the same file.</p> | |||||
| <p class="mb-0">Rows with no business name are skipped. New industries found in the file are created automatically.</p> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| @@ -0,0 +1,86 @@ | |||||
| <div class="card shadow-sm mb-3"> | |||||
| <div class="card-body"> | |||||
| <h1 class="h3 mb-1">Match columns</h1> | |||||
| <p class="text-muted"> | |||||
| <i class="bi bi-file-earmark-spreadsheet"></i> <%= H(originalName) %> · | |||||
| Choose what each column contains. Columns set to <em>Ignore</em> are not imported. Sample values come from the first rows of the file. | |||||
| </p> | |||||
| <form method="post" action="/import/run" id="mapForm"> | |||||
| <input type="hidden" name="csrf" value="<%= H(csrf) %>" /> | |||||
| <input type="hidden" name="token" value="<%= H(token) %>" /> | |||||
| <input type="hidden" name="original_name" value="<%= H(originalName) %>" /> | |||||
| <input type="hidden" name="ncols" value="<%= UBound(headers) + 1 %>" /> | |||||
| <div class="table-responsive"> | |||||
| <table class="table table-sm align-middle"> | |||||
| <thead> | |||||
| <tr><th>Column in file</th><th>Import as</th><th>Sample values</th></tr> | |||||
| </thead> | |||||
| <tbody> | |||||
| <% | |||||
| Dim ci, ri, guess, fld, sample, usedGuess | |||||
| Set usedGuess = CreateObject("Scripting.Dictionary") | |||||
| For ci = 0 To UBound(headers) | |||||
| guess = ImportFile_GuessField(headers(ci)) | |||||
| ' Only the first column guessed for a field is pre-selected. | |||||
| If Len(guess) > 0 Then | |||||
| If usedGuess.Exists(guess) Then guess = "" Else usedGuess.Add guess, 1 | |||||
| End If | |||||
| %> | |||||
| <tr> | |||||
| <td class="fw-semibold"><%= H(headers(ci)) %></td> | |||||
| <td> | |||||
| <select name="map_<%= ci %>" class="form-select form-select-sm"> | |||||
| <option value="">Ignore</option> | |||||
| <% For Each fld In fields %> | |||||
| <option value="<%= fld(0) %>"<% If fld(0) = guess Then Response.Write " selected" %>><%= H(fld(1)) %></option> | |||||
| <% Next %> | |||||
| </select> | |||||
| </td> | |||||
| <td class="text-muted small"> | |||||
| <% | |||||
| sample = "" | |||||
| For ri = 0 To rows.Count - 1 | |||||
| If Len(ImportFile_Cell(rows(ri), ci)) > 0 Then | |||||
| If Len(sample) > 0 Then sample = sample & " · " | |||||
| sample = sample & H(Left(ImportFile_Cell(rows(ri), ci), 40)) | |||||
| End If | |||||
| Next | |||||
| Response.Write sample | |||||
| %> | |||||
| </td> | |||||
| </tr> | |||||
| <% Next %> | |||||
| </tbody> | |||||
| </table> | |||||
| </div> | |||||
| <div class="row g-3 mb-3"> | |||||
| <div class="col-md-6"> | |||||
| <label for="default_industry" class="form-label">Default industry <span class="text-muted">(used when a row has none)</span></label> | |||||
| <input type="text" class="form-control" id="default_industry" name="default_industry" maxlength="100" /> | |||||
| </div> | |||||
| <div class="col-md-6 d-flex align-items-end"> | |||||
| <div class="form-check"> | |||||
| <input class="form-check-input" type="checkbox" id="mark_customers" name="mark_customers" value="1" /> | |||||
| <label class="form-check-label" for="mark_customers">These are previous customers</label> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| <button type="submit" class="btn btn-primary" id="runBtn"><i class="bi bi-check2-circle"></i> Import</button> | |||||
| <a href="/import" class="btn btn-link">Cancel</a> | |||||
| <span class="text-muted small ms-2 d-none" id="working">Importing — large files can take a minute…</span> | |||||
| </form> | |||||
| </div> | |||||
| </div> | |||||
| <script> | |||||
| document.getElementById('mapForm').addEventListener('submit', function (e) { | |||||
| var hasName = Array.prototype.some.call(this.querySelectorAll('select'), function (s) { return s.value === 'name'; }); | |||||
| if (!hasName) { e.preventDefault(); alert('Map one column to "Business name".'); return; } | |||||
| document.getElementById('runBtn').disabled = true; | |||||
| document.getElementById('working').classList.remove('d-none'); | |||||
| }); | |||||
| </script> | |||||
| @@ -0,0 +1,43 @@ | |||||
| <% If res("failed") Then %> | |||||
| <div class="alert alert-danger"> | |||||
| <strong>Import failed — nothing was saved.</strong><br /> | |||||
| <%= H(res("error")) %> | |||||
| </div> | |||||
| <p><a href="/import" class="btn btn-primary">Start over</a></p> | |||||
| <% Else %> | |||||
| <div class="card shadow-sm mb-3"> | |||||
| <div class="card-body"> | |||||
| <h1 class="h3 mb-3"><i class="bi bi-check-circle text-success"></i> Import complete</h1> | |||||
| <p class="text-muted"><%= H(originalName) %></p> | |||||
| <div class="row text-center g-3 mb-3"> | |||||
| <div class="col-6 col-md-3"><div class="border rounded p-3"><div class="display-6"><%= res("read") %></div><div class="small text-muted">Rows read</div></div></div> | |||||
| <div class="col-6 col-md-3"><div class="border rounded p-3 border-success"><div class="display-6 text-success"><%= res("added") %></div><div class="small text-muted">Added</div></div></div> | |||||
| <div class="col-6 col-md-3"><div class="border rounded p-3"><div class="display-6"><%= res("dup_db") + res("dup_file") %></div><div class="small text-muted">Duplicates skipped</div></div></div> | |||||
| <div class="col-6 col-md-3"><div class="border rounded p-3"><div class="display-6"><%= res("no_name") %></div><div class="small text-muted">No name</div></div></div> | |||||
| </div> | |||||
| <ul class="small text-muted"> | |||||
| <li><%= res("dup_db") %> already in the database, <%= res("dup_file") %> repeated within this file.</li> | |||||
| <li><%= res("new_industries") %> new industries created.</li> | |||||
| <% If markCustomers Then %><li>All added rows were flagged as previous customers.</li><% End If %> | |||||
| <li>Import batch #<%= res("batch_id") %></li> | |||||
| </ul> | |||||
| <% If res("dup_db") + res("dup_file") > 0 Then %> | |||||
| <h2 class="h6 mt-4">Skipped duplicates<% If res("dup_db") + res("dup_file") > res("dups").Count Then Response.Write " (first " & res("dups").Count & ")" %></h2> | |||||
| <table class="table table-sm small"> | |||||
| <thead><tr><th>File row</th><th>Business</th><th>Matched on</th></tr></thead> | |||||
| <tbody> | |||||
| <% Dim dupList, di, d : Set dupList = res("dups") %> | |||||
| <% For di = 0 To dupList.Count - 1 : d = dupList(di) %> | |||||
| <tr><td><%= d(0) %></td><td><%= H(d(1)) %></td><td><%= d(2) %></td></tr> | |||||
| <% Next %> | |||||
| </tbody> | |||||
| </table> | |||||
| <% End If %> | |||||
| <a href="/import" class="btn btn-primary">Import another file</a> | |||||
| </div> | |||||
| </div> | |||||
| <% End If %> | |||||
| @@ -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">Industries</h1> | |||||
| <span class="text-muted small"><%= list.Count %> industries</span> | |||||
| </div> | |||||
| <form method="post" action="/industries/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 industry</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…</th><th></th></tr> | |||||
| </thead> | |||||
| <tbody> | |||||
| <% Dim ii, row, oi | |||||
| For ii = 0 To list.Count - 1 | |||||
| Set row = list(ii) | |||||
| %> | |||||
| <tr> | |||||
| <td class="fw-semibold"><%= H(row("name")) %></td> | |||||
| <td class="text-end"><a href="/businesses?industry=<%= row("id") %>&status=all" class="text-decoration-none"><%= FormatNumber(row("n"), 0) %></a></td> | |||||
| <td> | |||||
| <form method="post" action="/industries/<%= 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="/industries/<%= row("id") %>/merge" class="d-flex gap-1 js-confirm" data-confirm="Merge "<%= H(row("name")) %>" into the selected industry? 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…</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="/industries/<%= row("id") %>/delete" class="d-inline js-confirm" data-confirm="Delete "<%= H(row("name")) %>"?"> | |||||
| <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 uncategorized > 0 Then %> | |||||
| <tr class="table-light"> | |||||
| <td class="fst-italic text-muted">(No industry)</td> | |||||
| <td class="text-end"><a href="/businesses?industry=0&status=all" class="text-decoration-none"><%= FormatNumber(uncategorized, 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> | |||||
| @@ -0,0 +1,77 @@ | |||||
| <% Flash().ShowErrorsIfPresent : Flash().ShowSuccessIfPresent %> | |||||
| <div class="d-flex justify-content-between align-items-center mb-3"> | |||||
| <div> | |||||
| <h1 class="h3 mb-0">Today</h1> | |||||
| <div class="text-muted small"><%= WeekdayName(Weekday(Date)) %>, <%= Date_Fmt(Date) %></div> | |||||
| </div> | |||||
| <a href="/businesses?contacted=never&show=prospects" class="btn btn-outline-primary btn-sm"><i class="bi bi-telephone-plus"></i> Find someone new to contact</a> | |||||
| </div> | |||||
| <% If overdue.Count = 0 And dueToday.Count = 0 Then %> | |||||
| <div class="alert alert-success"> | |||||
| <i class="bi bi-check-circle"></i> You're all caught up — nothing is due. | |||||
| <% If upcoming.Count > 0 Then %>There <% If upcoming.Count = 1 Then Response.Write "is 1 follow-up" Else Response.Write "are " & upcoming.Count & " follow-ups" %> coming up this week.<% End If %> | |||||
| </div> | |||||
| <% End If %> | |||||
| <% | |||||
| Dim groups(2), gi, g, gname, gclass, items, ri, rr, daysLate, lastLine | |||||
| Set groups(0) = overdue : Set groups(1) = dueToday : Set groups(2) = upcoming | |||||
| For gi = 0 To 2 | |||||
| Set items = groups(gi) | |||||
| If items.Count > 0 Then | |||||
| Select Case gi | |||||
| Case 0: gname = "Overdue" : gclass = "text-danger" | |||||
| Case 1: gname = "Due today" : gclass = "text-warning-emphasis" | |||||
| Case 2: gname = "Coming up (next 7 days)" : gclass = "text-secondary" | |||||
| End Select | |||||
| %> | |||||
| <h2 class="h5 mt-4 <%= gclass %>"><%= gname %> <span class="badge text-bg-light border"><%= items.Count %></span></h2> | |||||
| <div class="card shadow-sm mb-3"> | |||||
| <div class="list-group list-group-flush"> | |||||
| <% For ri = 0 To items.Count - 1 | |||||
| Set rr = items(ri) | |||||
| daysLate = DateDiff("d", CDate(rr("next_action_date")), Date) | |||||
| %> | |||||
| <div class="list-group-item"> | |||||
| <div class="row g-2 align-items-center"> | |||||
| <div class="col-md-5"> | |||||
| <a class="fw-semibold text-decoration-none" href="/businesses/<%= rr("id") %>"><%= H(rr("name")) %></a> | |||||
| <% If rr("is_customer") = 1 Then %><span class="badge text-bg-success ms-1">Customer</span><% End If %> | |||||
| <div class="small text-muted"> | |||||
| <%= H(rr("industry_name")) %> | |||||
| <% If Len(rr("city") & "") > 0 Then %><% If Len(rr("industry_name") & "") > 0 Then Response.Write " · " %><%= H(rr("city")) %><% End If %> | |||||
| <% If Len(rr("contact_name") & "") > 0 Then %> · <%= H(rr("contact_name")) %><% End If %> | |||||
| </div> | |||||
| </div> | |||||
| <div class="col-md-3 small"> | |||||
| <% If Len(rr("phone") & "") > 0 Then %><div><i class="bi bi-telephone"></i> <a href="tel:<%= H(rr("phone")) %>" class="text-decoration-none"><%= H(rr("phone")) %></a></div><% End If %> | |||||
| <% If Len(rr("email") & "") > 0 Then %><div class="text-truncate"><i class="bi bi-envelope"></i> <a href="mailto:<%= H(rr("email")) %>" class="text-decoration-none"><%= H(rr("email")) %></a></div><% End If %> | |||||
| </div> | |||||
| <div class="col-md-2 small"> | |||||
| <span class="<%= gclass %> fw-semibold"><%= Date_Fmt(rr("next_action_date")) %></span> | |||||
| <% If daysLate > 0 Then %><div class="text-danger"><%= daysLate %> day<% If daysLate <> 1 Then Response.Write "s" %> late</div> | |||||
| <% ElseIf daysLate < 0 Then %><div class="text-muted">in <%= -daysLate %> day<% If daysLate <> -1 Then Response.Write "s" %></div><% End If %> | |||||
| </div> | |||||
| <div class="col-md-2 text-md-end"> | |||||
| <a href="/businesses/<%= rr("id") %>" class="btn btn-primary btn-sm">Open</a> | |||||
| </div> | |||||
| </div> | |||||
| <% If Len(rr("last_method") & "") > 0 Then | |||||
| lastLine = Businesses_Label(Businesses_Methods(), rr("last_method")) | |||||
| If Len(rr("last_outcome") & "") > 0 Then lastLine = lastLine & " – " & H(Businesses_Label(Businesses_Outcomes(), rr("last_outcome"))) | |||||
| %> | |||||
| <div class="small text-muted mt-1"> | |||||
| Last: <%= Date_Fmt(rr("last_contacted_at")) %> · <%= lastLine %> | |||||
| <% If Len(rr("last_notes") & "") > 0 Then %> — <em><%= H(Left(Replace(Replace(rr("last_notes"), vbCr, " "), vbLf, " "), 140)) %><% If Len(rr("last_notes")) > 140 Then Response.Write "…" %></em><% End If %> | |||||
| </div> | |||||
| <% End If %> | |||||
| </div> | |||||
| <% Next %> | |||||
| </div> | |||||
| </div> | |||||
| <% | |||||
| End If | |||||
| Next | |||||
| %> | |||||
| @@ -0,0 +1,8 @@ | |||||
| </div> | |||||
| </main> | |||||
| <!-- Bootstrap bundle (with Popper) --> | |||||
| <script src="https://cdn.jsdelivr.net/npm/bootstrap@5.3.3/dist/js/bootstrap.bundle.min.js"></script> | |||||
| </body> | |||||
| </html> | |||||
| @@ -0,0 +1,86 @@ | |||||
| <!doctype html> | |||||
| <% | |||||
| Response.Charset = "utf-8" | |||||
| Response.CodePage = 65001 | |||||
| ' Safe title resolution | |||||
| Dim pageTitle | |||||
| If IsObject(CurrentController) Then | |||||
| On Error Resume Next | |||||
| pageTitle = CurrentController.Title | |||||
| If Err.Number <> 0 Then | |||||
| pageTitle = "RouteKit Classic ASP" | |||||
| Err.Clear | |||||
| End If | |||||
| On Error GoTo 0 | |||||
| End If | |||||
| If Len(pageTitle) = 0 Then pageTitle = "Classic ASP Starter Template" | |||||
| %> | |||||
| <html lang="en"> | |||||
| <head> | |||||
| <meta charset="utf-8" /> | |||||
| <title><%= pageTitle %></title> | |||||
| <meta name="viewport" content="width=device-width, initial-scale=1" /> | |||||
| <!-- Bootstrap CSS --> | |||||
| <link href="https://cdn.jsdelivr.net/npm/bootstrap@5.3.3/dist/css/bootstrap.min.css" rel="stylesheet" /> | |||||
| <!-- Bootstrap Icons (optional) --> | |||||
| <link href="https://cdn.jsdelivr.net/npm/bootstrap-icons@1.11.3/font/bootstrap-icons.css" rel="stylesheet" /> | |||||
| <!-- App CSS --> | |||||
| <link href="/css/site.css" rel="stylesheet" /> | |||||
| <style> | |||||
| body { | |||||
| background-color: #f5f5f5; | |||||
| } | |||||
| .rk-navbar-brand { | |||||
| font-weight: 600; | |||||
| letter-spacing: 0.03em; | |||||
| } | |||||
| main.routekit-main { | |||||
| padding-top: 1.5rem; | |||||
| padding-bottom: 2rem; | |||||
| } | |||||
| </style> | |||||
| </head> | |||||
| <body> | |||||
| <!-- Top navbar --> | |||||
| <nav class="navbar navbar-expand-lg navbar-dark bg-dark"> | |||||
| <div class="container-fluid"> | |||||
| <a class="navbar-brand rk-navbar-brand" href="/"> | |||||
| Prospecting | |||||
| </a> | |||||
| <button class="navbar-toggler" type="button" data-bs-toggle="collapse" data-bs-target="#rkMainNav" aria-controls="rkMainNav" aria-expanded="false" aria-label="Toggle navigation"> | |||||
| <span class="navbar-toggler-icon"></span> | |||||
| </button> | |||||
| <div class="collapse navbar-collapse" id="rkMainNav"> | |||||
| <ul class="navbar-nav me-auto mb-2 mb-lg-0"> | |||||
| <li class="nav-item"> | |||||
| <a class="nav-link" href="/">Today</a> | |||||
| </li> | |||||
| <li class="nav-item"> | |||||
| <a class="nav-link" href="/businesses">Businesses</a> | |||||
| </li> | |||||
| <li class="nav-item"> | |||||
| <a class="nav-link" href="/industries">Industries</a> | |||||
| </li> | |||||
| <li class="nav-item"> | |||||
| <a class="nav-link" href="/dashboard">Dashboard</a> | |||||
| </li> | |||||
| <li class="nav-item"> | |||||
| <a class="nav-link" href="/import">Import</a> | |||||
| </li> | |||||
| </ul> | |||||
| </div> | |||||
| </div> | |||||
| </nav> | |||||
| <!-- Main container for views --> | |||||
| <main class="routekit-main"> | |||||
| <div class="container"> | |||||
| <% Flash().ShowErrorsIfPresent : Flash().ShowSuccessIfPresent %> | |||||
| @@ -0,0 +1,23 @@ | |||||
| <!--#include file="../Core/helpers.asp"--> | |||||
| <!--#include file="../Core/lib.ErrorHandler.asp"--> | |||||
| <!--#include file="../Core/lib.ControllerRegistry.asp"--> | |||||
| <!--#include file="../Core/mvc.asp"--> | |||||
| <!--#include file="../Core/lib.DAL.asp"--> | |||||
| <!--#include file="../Core/lib.Data.asp"--> | |||||
| <!--#include file="../Core/lib.Migrations.asp"--> | |||||
| <% Dim router : Set router = GetObject("script:"& Server.MapPath("../Core/router.wsc") & "") %> | |||||
| <!--#include file="../Core/lib.collections.asp"--> | |||||
| <!--#include file="../Core/lib.HTML.asp"--> | |||||
| <!--#include file="../Core/lib.Routes.asp"--> | |||||
| <!--#include file="../Core/lib.Flash.asp"--> | |||||
| <!--#include file="../Core/lib.FormCache.asp"--> | |||||
| <!--#include file="../Core/lib.HTML.Security.asp"--> | |||||
| <!--#include file="../Core/lib.AutoMapper.asp"--> | |||||
| <!--#include file="../Core/lib.CDOEmail.asp"--> | |||||
| <!--#include file="../Core/lib.Upload.asp"--> | |||||
| <!--#include file="../Core/lib.json.asp"--> | |||||
| <!--#include file="../Core/lib.helpers.asp"--> | |||||
| <!--#include file="../Core/lib.crypto.helper.asp"--> | |||||
| <!--#include file="../Core/lib.Enumerable.asp"--> | |||||
| <!--#include file="../Core/lib.ad.auth.asp"--> | |||||
| <!--#include file="../Core/databaseConnection.asp"--> | |||||
| @@ -0,0 +1,127 @@ | |||||
| <% | |||||
| '------------------------------------------------------------------------------ | |||||
| ' DatabaseConnection.Class.inc | |||||
| ' A singleton VBScript "factory" for ADODB.Connection to multiple databases | |||||
| ' Enhanced with separate error handling for creation and open operations | |||||
| '------------------------------------------------------------------------------ | |||||
| ' Singleton holder | |||||
| Dim DatabaseConnection__Singleton | |||||
| Set DatabaseConnection__Singleton = Nothing | |||||
| ' Factory function | |||||
| Function DatabaseConnection() | |||||
| If DatabaseConnection__Singleton Is Nothing Then | |||||
| Set DatabaseConnection__Singleton = New DatabaseConnection_Class | |||||
| End If | |||||
| Set DatabaseConnection = DatabaseConnection__Singleton | |||||
| End Function | |||||
| '------------------------------------------------------------------------------ | |||||
| ' Class definition | |||||
| '------------------------------------------------------------------------------ | |||||
| Class DatabaseConnection_Class | |||||
| Private conn ' holds the ADODB.Connection instance | |||||
| '---------------------------------------- | |||||
| ' Connect to an Access (.mdb/.accdb) file | |||||
| '---------------------------------------- | |||||
| Public Function ConnectToAccessDatabase(dataSource, provider) | |||||
| If IsEmpty(provider) Or provider = "" Then | |||||
| provider = "Microsoft.Jet.OLEDB.4.0" | |||||
| End If | |||||
| Dim connStr | |||||
| connStr = "Provider=" & provider & ";" & _ | |||||
| "Data Source=" & dataSource & ";" & _ | |||||
| "Persist Security Info=False;" | |||||
| Set ConnectToAccessDatabase = Me.Connect(connStr) | |||||
| End Function | |||||
| '---------------------------------------- | |||||
| ' Connect to SQL Server | |||||
| '---------------------------------------- | |||||
| Public Function ConnectToSQLServer(server, database, uid, pwd, useTrusted) | |||||
| Dim connStr | |||||
| If useTrusted = True Then | |||||
| connStr = "Provider=SQLOLEDB;" & _ | |||||
| "Server=" & server & ";" & _ | |||||
| "Database=" & database & ";" & _ | |||||
| "Trusted_Connection=Yes;" | |||||
| Else | |||||
| connStr = "Provider=SQLOLEDB;" & _ | |||||
| "Server=" & server & ";" & _ | |||||
| "Database=" & database & ";" & _ | |||||
| "User ID=" & uid & ";" & _ | |||||
| "Password=" & pwd & ";" | |||||
| End If | |||||
| Set ConnectToSQLServer = Me.Connect(connStr) | |||||
| End Function | |||||
| '---------------------------------------- | |||||
| ' Connect via ODBC DSN | |||||
| '---------------------------------------- | |||||
| Public Function ConnectToODBC(dsnName, uid, pwd) | |||||
| Dim connStr | |||||
| connStr = "DSN=" & dsnName & ";" | |||||
| If Not IsEmpty(uid) Then connStr = connStr & "UID=" & uid & ";" | |||||
| If Not IsEmpty(pwd) Then connStr = connStr & "PWD=" & pwd & ";" | |||||
| Set ConnectToODBC = Me.Connect(connStr) | |||||
| End Function | |||||
| '---------------------------------------- | |||||
| ' Generic Connect: opens and returns an ADODB.Connection | |||||
| ' Includes separate handling for creation and open errors | |||||
| '---------------------------------------- | |||||
| Public Function Connect(connectionString) | |||||
| On Error Resume Next | |||||
| ' Dispose previous connection if any | |||||
| If Not conn Is Nothing Then | |||||
| conn.Close | |||||
| Set conn = Nothing | |||||
| End If | |||||
| ' Create ADO Connection object | |||||
| Set conn = Server.CreateObject("ADODB.Connection") | |||||
| If conn Is Nothing Then | |||||
| Err.Clear | |||||
| On Error GoTo 0 | |||||
| Err.Raise 50000, _ | |||||
| "DatabaseConnection_Class.Connect", _ | |||||
| "Could not create ADODB.Connection. Ensure ADO is installed and registered." | |||||
| End If | |||||
| ' Clear any prior errors before opening | |||||
| Err.Clear | |||||
| ' Open database connection | |||||
| conn.Open connectionString | |||||
| If Err.Number <> 0 Then | |||||
| Dim lastErrNum, lastErrDesc | |||||
| lastErrNum = Err.Number | |||||
| lastErrDesc = Err.Description | |||||
| Err.Clear | |||||
| On Error GoTo 0 | |||||
| Err.Raise lastErrNum, _ | |||||
| "DatabaseConnection_Class.Connect", _ | |||||
| "Failed to open connection (" & connectionString & _ | |||||
| ") - Error " & lastErrNum & ": " & lastErrDesc | |||||
| End If | |||||
| On Error GoTo 0 | |||||
| Set Connect = conn | |||||
| End Function | |||||
| '---------------------------------------- | |||||
| ' Close & clean up | |||||
| '---------------------------------------- | |||||
| Public Sub Close() | |||||
| On Error Resume Next | |||||
| If Not conn Is Nothing Then | |||||
| conn.Close | |||||
| Set conn = Nothing | |||||
| End If | |||||
| On Error GoTo 0 | |||||
| End Sub | |||||
| End Class | |||||
| %> | |||||
| @@ -0,0 +1,536 @@ | |||||
| <% | |||||
| Function QuoteValue(val) | |||||
| if IsWrappedInSingleQuotes(val) then | |||||
| QuoteValue = val | |||||
| Exit Function | |||||
| end if | |||||
| Select Case VarType(val) | |||||
| Case vbString | |||||
| QuoteValue = "'" & Replace(val, "'", "''") & "'" | |||||
| Case vbDate | |||||
| if conn.Provider = "Microsoft.Jet.OLEDB.4.0" or conn.Provider = "Microsoft.ACE.OLEDB.12.0" then | |||||
| QuoteValue = "#" & FormatDateTime(val, 0) & "#" | |||||
| else | |||||
| ' SQL Server | |||||
| QuoteValue = "'" & FormatDateTime(val, 0) & "'" | |||||
| end if | |||||
| Case vbNull, vbEmpty | |||||
| QuoteValue = "Null" | |||||
| Case vbBoolean | |||||
| ' Return boolean values without quotes | |||||
| QuoteValue = "'" & CStr(val) & "'" | |||||
| Case Else | |||||
| If IsNumeric(val) Then | |||||
| QuoteValue = CLng(val) | |||||
| Else | |||||
| QuoteValue = CStr(val) | |||||
| End If | |||||
| End Select | |||||
| End Function | |||||
| Public Function GetAppSetting(key) | |||||
| Dim cacheKey, xml, nodes, node, i | |||||
| cacheKey = "AppSetting_" & key | |||||
| ' Check Application cache first for performance | |||||
| If Not IsEmpty(Application(cacheKey)) Then | |||||
| GetAppSetting = Application(cacheKey) | |||||
| Exit Function | |||||
| End If | |||||
| ' Load from web.config only if not cached | |||||
| Set xml = Server.CreateObject("Microsoft.XMLDOM") | |||||
| xml.Load(Server.MapPath("web.config")) | |||||
| Set nodes = xml.selectNodes("//appSettings/add") | |||||
| For i = 0 To nodes.Length - 1 | |||||
| Set node = nodes.Item(i) | |||||
| If node.getAttribute("key") = key Then | |||||
| GetAppSetting = node.getAttribute("value") | |||||
| ' Cache the value for subsequent requests | |||||
| Application.Lock | |||||
| Application(cacheKey) = GetAppSetting | |||||
| Application.Unlock | |||||
| Exit Function | |||||
| End If | |||||
| Next | |||||
| GetAppSetting = "nothing" | |||||
| End Function | |||||
| Public Sub ShowServerVariables | |||||
| Dim varName, htmlTable | |||||
| htmlTable = "<table border='1' cellspacing='0' cellpadding='5'>" | |||||
| htmlTable = htmlTable & "<thead><tr><th>Variable Name</th><th>Value</th></tr></thead><tbody>" | |||||
| ' Loop through all server variables | |||||
| For Each varName In Request.ServerVariables | |||||
| htmlTable = htmlTable & "<tr>" | |||||
| htmlTable = htmlTable & "<td>" & Server.HTMLEncode(varName) & "</td>" | |||||
| htmlTable = htmlTable & "<td>" & Server.HTMLEncode(Request.ServerVariables(varName)) & "</td>" | |||||
| htmlTable = htmlTable & "</tr>" | |||||
| Next | |||||
| htmlTable = htmlTable & "</tbody></table>" | |||||
| ' Output the HTML table | |||||
| Response.Write(htmlTable) | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------ | |||||
| ' Utility: IIf Function for VBScript | |||||
| ' Usage: result = IIf(condition, trueValue, falseValue) | |||||
| '------------------------------------------------------------------------------ | |||||
| Function IIf(condition, trueValue, falseValue) | |||||
| On Error Resume Next | |||||
| If CBool(condition) Then | |||||
| IIf = trueValue | |||||
| Else | |||||
| IIf = falseValue | |||||
| End If | |||||
| If Err.Number <> 0 Then | |||||
| ' Optional: handle or log error in conversion/evaluation | |||||
| Err.Clear | |||||
| End If | |||||
| On Error GoTo 0 | |||||
| End Function | |||||
| '----------------------------- | |||||
| ' Utility: Generic Error Reporter | |||||
| '----------------------------- | |||||
| Public Sub ErrorCheck(context) | |||||
| If Err.Number <> 0 Then | |||||
| Dim errHtml | |||||
| errHtml = "<div style='padding:10px; border:2px solid red; background:#fdd; font-family:Verdana; font-size:12px;'>" | |||||
| errHtml = errHtml & "<strong>Error occurred" & IIf(Not IsEmpty(context) And context <> "", ": " & context, "") & "</strong><br />" | |||||
| errHtml = errHtml & "<em>Time:</em> " & Now() & "<br />" | |||||
| errHtml = errHtml & "<em>Number:</em> " & Err.Number & "<br />" | |||||
| errHtml = errHtml & "<em>Description:</em> " & Server.HTMLEncode(Err.Description) & "<br />" | |||||
| If Len(Err.Source) > 0 Then | |||||
| errHtml = errHtml & "<em>Source:</em> " & Server.HTMLEncode(Err.Source) & "<br />" | |||||
| End If | |||||
| errHtml = errHtml & "</div>" | |||||
| Response.Write errHtml | |||||
| Err.Clear | |||||
| End If | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------ | |||||
| ' Utility: TrimQueryParams | |||||
| ' Removes everything from the first "?" or "&" onward. | |||||
| ' Usage: | |||||
| ' CleanPath = TrimQueryParams(rawPath) | |||||
| '------------------------------------------------------------------------------ | |||||
| Function TrimQueryParams(rawPath) | |||||
| Dim posQ, posA, cutPos | |||||
| ' find the first occurrences of "?" and "&" | |||||
| posQ = InStr(rawPath, "?") | |||||
| posA = InStr(rawPath, "&") | |||||
| ' determine the earliest cut position (>0) | |||||
| If posQ > 0 And posA > 0 Then | |||||
| cutPos = IIf(posQ < posA, posQ, posA) | |||||
| ElseIf posQ > 0 Then | |||||
| cutPos = posQ | |||||
| ElseIf posA > 0 Then | |||||
| cutPos = posA | |||||
| Else | |||||
| cutPos = 0 | |||||
| End If | |||||
| ' if found, return up to just before that char | |||||
| If cutPos > 0 Then | |||||
| TrimQueryParams = Left(rawPath, cutPos - 1) | |||||
| Else | |||||
| TrimQueryParams = rawPath | |||||
| End If | |||||
| End Function | |||||
| Sub Destroy(o) | |||||
| if isobject(o) then | |||||
| if not o is nothing then | |||||
| on error resume next | |||||
| o.close | |||||
| on error goto 0 | |||||
| set o = nothing | |||||
| end if | |||||
| end if | |||||
| End Sub | |||||
| 'prepends indents | |||||
| Private Sub puti(v) | |||||
| put Spaces(m_indent) & v | |||||
| End Sub | |||||
| Sub put(v) | |||||
| Select Case typename(v) | |||||
| Case "LinkedList_Class" : response.write join(v.TO_Array, ", ") | |||||
| Case "DynamicArray_Class" : response.write JoinList(v) | |||||
| Case "Variant()" : response.write join(v, ", ") | |||||
| Case else : response.write v | |||||
| End Select | |||||
| End Sub | |||||
| Sub put_ | |||||
| put "<br>" | |||||
| End Sub | |||||
| Sub putl(v) | |||||
| put v | |||||
| put_ | |||||
| End Sub | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| 'Wrapper for Server.HTMLEncode() -- makes it easier on the eyes when reading the HTML code | |||||
| Function H(s) | |||||
| If Not IsEmpty(s) and Not IsNull(s) then | |||||
| H = Server.HTMLEncode(s) | |||||
| Else | |||||
| H = "" | |||||
| End If | |||||
| End Function | |||||
| '======================================================================================================================= | |||||
| ' Adapted from Tolerable library | |||||
| '======================================================================================================================= | |||||
| ' This subroutine allows us to ignore the difference | |||||
| ' between object and primitive assignments. This is | |||||
| ' essential for many parts of the engine. | |||||
| Public Sub Assign(ByRef var, ByVal val) | |||||
| If IsObject(val) Then | |||||
| Set var = val | |||||
| Else | |||||
| var = val | |||||
| End If | |||||
| End Sub | |||||
| ' This is similar to the ? : operator of other languages. | |||||
| ' Unfortunately, both the if_true and if_false "branches" | |||||
| ' will be evalauted before the condition is even checked. So, | |||||
| ' you'll only want to use this for simple expressions. | |||||
| Public Function Choice(ByVal cond, ByVal if_true, ByVal if_false) | |||||
| If cond Then | |||||
| Assign Choice, if_true | |||||
| Else | |||||
| Assign Choice, if_false | |||||
| End If | |||||
| End Function | |||||
| ' Allows single-quotes to be used in place of double-quotes. | |||||
| ' Basically, this is a cheap trick that can make it easier | |||||
| ' to specify Lambdas. | |||||
| Public Function Q(ByVal input) | |||||
| Q = Replace(input, "'", """") | |||||
| End Function | |||||
| Function SurroundString(inputVar) | |||||
| If VarType(inputVar) = vbString Then | |||||
| SurroundString = """" & inputVar & """" | |||||
| Else | |||||
| SurroundString = inputVar | |||||
| End If | |||||
| End Function | |||||
| Function SurroundStringInArray(arr) | |||||
| Dim i | |||||
| For i = LBound(arr) To UBound(arr) | |||||
| If IsString(arr(i)) Then | |||||
| arr(i) = """" & arr(i) & """" | |||||
| End If | |||||
| Next | |||||
| SurroundStringInArray = arr | |||||
| End Function | |||||
| '----------------------------------------------------------------------------------------------------------------------- | |||||
| 'Boolean type checkers | |||||
| 'Don't forget IsArray is built-in! | |||||
| Function IsString(value) | |||||
| IsString = Choice(typename(value) = "String", true, false) | |||||
| End Function | |||||
| Function IsDict(value) | |||||
| IsDict = Choice(typename(value) = "Dictionary", true, false) | |||||
| End Function | |||||
| Function IsRecordset(value) | |||||
| IsRecordset = Choice(typename(value) = "Recordset", true, false) | |||||
| End Function | |||||
| Function IsLinkedList(value) | |||||
| IsLinkedList = Choice(typename(value) = "LinkedList_Class", true, false) | |||||
| End Function | |||||
| Function IsArray(value) | |||||
| IsArray = Choice(typename(value) = "Variant()", true, false) | |||||
| End Function | |||||
| '-------------------------------------------------------------------- | |||||
| ' Returns True when the named key is present in Session.Contents | |||||
| ' • Handles scalars (String, Integer, etc.), objects, Empty, and Null | |||||
| '-------------------------------------------------------------------- | |||||
| Function SessionHasKey(keyName) | |||||
| 'Loop over the existing keys—Session.Contents is like a dictionary | |||||
| Dim k | |||||
| For Each k In Session.Contents | |||||
| If StrComp(k, keyName, vbTextCompare) = 0 Then | |||||
| SessionHasKey = True | |||||
| Exit Function | |||||
| End If | |||||
| Next | |||||
| SessionHasKey = False 'not found | |||||
| End Function | |||||
| Function RenderObjectsAsTable(arr,boolUseTabulator) | |||||
| Dim html, propNames, i, j, obj, val, pkName, isPk | |||||
| If IsEmpty(arr) Or Not IsArray(arr) Then | |||||
| RenderObjectsAsTable = "<!-- no data -->" | |||||
| Exit Function | |||||
| End If | |||||
| Set obj = arr(0) | |||||
| On Error Resume Next | |||||
| propNames = obj.Properties | |||||
| pkName = obj.PrimaryKey | |||||
| On Error GoTo 0 | |||||
| If IsEmpty(propNames) Or Len(pkName) = 0 Then | |||||
| RenderObjectsAsTable = "<!-- missing properties or primary key -->" | |||||
| Exit Function | |||||
| End If | |||||
| html = "<div class='table-wrapper'>" & vbCrLf | |||||
| html = html & "<table class='pobo-table' id='pobo-table'>" & vbCrLf | |||||
| html = html & " <thead><tr>" & vbCrLf | |||||
| For i = 0 To UBound(propNames) | |||||
| html = html & " <th>" & Server.HTMLEncode(propNames(i)) & "</th>" & vbCrLf | |||||
| Next | |||||
| html = html & " </tr></thead>" & vbCrLf | |||||
| html = html & " <tbody>" & vbCrLf | |||||
| For j = 0 To UBound(arr) | |||||
| Set obj = arr(j) | |||||
| html = html & " <tr>" & vbCrLf | |||||
| For i = 0 To UBound(propNames) | |||||
| val = GetDynamicProperty(obj, propNames(i)) | |||||
| isPk = (StrComp(propNames(i), pkName, vbTextCompare) = 0) | |||||
| If IsNull(val) Or IsEmpty(val) Then | |||||
| val = " " | |||||
| ElseIf IsDate(val) Then | |||||
| val = FormatDateTime(val, vbShortDate) | |||||
| ElseIf VarType(val) = vbBoolean Then | |||||
| val = IIf(val, "True", "False") | |||||
| Else | |||||
| val = CStr(val) | |||||
| Dim maxLen : maxLen = CInt(GetAppSetting("TableCellMaxLength")) | |||||
| If maxLen <= 0 Then maxLen = 90 | |||||
| If Len(val) > maxLen Then | |||||
| val = Left(val, maxLen - 3) & "..." | |||||
| End If | |||||
| val = Server.HTMLEncode(val) | |||||
| End If | |||||
| If isPk and boolUseTabulator = False Then | |||||
| val = "<a href=""" & obj.Tablename & "/edit/" & GetDynamicProperty(obj, pkName) & """ class=""table-link"">" & val & "</a>" | |||||
| End If | |||||
| html = html & " <td>" & val & "</td>" & vbCrLf | |||||
| Next | |||||
| html = html & " </tr>" & vbCrLf | |||||
| Next | |||||
| html = html & " </tbody>" & vbCrLf & "</table>" & vbCrLf & "</div>" | |||||
| RenderObjectsAsTable = html | |||||
| End Function | |||||
| Function RenderFormFromObject(obj) | |||||
| Dim html, propNames, i, name, val, inputType | |||||
| Dim pkName, tableName, checkedAttr | |||||
| On Error Resume Next | |||||
| propNames = obj.Properties | |||||
| pkName = obj.PrimaryKey | |||||
| tableName = obj.TableName | |||||
| On Error GoTo 0 | |||||
| If IsEmpty(propNames) Or Len(pkName) = 0 Then | |||||
| RenderFormFromObject = "<!-- Invalid object -->" | |||||
| Exit Function | |||||
| End If | |||||
| html = "<form method='post' action='/" & tableName & "/save' class='article-content'>" & vbCrLf | |||||
| For i = 0 To UBound(propNames) | |||||
| name = propNames(i) | |||||
| val = GetDynamicProperty(obj, name) | |||||
| ' Handle nulls | |||||
| If IsNull(val) Then val = "" | |||||
| ' Primary key → hidden input | |||||
| If StrComp(name, pkName, vbTextCompare) = 0 Then | |||||
| html = html & " <input type='hidden' name='" & name & "' value='" & Server.HTMLEncode(val) & "' />" & vbCrLf | |||||
| 'Continue For | |||||
| End If | |||||
| html = html & " <div class='form-group'>" & vbCrLf | |||||
| html = html & " <label for='" & name & "'>" & name & "</label>" & vbCrLf | |||||
| Select Case True | |||||
| Case VarType(val) = vbBoolean | |||||
| checkedAttr = "" | |||||
| If val = True Then checkedAttr = " checked" | |||||
| html = html & " <input type='checkbox' class='form-check-input' name='" & name & "' id='" & name & "' value='true'" & checkedAttr & " />" & vbCrLf | |||||
| Case IsDate(val) | |||||
| html = html & " <input type='date' class='form-control' name='" & name & "' id='" & name & "' value='" & FormatDateForInput(val) & "' />" & vbCrLf | |||||
| Case IsNumeric(val) | |||||
| html = html & " <input type='number' class='form-control' name='" & name & "' id='" & name & "' value='" & val & "' />" & vbCrLf | |||||
| Case Len(val) > CInt(GetAppSetting("FormTextareaThreshold")) | |||||
| html = html & " <textarea class='form-control' name='" & name & "' id='" & name & "' rows='6'>" & Server.HTMLEncode(val) & "</textarea>" & vbCrLf | |||||
| Case Else | |||||
| html = html & " <input type='text' class='form-control' name='" & name & "' id='" & name & "' value='" & Server.HTMLEncode(val) & "' />" & vbCrLf | |||||
| End Select | |||||
| html = html & " </div>" & vbCrLf | |||||
| Next | |||||
| html = html & " <button type='submit' class='btn btn-primary btn-lg'>Save</button>" & vbCrLf | |||||
| html = html & "</form>" & vbCrLf | |||||
| RenderFormFromObject = html | |||||
| End Function | |||||
| Function GetDynamicProperty(obj, propName) | |||||
| On Error Resume Next | |||||
| Dim result | |||||
| Execute "result = obj." & propName | |||||
| If Err.Number <> 0 Then | |||||
| result = "" | |||||
| Err.Clear | |||||
| End If | |||||
| GetDynamicProperty = result | |||||
| On Error GoTo 0 | |||||
| End Function | |||||
| Function FormatDateForInput(val) | |||||
| If IsDate(val) Then | |||||
| Dim yyyy, mm, dd | |||||
| yyyy = Year(val) | |||||
| mm = Right("0" & Month(val), 2) | |||||
| dd = Right("0" & Day(val), 2) | |||||
| FormatDateForInput = yyyy & "-" & mm & "-" & dd | |||||
| Else | |||||
| FormatDateForInput = "" | |||||
| End If | |||||
| End Function | |||||
| '------------------------------------------------------------- | |||||
| ' Returns obj.<propName> for any public VBScript class property | |||||
| '------------------------------------------------------------- | |||||
| Function GetObjProp(o, pName) | |||||
| Dim tmp | |||||
| ' Build a tiny statement like: tmp = o.UserID | |||||
| Execute "tmp = o." & pName | |||||
| GetObjProp = tmp | |||||
| End Function | |||||
| Function GenerateSlug(title) | |||||
| Dim slug | |||||
| slug = LCase(title) ' Convert to lowercase | |||||
| slug = Replace(slug, "&", "and") ' Replace ampersands | |||||
| slug = Replace(slug, "'", "") ' Remove apostrophes | |||||
| slug = Replace(slug, """", "") ' Remove quotes | |||||
| slug = Replace(slug, "–", "-") ' Replace en dash | |||||
| slug = Replace(slug, "—", "-") ' Replace em dash | |||||
| slug = Replace(slug, "/", "-") ' Replace slashes | |||||
| slug = Replace(slug, "\", "-") ' Replace backslashes | |||||
| ' Remove all non-alphanumeric and non-hyphen/space characters | |||||
| Dim i, ch, clean | |||||
| clean = "" | |||||
| For i = 1 To Len(slug) | |||||
| ch = Mid(slug, i, 1) | |||||
| If (ch >= "a" And ch <= "z") Or (ch >= "0" And ch <= "9") Or ch = " " Or ch = "-" Then | |||||
| clean = clean & ch | |||||
| End If | |||||
| Next | |||||
| ' Replace multiple spaces or hyphens with single hyphen | |||||
| Do While InStr(clean, " ") > 0 | |||||
| clean = Replace(clean, " ", " ") | |||||
| Loop | |||||
| clean = Replace(clean, " ", "-") | |||||
| Do While InStr(clean, "--") > 0 | |||||
| clean = Replace(clean, "--", "-") | |||||
| Loop | |||||
| ' Trim leading/trailing hyphens | |||||
| Do While Left(clean, 1) = "-" | |||||
| clean = Mid(clean, 2) | |||||
| Loop | |||||
| Do While Right(clean, 1) = "-" | |||||
| clean = Left(clean, Len(clean) - 1) | |||||
| Loop | |||||
| GenerateSlug = clean | |||||
| End Function | |||||
| Function GetRawJsonFromRequest() | |||||
| Dim stream, rawJson | |||||
| Set stream = Server.CreateObject("ADODB.Stream") | |||||
| stream.Type = 1 ' adTypeBinary | |||||
| stream.Open | |||||
| stream.Write Request.BinaryRead(Request.TotalBytes) | |||||
| stream.Position = 0 | |||||
| stream.Type = 2 ' adTypeText | |||||
| stream.Charset = "utf-8" | |||||
| rawJson = stream.ReadText | |||||
| stream.Close | |||||
| Set stream = Nothing | |||||
| GetRawJsonFromRequest = rawJson | |||||
| End Function | |||||
| Function Active(controllerName) | |||||
| On Error Resume Next | |||||
| If Replace(Lcase(router.Resolve(Request.ServerVariables("REQUEST_METHOD"), TrimQueryParams(Request.ServerVariables("HTTP_X_ORIGINAL_URL")))(0)),"controller","") = LCase(controllerName) Then | |||||
| Active = "active" | |||||
| Else | |||||
| Active = "" | |||||
| End If | |||||
| On Error GoTo 0 | |||||
| End Function | |||||
| '==================================================================== | |||||
| ' FormatDateForSql | |||||
| ' Converts a VBScript Date to a SQL Server-compatible string | |||||
| ' Output: 'YYYY-MM-DD HH:MM:SS' | |||||
| '==================================================================== | |||||
| Function FormatDateForSql(vbDate) | |||||
| If IsNull(vbDate) Or vbDate = "" Then | |||||
| FormatDateForSql = "NULL" | |||||
| Exit Function | |||||
| End If | |||||
| ' Ensure vbDate is a valid date | |||||
| If Not IsDate(vbDate) Then | |||||
| Err.Raise vbObjectError + 1000, "FormatDateForSql", "Invalid date: " & vbDate | |||||
| End If | |||||
| Dim yyyy, mm, dd, hh, nn, ss | |||||
| yyyy = Year(vbDate) | |||||
| mm = Right("0" & Month(vbDate), 2) | |||||
| dd = Right("0" & Day(vbDate), 2) | |||||
| hh = Right("0" & Hour(vbDate), 2) | |||||
| nn = Right("0" & Minute(vbDate), 2) | |||||
| ss = Right("0" & Second(vbDate), 2) | |||||
| ' Construct SQL Server datetime literal | |||||
| FormatDateForSql = "'" & yyyy & "-" & mm & "-" & dd & " " & hh & ":" & nn & ":" & ss & "'" | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,159 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' AUTOMAPPER CLASS | |||||
| '======================================================================================================================= | |||||
| 'Side Effects: Since src and target are passed ByRef to reduce unnecessary copying, if src is a recordset then the | |||||
| ' current record pointer is modified using src.MoveFirst and src.MoveNext. The end result is the current | |||||
| ' record pointer ends the operation at src.EOF. | |||||
| Class Automapper_Class | |||||
| Private m_src | |||||
| Private m_target | |||||
| Private m_statements | |||||
| Private m_statements_count | |||||
| Private Property Get Src : set Src = m_src : End Property | |||||
| Private Property Get Target : set Target = m_target : End Property | |||||
| Private Sub Class_Initialize | |||||
| m_statements_count = -1 | |||||
| ReDim m_statements(-1) | |||||
| End Sub | |||||
| Private Sub ResetState | |||||
| m_statements_count = -1 | |||||
| ReDim m_statements(-1) | |||||
| Set m_src = Nothing | |||||
| Set m_target = Nothing | |||||
| End Sub | |||||
| 'Maps all rs or object fields to corresponding fields in the specified class. | |||||
| Public Function AutoMap(src_obj, target_obj) | |||||
| Set AutoMap = FlexMap(src_obj, target_obj, empty) | |||||
| End Function | |||||
| 'Only maps fields specified in the field_names array (array of strings). | |||||
| 'If field_names is empty, attempts to map all fields from the passed rs or object. | |||||
| Public Function FlexMap(src_obj, target_obj, field_names) | |||||
| Set FlexMap = DynMap(src_obj, target_obj, field_names, empty) | |||||
| End Function | |||||
| 'Only maps fields specified in the field_names array (array of strings). | |||||
| 'If field_names is empty then src MUST be a recordset as it attempts to map all fields from the recordset. | |||||
| 'Since there is no reflection in vbscript, there is no way around this short of pseudo-reflection. | |||||
| Public Function DynMap(src_obj, target_obj, field_names, exprs) | |||||
| SetSource src_obj | |||||
| SetTarget target_obj | |||||
| dim field_name | |||||
| dim field_idx 'loop counter | |||||
| if IsEmpty(field_names) then 'map everything | |||||
| if typename(src_obj) = "Recordset" then | |||||
| for field_idx = 0 to src_obj.Fields.Count - 1 | |||||
| field_name = src_obj.Fields.Item(field_idx).Name | |||||
| 'AddStatement field_name | |||||
| AddStatement BuildStatement(field_name) | |||||
| next | |||||
| elseif InStr(typename(src_obj), "Dictionary") > 0 then 'enables Scripting.Dictionary and IRequestDictionary for Request.Querystring and Request.Form | |||||
| for each field_name in src_obj | |||||
| AddStatement BuildStatement(field_name) | |||||
| next | |||||
| elseif not IsEmpty(src_obj.Class_Get_Properties) then | |||||
| dim props : props = src_obj.Class_Get_Properties | |||||
| for field_idx = 0 to ubound(props) | |||||
| field_name = props(field_idx) | |||||
| 'AddStatement field_name | |||||
| AddStatement BuildStatement(field_name) | |||||
| next | |||||
| else 'some invalid type of object | |||||
| Err.Raise 9, "Automapper.DynMap", "Cannot automatically map this source object. Expected recordset or object implementing Class_Get_Properties reflection, got: " & typename(src_obj) | |||||
| end if | |||||
| else 'map only specified fields | |||||
| for field_idx = lbound(field_names) to ubound(field_names) | |||||
| field_name = field_names(field_idx) | |||||
| 'AddStatement field_name | |||||
| AddStatement BuildStatement(field_name) | |||||
| next | |||||
| end if | |||||
| dim exprs_idx | |||||
| if not IsEmpty(exprs) then | |||||
| if typename(exprs) = "Variant()" then | |||||
| for exprs_idx = lbound(exprs) to ubound(exprs) | |||||
| 'field_name = exprs(exprs_idx) | |||||
| 'AddStatement field_name | |||||
| AddStatement exprs(exprs_idx) | |||||
| next | |||||
| else 'assume string or string-like default value | |||||
| AddStatement exprs | |||||
| end if | |||||
| end if | |||||
| 'Can't pre-join the statements because if one fails the rest of them fail too... :( | |||||
| 'dim joined_statements : joined_statements = Join(m_statements, " : ") | |||||
| 'put joined_statements | |||||
| 'suspend errors to prevent failing when attempting to map a field that does not exist in the class | |||||
| on error resume next | |||||
| dim stmt_idx | |||||
| for stmt_idx = 0 to ubound(m_statements) | |||||
| Execute m_statements(stmt_idx) | |||||
| next | |||||
| on error goto 0 | |||||
| set DynMap = m_target | |||||
| ResetState | |||||
| End Function | |||||
| Private Sub SetSource(ByVal src_obj) | |||||
| set m_src = src_obj | |||||
| End Sub | |||||
| Private Sub SetTarget(ByVal target_obj) | |||||
| if typename(target_obj) = "String" then | |||||
| set m_target = eval("new " & target_obj) | |||||
| else | |||||
| set m_target = target_obj | |||||
| end if | |||||
| End Sub | |||||
| 'Builds a statement and adds it to the internal statements array | |||||
| Private Sub AddStatement(ByVal stmt) | |||||
| m_statements_count = m_statements_count + 1 | |||||
| ReDim Preserve m_statements(m_statements_count) | |||||
| m_statements(m_statements_count) = stmt | |||||
| End Sub | |||||
| Private Function BuildStatement(ByVal field_name) | |||||
| dim result | |||||
| if typename(m_src) = "Recordset" or InStr(typename(m_src), "Dictionary") > 0 then | |||||
| result = "m_target." & field_name & " = m_src(""" & field_name & """)" | |||||
| else | |||||
| 'Funky magic... | |||||
| 'If src.field_name is an object, ensure the set statement is used | |||||
| if IsObject(eval("m_src." & field_name)) then | |||||
| result = "set " | |||||
| else | |||||
| 'result = "m_target." & field_name & " = m_src." & field_name | |||||
| end if | |||||
| result = result & " m_target." & field_name & " = m_src." & field_name | |||||
| end if | |||||
| BuildStatement = result | |||||
| End Function | |||||
| End Class | |||||
| Function Automapper() | |||||
| Set Automapper = new Automapper_Class | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,155 @@ | |||||
| <% | |||||
| ' Class: CDOEmail | |||||
| ' Handles email creation and sending via CDO in VBScript | |||||
| Class CDOEmail_Class | |||||
| ' Public properties | |||||
| Public From | |||||
| Public Subject | |||||
| Public Body | |||||
| Public IsBodyHTML | |||||
| Public SMTPServer | |||||
| Public SMTPPort | |||||
| Public SMTPUsername | |||||
| Public SMTPPassword | |||||
| Public SMTPUseSSL | |||||
| ' Private members | |||||
| Private cfg | |||||
| Private msg | |||||
| Private dictRecipients | |||||
| Private arrAttachments | |||||
| ' Initialize default values and objects | |||||
| Private Sub Class_Initialize() | |||||
| ' Create CDO configuration and message objects | |||||
| Set cfg = Server.CreateObject("CDO.Configuration") | |||||
| Set msg = Server.CreateObject("CDO.Message") | |||||
| ' Default SMTP settings | |||||
| SMTPServer = "localhost" | |||||
| SMTPPort = 25 | |||||
| SMTPUsername = "" | |||||
| SMTPPassword = "" | |||||
| SMTPUseSSL = False | |||||
| ' Initialize recipient collections | |||||
| Set dictRecipients = Server.CreateObject("Scripting.Dictionary") | |||||
| dictRecipients.Add "TO", Array() | |||||
| dictRecipients.Add "CC", Array() | |||||
| dictRecipients.Add "BCC", Array() | |||||
| ' Initialize attachments dynamic array | |||||
| ReDim arrAttachments(-1) | |||||
| ' Default message settings | |||||
| From = "" | |||||
| Subject = "" | |||||
| Body = "" | |||||
| IsBodyHTML = False | |||||
| End Sub | |||||
| ' Add a recipient by type: "To", "Cc", or "Bcc" | |||||
| Public Sub AddRecipient(recipientType, address) | |||||
| Dim key, tmp | |||||
| key = UCase(recipientType) | |||||
| If Not dictRecipients.Exists(key) Then | |||||
| Err.Raise vbObjectError + 1000, "CDOEmail", "Invalid recipient type: " & recipientType | |||||
| End If | |||||
| tmp = dictRecipients(key) | |||||
| If UBound(tmp) < LBound(tmp) Then | |||||
| ReDim tmp(0) | |||||
| Else | |||||
| ReDim Preserve tmp(UBound(tmp) + 1) | |||||
| End If | |||||
| tmp(UBound(tmp)) = address | |||||
| dictRecipients(key) = tmp | |||||
| End Sub | |||||
| ' Add a file attachment | |||||
| Public Sub AddAttachment(filePath) | |||||
| If UBound(arrAttachments) < LBound(arrAttachments) Then | |||||
| ReDim arrAttachments(0) | |||||
| Else | |||||
| ReDim Preserve arrAttachments(UBound(arrAttachments) + 1) | |||||
| End If | |||||
| arrAttachments(UBound(arrAttachments)) = filePath | |||||
| End Sub | |||||
| ' Send the email, returning True on success, False on failure | |||||
| Public Function Send() | |||||
| ' Configure SMTP settings | |||||
| With cfg.Fields | |||||
| .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 ' cdoSendUsingPort | |||||
| .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPServer | |||||
| .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTPPort | |||||
| .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = Choice(Len(SMTPUsername) > 0, 1, 0) ' cdoBasic or cdoAnonymous | |||||
| .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = SMTPUsername | |||||
| .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = SMTPPassword | |||||
| .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = SMTPUseSSL | |||||
| .Update | |||||
| End With | |||||
| ' Apply configuration to message | |||||
| Set msg.Configuration = cfg | |||||
| ' Populate message fields | |||||
| msg.From = From | |||||
| msg.Subject = Subject | |||||
| If dictRecipients.Exists("TO") And UBound(dictRecipients("TO")) >= LBound(dictRecipients("TO")) Then | |||||
| msg.To = Join(dictRecipients("TO"), ";") | |||||
| End If | |||||
| If dictRecipients.Exists("CC") And UBound(dictRecipients("CC")) >= LBound(dictRecipients("CC")) Then | |||||
| msg.CC = Join(dictRecipients("CC"), ";") | |||||
| End If | |||||
| If dictRecipients.Exists("BCC") And UBound(dictRecipients("BCC")) >= LBound(dictRecipients("BCC")) Then | |||||
| msg.BCC = Join(dictRecipients("BCC"), ";") | |||||
| End If | |||||
| If IsBodyHTML Then | |||||
| msg.HTMLBody = Body | |||||
| Else | |||||
| msg.TextBody = Body | |||||
| End If | |||||
| ' Add attachments if any | |||||
| Dim i | |||||
| For i = LBound(arrAttachments) To UBound(arrAttachments) | |||||
| msg.AddAttachment arrAttachments(i) | |||||
| Next | |||||
| ' Send and handle errors | |||||
| On Error Resume Next | |||||
| msg.Send | |||||
| errNum = Err.Number | |||||
| errDesc = Err.Description | |||||
| On Error Goto 0 | |||||
| If Err.Number <> 0 Then | |||||
| Response.Write "CDO Error #" & errNum & ": " & errDesc & "<br/>" | |||||
| Send = False | |||||
| Err.Clear | |||||
| Else | |||||
| Send = True | |||||
| End If | |||||
| End Function | |||||
| ' Clean up objects | |||||
| Private Sub Class_Terminate() | |||||
| On Error Resume Next | |||||
| Set msg = Nothing | |||||
| Set cfg = Nothing | |||||
| Set dictRecipients = Nothing | |||||
| Erase arrAttachments | |||||
| End Sub | |||||
| End Class | |||||
| dim CDOEmail_Class__Singleton | |||||
| Function CDOEmail() | |||||
| if IsEmpty(CDOEmail_Class__Singleton) then | |||||
| set CDOEmail_Class__Singleton = new CDOEmail_Class | |||||
| end if | |||||
| set CDOEmail = CDOEmail_Class__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,914 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' KVArray | |||||
| ' Relatively painless implementation of key/value pair arrays without requiring a full Scripting.Dictionary COM instance. | |||||
| ' A KVArray is a standard array where element i is the key and element i+1 is the value. Loops must step by 2. | |||||
| '======================================================================================================================= | |||||
| 'given a KVArray and key index, returns the key and value | |||||
| 'pre: kv_array has at least key_idx and key_idx + 1 values | |||||
| 'post: key and val are populated | |||||
| Sub KeyVal(kv_array, key_idx, ByRef key, ByRef val) | |||||
| if (key_idx + 1 > ubound(kv_array)) then err.raise 1, "KeyVal", "expected key_idx < " & ubound(kv_array) - 1 & ", got: " & key_idx | |||||
| key = kv_array(key_idx) | |||||
| val = kv_array(key_idx + 1) | |||||
| End Sub | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| 'Given a KVArray, a key and a value, appends the key and value to the end of the KVArray | |||||
| Sub KVAppend(ByRef kv_array, key, val) | |||||
| dim i : i = ubound(kv_array) | |||||
| redim preserve kv_array(i + 2) | |||||
| kv_array(i + 1) = key | |||||
| kv_array(i + 2) = val | |||||
| End Sub | |||||
| '----------------------------------------------------------------------------------------------------------------------- | |||||
| 'Given a KVArray and two variants, populates the first variant with all keys and the second variant with all values. | |||||
| 'If | |||||
| 'Pre: kv_array has at least key_idx and key_idx + 1 values | |||||
| 'Post: key_array contains all keys in kvarray. | |||||
| ' val_array contains all values in kvarray. | |||||
| ' key_array and val_array values are in corresponding order, i.e. key_array(i) corresponds to val_array(i). | |||||
| Sub KVUnzip(kv_array, key_array, val_array) | |||||
| dim kv_array_size : kv_array_size = ubound(kv_array) | |||||
| dim num_pairs : num_pairs = (kv_array_size + 1) / 2 | |||||
| dim result_array_size : result_array_size = num_pairs - 1 | |||||
| 'Extend existing key_array or create new array to hold the keys | |||||
| If IsArray(key_array) then | |||||
| redim preserve key_array(ubound(key_array) + result_array_size) | |||||
| Else | |||||
| key_array = Array() | |||||
| redim key_array(result_array_size) | |||||
| End If | |||||
| 'Extend existing val array or create new array to hold the values | |||||
| If IsArray(val_array) then | |||||
| redim preserve val_array(ubound(val_array) + result_array_size) | |||||
| Else | |||||
| val_array = Array() | |||||
| redim val_array(num_pairs - 1) | |||||
| End If | |||||
| 'Unzip the KVArray into the two output arrays | |||||
| dim i, key, val | |||||
| dim key_val_arrays_idx : key_val_arrays_idx = 0 ' used to sync loading the key_array and val_array | |||||
| For i = 0 to ubound(kv_array) step 2 | |||||
| KeyVal kv_array, i, key, val | |||||
| key_array(key_val_arrays_idx) = key | |||||
| val_array(key_val_arrays_idx) = val | |||||
| key_val_arrays_idx = key_val_arrays_idx + 1 ' increment by 1 because loop goes to next pair in kv_array | |||||
| Next | |||||
| End Sub | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| 'Given a KVArray, dumps it to the screen. Useful for debugging purposes. | |||||
| Sub DumpKVArray(kv_array) | |||||
| dim i, key, val | |||||
| For i = 0 to ubound(kv_array) step 2 | |||||
| KeyVal kv_array, i, key, val | |||||
| put key & " => " & val & "<br>" | |||||
| Next | |||||
| End Sub | |||||
| '======================================================================================================================= | |||||
| ' Pair Class | |||||
| ' Holds a pair of values, i.e. a key value pair, recordset field name/value pair, etc. | |||||
| ' Similar to the C++ STL std::pair class. Useful for some iteration and the like. | |||||
| ' | |||||
| ' This was an interesting idea but so far has not really been used, oh well...... | |||||
| '======================================================================================================================= | |||||
| Class Pair_Class | |||||
| Private m_first, m_second | |||||
| Public Property Get First : First = m_first : End Property | |||||
| Public Property Get [Second] : [Second] = m_second : End Property | |||||
| Public Default Property Get TO_String | |||||
| TO_String = First & " " & [Second] | |||||
| End Property | |||||
| Public Sub Initialize(ByVal firstval, ByVal secondval) | |||||
| Assign m_first, firstval | |||||
| Assign m_second, secondval | |||||
| End Sub | |||||
| 'Swaps the two values | |||||
| Public Sub Swap | |||||
| dim tmp | |||||
| Assign tmp, m_second | |||||
| Assign m_second, m_first | |||||
| Assign m_first, tmp | |||||
| End Sub | |||||
| End Class | |||||
| Function MakePair(ByVal firstval, ByVal secondval) | |||||
| dim P : set P = new Pair_Class | |||||
| P.Initialize firstval, secondval | |||||
| set MakePair = P | |||||
| End Function | |||||
| '======================================================================================================================= | |||||
| ' Linked List - From the Tolerable lib | |||||
| '======================================================================================================================= | |||||
| ' This is just here for reference | |||||
| Class Iterator_Class | |||||
| Public Function HasNext() | |||||
| End Function | |||||
| Public Function PeekNext() | |||||
| End Function | |||||
| Public Function GetNext() | |||||
| End Function | |||||
| Public Function HasPrev() | |||||
| End Function | |||||
| Public Function PeekPrev() | |||||
| End Function | |||||
| Public Function GetPrev() | |||||
| End Function | |||||
| End Class | |||||
| Class Enumerator_Source_Iterator_Class | |||||
| Private m_iter | |||||
| Public Sub Initialize(ByVal iter) | |||||
| Set m_iter = iter | |||||
| End Sub | |||||
| Private Sub Class_Terminate() | |||||
| Set m_iter = Nothing | |||||
| End Sub | |||||
| Public Sub GetNext(ByRef retval, ByRef successful) | |||||
| If m_iter.HasNext Then | |||||
| Assign retval, m_iter.GetNext | |||||
| successful = True | |||||
| Else | |||||
| successful = False | |||||
| End If | |||||
| End Sub | |||||
| End Class | |||||
| Public Function En_Iterator(ByVal iter) | |||||
| Dim retval | |||||
| Set retval = New Enumerator_Source_Iterator_Class | |||||
| retval.Initialize iter | |||||
| Set En_Iterator = Enumerator(retval) | |||||
| End Function | |||||
| Class LinkedList_Node_Class | |||||
| Public m_prev | |||||
| Public m_next | |||||
| Public m_value | |||||
| Private Sub Class_Initialize() | |||||
| Set m_prev = Nothing | |||||
| Set m_next = Nothing | |||||
| End Sub | |||||
| Private Sub Class_Terminate() | |||||
| Set m_prev = Nothing | |||||
| Set m_next = Nothing | |||||
| Set m_value = Nothing | |||||
| End Sub | |||||
| Public Sub SetValue(ByVal value) | |||||
| Assign m_value, value | |||||
| End Sub | |||||
| End Class | |||||
| Class Iterator_LinkedList_Class | |||||
| Private m_left | |||||
| Private m_right | |||||
| Public Sub Initialize(ByVal r) | |||||
| Set m_left = Nothing | |||||
| Set m_right = r | |||||
| End Sub | |||||
| Private Sub Class_Terminate() | |||||
| Set m_Left = Nothing | |||||
| Set m_Right = Nothing | |||||
| End Sub | |||||
| Public Function HasNext() | |||||
| HasNext = Not(m_right Is Nothing) | |||||
| End Function | |||||
| Public Function PeekNext() | |||||
| Assign PeekNext, m_right.m_value | |||||
| End Function | |||||
| Public Function GetNext() | |||||
| Assign GetNext, m_right.m_value | |||||
| Set m_left = m_right | |||||
| Set m_right = m_right.m_next | |||||
| End Function | |||||
| Public Function HasPrev() | |||||
| HasPrev = Not(m_left Is Nothing) | |||||
| End Function | |||||
| Public Function PeekPrev() | |||||
| Assign PeekPrev, m_left.m_value | |||||
| End Function | |||||
| Public Function GetPrev() | |||||
| Assign GetPrev, m_left.m_value | |||||
| Set m_right = m_left | |||||
| Set m_left = m_left.m_prev | |||||
| End Function | |||||
| End Class | |||||
| '----------------------------------------------------------------------------------------------------------------------- | |||||
| Class LinkedList_Class | |||||
| Private m_first | |||||
| Private m_last | |||||
| Private m_size | |||||
| Private Sub Class_Initialize() | |||||
| Me.Reset | |||||
| End Sub | |||||
| Private Sub Class_Terminate() | |||||
| Me.Reset | |||||
| End Sub | |||||
| Public Function Clear() | |||||
| Set m_first = Nothing | |||||
| Set m_last = Nothing | |||||
| m_size = 0 | |||||
| Set Clear = Me | |||||
| End Function | |||||
| Private Function NewNode(ByVal value) | |||||
| Dim retval | |||||
| Set retval = New LinkedList_Node_Class | |||||
| retval.SetValue value | |||||
| Set NewNode = retval | |||||
| End Function | |||||
| Public Sub Reset() | |||||
| Set m_first = Nothing | |||||
| Set m_last = Nothing | |||||
| m_size = 0 | |||||
| End Sub | |||||
| Public Function IsEmpty() | |||||
| IsEmpty = (m_last Is Nothing) | |||||
| End Function | |||||
| Public Property Get Count | |||||
| Count = m_size | |||||
| End Property | |||||
| 'I just like .Size better than .Count sometimes, sue me | |||||
| Public Property Get Size | |||||
| Size = m_size | |||||
| End Property | |||||
| Public Function Iterator() | |||||
| Dim retval | |||||
| Set retval = New Iterator_LinkedList_Class | |||||
| retval.Initialize m_first | |||||
| Set Iterator = retval | |||||
| End Function | |||||
| Public Function Push(ByVal value) | |||||
| Dim temp | |||||
| Set temp = NewNode(value) | |||||
| If Me.IsEmpty Then | |||||
| Set m_first = temp | |||||
| Set m_last = temp | |||||
| Else | |||||
| Set temp.m_prev = m_last | |||||
| Set m_last.m_next = temp | |||||
| Set m_last = temp | |||||
| End If | |||||
| m_size = m_size + 1 | |||||
| Set Push = Me | |||||
| End Function | |||||
| Public Function Peek() | |||||
| ' TODO: Error handling | |||||
| Assign Peek, m_last.m_value | |||||
| End Function | |||||
| ' Alias for Peek | |||||
| Public Function Back() | |||||
| ' TODO: Error handling | |||||
| Assign Back, m_last.m_value | |||||
| End Function | |||||
| Public Function Pop() | |||||
| Dim temp | |||||
| ' TODO: Error Handling | |||||
| Assign Pop, m_last.m_value | |||||
| Set temp = m_last | |||||
| Set m_last = temp.m_prev | |||||
| Set temp.m_prev = Nothing | |||||
| If m_last Is Nothing Then | |||||
| Set m_first = Nothing | |||||
| Else | |||||
| Set m_last.m_next = Nothing | |||||
| End If | |||||
| m_size = m_size - 1 | |||||
| End Function | |||||
| Public Function Unshift(ByVal value) | |||||
| Dim temp | |||||
| Set temp = NewNode(value) | |||||
| If Me.IsEmpty Then | |||||
| Set m_first = temp | |||||
| Set m_last = temp | |||||
| Else | |||||
| Set temp.m_next = m_first | |||||
| Set m_first.m_prev = temp | |||||
| Set m_first = temp | |||||
| End If | |||||
| m_size = m_size + 1 | |||||
| Set Unshift = Me | |||||
| End Function | |||||
| ' Alias for Peek | |||||
| Public Function Front() | |||||
| ' TODO: Error handling | |||||
| Assign Front, m_first.m_value | |||||
| End Function | |||||
| Public Function Shift() | |||||
| Dim temp | |||||
| ' TODO: Error Handling | |||||
| Assign Shift, m_first.m_value | |||||
| Set temp = m_first | |||||
| Set m_first = temp.m_next | |||||
| Set temp.m_next = Nothing | |||||
| If m_first Is Nothing Then | |||||
| Set m_last = Nothing | |||||
| Else | |||||
| Set m_first.m_prev = Nothing | |||||
| End If | |||||
| m_size = m_size - 1 | |||||
| End Function | |||||
| Public Function TO_Array() | |||||
| Dim i, iter | |||||
| ReDim retval(Me.Count - 1) | |||||
| i = 0 | |||||
| Set iter = Me.Iterator | |||||
| While iter.HasNext | |||||
| assign retval(i),iter.GetNext | |||||
| i = i + 1 | |||||
| Wend | |||||
| TO_Array = retval | |||||
| End Function | |||||
| Public Function TO_En() | |||||
| Set TO_En = En_Iterator(Iterator) | |||||
| End Function | |||||
| End Class | |||||
| '======================================================================================================================= | |||||
| ' Dynamic Array - From the Tolerable lib | |||||
| '======================================================================================================================= | |||||
| Class DynamicArray_Class | |||||
| Private m_data | |||||
| Private m_size | |||||
| Public Sub Initialize(ByVal d, ByVal s) | |||||
| m_data = d | |||||
| m_size = s | |||||
| End Sub | |||||
| Private Sub Class_Terminate() | |||||
| Set m_data = Nothing | |||||
| End Sub | |||||
| Public Property Get Capacity | |||||
| Capacity = UBOUND(m_data) + 1 | |||||
| End Property | |||||
| Public Property Get Count | |||||
| Count = m_size | |||||
| End Property | |||||
| ' Alias for Count | |||||
| Public Property Get Size | |||||
| Size = m_size | |||||
| End Property | |||||
| Public Function IsEmpty() | |||||
| IsEmpty = (m_size = 0) | |||||
| End Function | |||||
| Public Function Clear() | |||||
| m_size = 0 | |||||
| Set Clear = Me | |||||
| End Function | |||||
| Private Sub Grow | |||||
| ' TODO: There's probably a better way to | |||||
| ' do this. Doubling might be excessive | |||||
| ReDim Preserve m_data(UBOUND(m_data) * 2) | |||||
| End Sub | |||||
| Public Function Push(ByVal val) | |||||
| If m_size >= UBOUND(m_data) Then | |||||
| Grow | |||||
| End If | |||||
| Assign m_data(m_size), val | |||||
| m_size = m_size + 1 | |||||
| Set Push = Me | |||||
| End Function | |||||
| ' Look at the last element | |||||
| Public Function Peek() | |||||
| Assign Peek, m_data(m_size - 1) | |||||
| End Function | |||||
| ' Look at the last element and | |||||
| ' pop it off of the list | |||||
| Public Function Pop() | |||||
| Assign Pop, m_data(m_size - 1) | |||||
| m_size = m_size - 1 | |||||
| End Function | |||||
| ' If pseudo_index < 0, then we assume we're counting | |||||
| ' from the back of the Array. | |||||
| Private Function CalculateIndex(ByVal pseudo_index) | |||||
| If pseudo_index >= 0 Then | |||||
| CalculateIndex = pseudo_index | |||||
| Else | |||||
| CalculateIndex = m_size + pseudo_index | |||||
| End If | |||||
| End Function | |||||
| Public Default Function Item(ByVal i) | |||||
| Assign Item, m_data(CalculateIndex(i)) | |||||
| End Function | |||||
| ' This does not treat negative indices as wrap-around. | |||||
| ' Thus, it is slightly faster. | |||||
| Public Function FastItem(ByVal i) | |||||
| Assign FastItem, m_data(i) | |||||
| End Function | |||||
| Public Function Slice(ByVal s, ByVal e) | |||||
| s = CalculateIndex(s) | |||||
| e = CalculateIndex(e) | |||||
| If e < s Then | |||||
| Set Slice = DynamicArray() | |||||
| Else | |||||
| ReDim retval(e - s) | |||||
| Dim i, j | |||||
| j = 0 | |||||
| For i = s to e | |||||
| Assign retval(j), m_data(i) | |||||
| j = j + 1 | |||||
| Next | |||||
| Set Slice = DynamicArray1(retval) | |||||
| End If | |||||
| End Function | |||||
| Public Function Iterator() | |||||
| Dim retval | |||||
| Set retval = New Iterator_DynamicArray_Class | |||||
| retval.Initialize Me | |||||
| Set Iterator = retval | |||||
| End Function | |||||
| Public Function TO_En() | |||||
| Set TO_En = En_Iterator(Me.Iterator) | |||||
| End Function | |||||
| Public Function TO_Array() | |||||
| Dim i | |||||
| ReDim retval(m_size - 1) | |||||
| For i = 0 to UBOUND(retval) | |||||
| Assign retval(i), m_data(i) | |||||
| Next | |||||
| TO_Array = retval | |||||
| End Function | |||||
| End Class | |||||
| Public Function DynamicArray() | |||||
| ReDim data(3) | |||||
| Set DynamicArray = DynamicArray2(data, 0) | |||||
| End Function | |||||
| Public Function DynamicArray1(ByVal data) | |||||
| Set DynamicArray1 = DynamicArray2(data, UBOUND(data) + 1) | |||||
| End Function | |||||
| Private Function DynamicArray2(ByVal data, ByVal size) | |||||
| Dim retval | |||||
| Set retval = New DynamicArray_Class | |||||
| retval.Initialize data, size | |||||
| Set DynamicArray2 = retval | |||||
| End Function | |||||
| Class Iterator_DynamicArray_Class | |||||
| Private m_dynamic_array | |||||
| Private m_index | |||||
| Public Sub Initialize(ByVal dynamic_array) | |||||
| Set m_dynamic_array = dynamic_array | |||||
| m_index = 0 | |||||
| End Sub | |||||
| Private Sub Class_Terminate | |||||
| Set m_dynamic_array = Nothing | |||||
| End Sub | |||||
| Public Function HasNext() | |||||
| HasNext = (m_index < m_dynamic_array.Size) | |||||
| End Function | |||||
| Public Function PeekNext() | |||||
| Assign PeekNext, m_dynamic_array.FastItem(m_index) | |||||
| End Function | |||||
| Public Function GetNext() | |||||
| Assign GetNext, m_dynamic_array.FastItem(m_index) | |||||
| m_index = m_index + 1 | |||||
| End Function | |||||
| Public Function HasPrev() | |||||
| HasPrev = (m_index > 0) | |||||
| End Function | |||||
| Public Function PeekPrev() | |||||
| Assign PeekPrev, m_dynamic_array.FastItem(m_index - 1) | |||||
| End Function | |||||
| Public Function GetPrev() | |||||
| Assign GetPrev, m_dynamic_array.FastItem(m_index - 1) | |||||
| m_index = m_index - 1 | |||||
| End Function | |||||
| End Class | |||||
| '======================================================================================================================= | |||||
| ' Other Iterators | |||||
| '======================================================================================================================= | |||||
| '!!! EXPERIMENTAL !!! May not be very useful, oh well... | |||||
| Class Iterator_Recordset_Class | |||||
| Private m_rs | |||||
| Private m_record_count | |||||
| Private m_current_index | |||||
| Private m_field_names 'cached array | |||||
| Public Sub Initialize(ByVal rs) | |||||
| Set m_rs = rs | |||||
| m_rs.MoveFirst | |||||
| m_rs.MovePrevious | |||||
| m_record_count = rs.RecordCount | |||||
| m_current_index = 0 | |||||
| 'cache field names | |||||
| m_field_names = array() | |||||
| redim m_field_names(m_rs.Fields.Count) | |||||
| dim field | |||||
| dim i : i = 0 | |||||
| for each field in m_rs.Fields | |||||
| m_field_names(i) = field.Name | |||||
| next | |||||
| End Sub | |||||
| Private Sub Class_Terminate | |||||
| Set m_rs = Nothing | |||||
| End Sub | |||||
| Public Function HasNext() | |||||
| HasNext = (m_current_index < m_record_count) | |||||
| put "m_current_index := " & m_current_index | |||||
| put "m_record_count := " & m_record_count | |||||
| End Function | |||||
| Public Function PeekNext | |||||
| if HasNext then | |||||
| m_rs.MoveNext | |||||
| Assign PeekNext, GetPairs | |||||
| m_rs.MovePrevious | |||||
| else | |||||
| set PeekNext = Nothing | |||||
| end if | |||||
| End Function | |||||
| Private Function GetPairs | |||||
| End Function | |||||
| Public Function GetNext | |||||
| if m_current_index < m_record_count then | |||||
| Assign GetNext, m_rs | |||||
| m_rs.MoveNext | |||||
| m_current_index = m_current_index + 1 | |||||
| else | |||||
| set GetNext = Nothing | |||||
| end if | |||||
| End Function | |||||
| Public Function HasPrev() | |||||
| if m_rs.BOF then | |||||
| HasPrev = false | |||||
| else | |||||
| m_rs.MovePrevious | |||||
| HasPrev = Choice(m_rs.BOF, false, true) | |||||
| m_rs.MoveNext | |||||
| end if | |||||
| End Function | |||||
| Public Function PeekPrev | |||||
| m_rs.MovePrevious | |||||
| if m_rs.BOF then | |||||
| set PeekPrev = Nothing | |||||
| else | |||||
| Assign PeekPrev, m_rs | |||||
| end if | |||||
| m_rs.MoveNext | |||||
| End Function | |||||
| Public Function GetPrev | |||||
| m_rs.MovePrevious | |||||
| if m_rs.BOF then | |||||
| set GetPrev = Nothing | |||||
| else | |||||
| Assign GetPrev, m_rs | |||||
| end if | |||||
| End Function | |||||
| End Class | |||||
| Class Iterator_Dictionary_Class | |||||
| Private m_dic | |||||
| Private m_keys 'array | |||||
| Private m_idx 'current array index | |||||
| Private m_keys_ubound 'cached ubound(m_keys) | |||||
| Public Sub Initialize(ByVal dic) | |||||
| set m_dic = dic | |||||
| m_keys = m_dic.Keys() | |||||
| m_idx = -1 | |||||
| m_keys_ubound = ubound(m_keys) | |||||
| End Sub | |||||
| Private Sub Class_Terminate | |||||
| set m_dic = Nothing | |||||
| End Sub | |||||
| Public Function HasNext() | |||||
| HasNext = (m_idx < m_keys_ubound) | |||||
| End Function | |||||
| Public Function PeekNext() | |||||
| Assign PeekNext, m_dic(m_keys(m_idx + 1)) | |||||
| End Function | |||||
| Public Function GetNext() | |||||
| Assign GetNext, m_dic(m_keys(m_idx + 1)) | |||||
| m_idx = m_idx + 1 | |||||
| End Function | |||||
| Public Function HasPrev() | |||||
| HasPrev = (m_idx > 0) | |||||
| End Function | |||||
| Public Function PeekPrev() | |||||
| Assign PeekPrev, m_dic(m_keys(m_idx - 1)) | |||||
| End Function | |||||
| Public Function GetPrev() | |||||
| Assign GetPrev, m_dic(m_keys(m_idx - 1)) | |||||
| m_idx = m_idx - 1 | |||||
| End Function | |||||
| End Class | |||||
| '======================================================================================================================= | |||||
| ' Iterator Factory | |||||
| '======================================================================================================================= | |||||
| 'Returns the appropriate iterator for the passed-in collection. Errors if unknown collection. | |||||
| Function IteratorFor(col) | |||||
| dim result | |||||
| select case typename(col) | |||||
| case "LinkedList_Class" : set result = new Iterator_LinkedList_Class | |||||
| case "Dictionary" : set result = new Iterator_Dictionary_Class | |||||
| case "Recordset" : set result = new Iterator_Recordset_Class | |||||
| end select | |||||
| result.Initialize col | |||||
| set IteratorFor = result | |||||
| End Function | |||||
| Class List | |||||
| Private items | |||||
| Private P_count | |||||
| Private Sub Class_Initialize() | |||||
| ReDim items(-1) | |||||
| P_count = 0 | |||||
| End Sub | |||||
| Public Sub Add(value) | |||||
| ReDim Preserve items(P_count) | |||||
| If IsObject(value) Then | |||||
| Set items(P_count) = value | |||||
| Else | |||||
| items(P_count) = value | |||||
| End If | |||||
| P_count = P_count + 1 | |||||
| End Sub | |||||
| Public Sub AddRange(arrayToAdd) | |||||
| Dim i | |||||
| For i = 0 To UBound(arrayToAdd) | |||||
| Me.Add arrayToAdd(i) | |||||
| Next | |||||
| End Sub | |||||
| Public Property Get Count() | |||||
| Count = P_count | |||||
| End Property | |||||
| Public Property Get Item(index) | |||||
| If index < 0 Or index >= P_count Then | |||||
| Err.Raise 9, "List", "Index out of bounds" | |||||
| End If | |||||
| If IsObject(items(index)) Then | |||||
| Set Item = items(index) | |||||
| Else | |||||
| Item = items(index) | |||||
| End If | |||||
| End Property | |||||
| Public Property Let Item(index, value) | |||||
| If index < 0 Or index >= P_count Then | |||||
| Err.Raise 9, "List", "Index out of bounds" | |||||
| End If | |||||
| If IsObject(value) Then | |||||
| Set items(index) = value | |||||
| Else | |||||
| items(index) = value | |||||
| End If | |||||
| End Property | |||||
| Public Function Contains(ByRef value) | |||||
| Dim i | |||||
| For i = 0 To P_count - 1 | |||||
| If IsObject(items(i)) And IsObject(value) Then | |||||
| If (items(i) Is value) Then | |||||
| Contains = True | |||||
| Exit Function | |||||
| End If | |||||
| Else | |||||
| If items(i) = value Then | |||||
| Contains = True | |||||
| Exit Function | |||||
| End If | |||||
| End If | |||||
| Next | |||||
| Contains = False | |||||
| End Function | |||||
| Public Function IndexOf(value) | |||||
| Dim i | |||||
| For i = 0 To P_count - 1 | |||||
| If IsObject(items(i)) And IsObject(value) Then | |||||
| If items(i) Is value Then | |||||
| IndexOf = i | |||||
| Exit Function | |||||
| End If | |||||
| Else | |||||
| If items(i) = value Then | |||||
| IndexOf = i | |||||
| Exit Function | |||||
| End If | |||||
| End If | |||||
| Next | |||||
| IndexOf = -1 | |||||
| End Function | |||||
| Public Sub Remove(value) | |||||
| Dim i | |||||
| i = Me.IndexOf(value) | |||||
| If i <> -1 Then | |||||
| Me.RemoveAt i | |||||
| End If | |||||
| End Sub | |||||
| Public Sub RemoveAt(index) | |||||
| Dim i | |||||
| If index < 0 Or index >= P_count Then | |||||
| Err.Raise 9, "List", "Index out of bounds" | |||||
| End If | |||||
| For i = index To P_count - 2 | |||||
| If IsObject(items(i + 1)) Then | |||||
| Set items(i) = items(i + 1) | |||||
| Else | |||||
| items(i) = items(i + 1) | |||||
| End If | |||||
| Next | |||||
| P_count = P_count - 1 | |||||
| If P_count <= 0 Then | |||||
| ReDim items(-1) | |||||
| Else | |||||
| ReDim Preserve items(P_count - 1) | |||||
| End If | |||||
| End Sub | |||||
| Public Sub Clear() | |||||
| ReDim items(-1) | |||||
| P_count = 0 | |||||
| End Sub | |||||
| Public Sub Sort() | |||||
| Dim i, j, tmp | |||||
| For i = 0 To P_count - 2 | |||||
| For j = i + 1 To P_count - 1 | |||||
| If CStr(items(i)) > CStr(items(j)) Then | |||||
| Set tmp = items(i) | |||||
| Set items(i) = items(j) | |||||
| Set items(j) = tmp | |||||
| End If | |||||
| Next | |||||
| Next | |||||
| End Sub | |||||
| ' Note: this will NOT be used automatically by VBScript For Each, | |||||
| ' but you can use it manually. | |||||
| Public Function New_Enum() | |||||
| Set New_Enum = New ListEnumerator | |||||
| New_Enum.Init items, P_count | |||||
| End Function | |||||
| End Class | |||||
| Class ListEnumerator | |||||
| Private items, index, max | |||||
| Public Sub Init(arr, cnt) | |||||
| items = arr | |||||
| index = -1 | |||||
| max = cnt | |||||
| End Sub | |||||
| Public Function MoveNext() | |||||
| index = index + 1 | |||||
| MoveNext = (index < max) | |||||
| End Function | |||||
| Public Property Get Current() | |||||
| Set Current = items(index) | |||||
| End Property | |||||
| Public Sub Reset() | |||||
| index = -1 | |||||
| End Sub | |||||
| End Class | |||||
| %> | |||||
| @@ -0,0 +1,116 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' Controller Registry | |||||
| ' Provides a whitelist of valid controllers to prevent code injection attacks | |||||
| '======================================================================================================================= | |||||
| Class ControllerRegistry_Class | |||||
| Private m_controllers | |||||
| Private Sub Class_Initialize() | |||||
| Set m_controllers = Server.CreateObject("Scripting.Dictionary") | |||||
| m_controllers.CompareMode = 1 ' vbTextCompare for case-insensitive | |||||
| ' Register all valid controllers here | |||||
| ' Format: m_controllers.Add "controllername", True | |||||
| RegisterController "homecontroller" | |||||
| RegisterController "errorcontroller" | |||||
| RegisterController "importcontroller" | |||||
| RegisterController "businessescontroller" | |||||
| RegisterController "todaycontroller" | |||||
| RegisterController "industriescontroller" | |||||
| RegisterController "exportcontroller" | |||||
| RegisterController "dashboardcontroller" | |||||
| End Sub | |||||
| Private Sub Class_Terminate() | |||||
| Set m_controllers = Nothing | |||||
| End Sub | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Register a controller as valid | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub RegisterController(controllerName) | |||||
| Dim key : key = LCase(Trim(controllerName)) | |||||
| If Not m_controllers.Exists(key) Then | |||||
| m_controllers.Add key, True | |||||
| End If | |||||
| End Sub | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Check if a controller is registered (valid) | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Function IsValidController(controllerName) | |||||
| Dim key : key = LCase(Trim(controllerName)) | |||||
| IsValidController = m_controllers.Exists(key) | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Get list of all registered controllers | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Function GetRegisteredControllers() | |||||
| GetRegisteredControllers = m_controllers.Keys() | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Validate controller name format (alphanumeric and underscore only) | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Function IsValidControllerFormat(controllerName) | |||||
| If IsEmpty(controllerName) Or Len(controllerName) = 0 Then | |||||
| IsValidControllerFormat = False | |||||
| Exit Function | |||||
| End If | |||||
| Dim i, ch | |||||
| For i = 1 To Len(controllerName) | |||||
| ch = Mid(controllerName, i, 1) | |||||
| ' Allow a-z, A-Z, 0-9, and underscore | |||||
| If Not ((ch >= "a" And ch <= "z") Or _ | |||||
| (ch >= "A" And ch <= "Z") Or _ | |||||
| (ch >= "0" And ch <= "9") Or _ | |||||
| ch = "_") Then | |||||
| IsValidControllerFormat = False | |||||
| Exit Function | |||||
| End If | |||||
| Next | |||||
| IsValidControllerFormat = True | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Validate action name format (alphanumeric and underscore only) | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Function IsValidActionFormat(actionName) | |||||
| If IsEmpty(actionName) Or Len(actionName) = 0 Then | |||||
| IsValidActionFormat = False | |||||
| Exit Function | |||||
| End If | |||||
| Dim i, ch | |||||
| For i = 1 To Len(actionName) | |||||
| ch = Mid(actionName, i, 1) | |||||
| ' Allow a-z, A-Z, 0-9, and underscore | |||||
| If Not ((ch >= "a" And ch <= "z") Or _ | |||||
| (ch >= "A" And ch <= "Z") Or _ | |||||
| (ch >= "0" And ch <= "9") Or _ | |||||
| ch = "_") Then | |||||
| IsValidActionFormat = False | |||||
| Exit Function | |||||
| End If | |||||
| Next | |||||
| IsValidActionFormat = True | |||||
| End Function | |||||
| End Class | |||||
| ' Singleton instance | |||||
| Dim ControllerRegistry_Class__Singleton | |||||
| Function ControllerRegistry() | |||||
| If IsEmpty(ControllerRegistry_Class__Singleton) Then | |||||
| Set ControllerRegistry_Class__Singleton = New ControllerRegistry_Class | |||||
| End If | |||||
| Set ControllerRegistry = ControllerRegistry_Class__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,29 @@ | |||||
| <% | |||||
| ' This class encapsulates database access into one location, isolating database details from the rest of the app. | |||||
| ' Multiple databases can be handled in one of two ways: | |||||
| ' | |||||
| ' Option 1. Use a single DAL_Class instance with separate public properties for each database. | |||||
| ' Ex: To access Orders use DAL.Orders and to access Employees use DAL.Employees. | |||||
| ' | |||||
| ' Option 2. Use a separate DAL_Class instance for each database. | |||||
| ' Ex: | |||||
| ' dim OrdersDAL : set OrdersDAL = new DAL_Class | |||||
| ' OrdersDAL.ConnectionString = "..." <-- you would have to create this property to use this approach | |||||
| ' | |||||
| ' If you only access one database it is easier to just set the global DAL singleton to an instance of the | |||||
| ' Database_Class and use it directly. See the example project for details. | |||||
| '======================================================================================================================= | |||||
| ' DATA ACCESS LAYER Class | |||||
| '======================================================================================================================= | |||||
| dim DAL__Singleton : set DAL__Singleton = Nothing | |||||
| Function DAL() | |||||
| If DAL__Singleton is Nothing then | |||||
| set DAL__Singleton = new Database_Class | |||||
| DAL__Singleton.Initialize GetAppSetting("ConnectionString") | |||||
| End If | |||||
| set DAL = DAL__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,113 @@ | |||||
| <% | |||||
| Class Database_Class | |||||
| Private m_connection | |||||
| Private m_connection_string | |||||
| Private m_trace_enabled | |||||
| Public Sub set_trace(bool) : m_trace_enabled = bool : End Sub | |||||
| Public Property Get is_trace_enabled : is_trace_enabled = m_trace_enabled : End Property | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub Initialize(connection_string) | |||||
| m_connection_string = connection_string | |||||
| End Sub | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Function ShapeQuery(sql,params) | |||||
| dim shapeConn : set shapeConn = server.createobject("adodb.connection") | |||||
| shapeConn.ConnectionString = "Provider=MSDataShape;Data " & m_connection_string | |||||
| dim cmd : set cmd = server.createobject("adodb.command") | |||||
| shapeConn.open | |||||
| set cmd.ActiveConnection = shapeConn | |||||
| cmd.CommandText = sql | |||||
| dim rs | |||||
| If IsArray(params) then | |||||
| set rs = cmd.Execute(, params) | |||||
| ElseIf Not IsEmpty(params) then ' one parameter | |||||
| set rs = cmd.Execute(, Array(params)) | |||||
| Else | |||||
| set rs = cmd.Execute() | |||||
| End If | |||||
| set ShapeQuery = rs | |||||
| End Function | |||||
| Public Function Query(sql, params) | |||||
| dim cmd : set cmd = server.createobject("adodb.command") | |||||
| set cmd.ActiveConnection = Connection | |||||
| cmd.CommandText = sql | |||||
| dim rs | |||||
| If IsArray(params) then | |||||
| set rs = cmd.Execute(, params) | |||||
| ElseIf Not IsEmpty(params) then ' one parameter | |||||
| set rs = cmd.Execute(, Array(params)) | |||||
| Else | |||||
| set rs = cmd.Execute() | |||||
| End If | |||||
| set Query = rs | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Function PagedQuery(sql, params, per_page, page_num) | |||||
| dim cmd : set cmd = server.createobject("adodb.command") | |||||
| set cmd.ActiveConnection = Connection | |||||
| cmd.CommandText = sql | |||||
| cmd.CommandType = 1 'adCmdText | |||||
| cmd.ActiveConnection.CursorLocation = 3 'adUseClient | |||||
| dim rs | |||||
| If IsArray(params) then | |||||
| set rs = cmd.Execute(, params) | |||||
| ElseIf Not IsEmpty(params) then ' one parameter | |||||
| set rs = cmd.Execute(, Array(params)) | |||||
| Else | |||||
| set rs = cmd.Execute() | |||||
| End If | |||||
| If Not rs.EOF then | |||||
| rs.PageSize = 1 | |||||
| rs.CacheSize = 1 | |||||
| rs.AbsolutePage = 1 | |||||
| End If | |||||
| set PagedQuery = rs | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub [Execute](sql, params) | |||||
| me.query sql, params | |||||
| End Sub | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub BeginTransaction | |||||
| Connection.BeginTrans | |||||
| End Sub | |||||
| Public Sub RollbackTransaction | |||||
| Connection.RollbackTrans | |||||
| End Sub | |||||
| Public Sub CommitTransaction | |||||
| Connection.CommitTrans | |||||
| End Sub | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Private Methods | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Private Sub Class_terminate | |||||
| Destroy m_connection | |||||
| End Sub | |||||
| Public Function Connection | |||||
| if not isobject(m_connection) then | |||||
| set m_connection = Server.CreateObject("adodb.connection") | |||||
| m_connection.open m_connection_string | |||||
| end if | |||||
| set Connection = m_connection | |||||
| End Function | |||||
| end Class | |||||
| %> | |||||
| @@ -0,0 +1,202 @@ | |||||
| <% | |||||
| Class EnumerableHelper_Class | |||||
| Private m_list | |||||
| Public Sub Init(list) | |||||
| set m_list = list | |||||
| End Sub | |||||
| Public Sub Class_Terminate | |||||
| set m_list = Nothing | |||||
| End Sub | |||||
| Public Default Function Data() | |||||
| set Data = m_list | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Convenience wrappers | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Function Count() | |||||
| Count = m_list.Count() | |||||
| End Function | |||||
| Public Function First() | |||||
| Assign First, m_list.Front() | |||||
| End Function | |||||
| Public Function Last() | |||||
| Assign Last, m_list.Back() | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Methods that return a single value | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| 'true if all elements of the list satisfy the condition | |||||
| Public Function All(condition) | |||||
| dim item_, all_matched : all_matched = true | |||||
| dim it : set it = m_list.Iterator | |||||
| Do While it.HasNext | |||||
| Assign item_, it.GetNext() | |||||
| If "String" = typename(condition) then | |||||
| If Not eval(condition) then | |||||
| all_matched = false | |||||
| End If | |||||
| Else | |||||
| If Not condition(item_) then | |||||
| all_matched = false | |||||
| End If | |||||
| End If | |||||
| If Not all_matched then Exit Do | |||||
| Loop | |||||
| All = all_matched | |||||
| End Function | |||||
| 'true if any element of the list satisfies the condition | |||||
| Public Function Any(condition) | |||||
| Any = Not All("Not " & condition) | |||||
| End Function | |||||
| Public Function Max(expr) | |||||
| dim V_, item_, maxval | |||||
| dim it : set it = m_list.Iterator | |||||
| If "String" = typename(expr) then | |||||
| While it.HasNext | |||||
| Assign item_, it.GetNext() | |||||
| Assign V_, eval(expr) | |||||
| If V_ > maxval then maxval = V_ | |||||
| Wend | |||||
| Else | |||||
| While it.HasNext | |||||
| Assign item_, it.GetNext() | |||||
| Assign V_, expr(item_) | |||||
| If V_ > maxval then maxval = V_ | |||||
| Wend | |||||
| End If | |||||
| Max = maxval | |||||
| End Function | |||||
| Public Function Min(expr) | |||||
| dim V_, item_, minval | |||||
| dim it : set it = m_list.Iterator | |||||
| If "String" = typename(expr) then | |||||
| While it.HasNext | |||||
| Assign item_, it.GetNext() | |||||
| If IsEmpty(minval) then ' empty is always less than everything so set it on first pass | |||||
| Assign minval, item_ | |||||
| End If | |||||
| Assign V_, eval(expr) | |||||
| If V_ < minval then minval = V_ | |||||
| Wend | |||||
| Else | |||||
| While it.HasNext | |||||
| Assign item_, it.GetNext() | |||||
| If IsEmpty(minval) then | |||||
| Assign minval, item_ | |||||
| End If | |||||
| V_ = expr(item_) | |||||
| If V_ < minval then minval = V_ | |||||
| Wend | |||||
| End If | |||||
| Min = minval | |||||
| End Function | |||||
| Public Function Sum(expr) | |||||
| dim V_, item_ | |||||
| dim it : set it = m_list.Iterator | |||||
| While it.HasNext | |||||
| Assign item_, it.GetNext() | |||||
| execute "V_ = V_ + " & expr | |||||
| Wend | |||||
| Sum = V_ | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Methods that return a new instance of this class | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| 'returns a list that results from running lambda_or_proc once for every element in the list | |||||
| Public Function Map(lambda_or_proc) | |||||
| dim list2 : set list2 = new LinkedList_Class | |||||
| dim it : set it = m_list.Iterator | |||||
| dim item_ | |||||
| If "String" = typename(lambda_or_proc) then | |||||
| dim V_ | |||||
| While it.HasNext | |||||
| Assign item_, it.GetNext() | |||||
| execute lambda_or_proc | |||||
| list2.Push V_ | |||||
| Wend | |||||
| Else | |||||
| While it.HasNext | |||||
| Assign item_, it.GetNext() | |||||
| list2.Push lambda_or_proc(item_) | |||||
| Wend | |||||
| End If | |||||
| set Map = Enumerable(list2) | |||||
| End Function | |||||
| 'alias to match IEnumerable for convenience | |||||
| Public Function [Select](lambda_or_proc) | |||||
| set [Select] = Map(lambda_or_proc) | |||||
| End Function | |||||
| 'returns list containing first n items | |||||
| Public Function Take(n) | |||||
| dim list2 : set list2 = new LinkedList_Class | |||||
| dim it : set it = m_list.Iterator | |||||
| dim i : i = 1 | |||||
| While it.HasNext And i <= n | |||||
| list2.Push it.GetNext() | |||||
| i = i + 1 | |||||
| Wend | |||||
| set Take = Enumerable(list2) | |||||
| End Function | |||||
| 'returns list containing elements as long as the condition is true, and skips the remaining elements | |||||
| Public Function TakeWhile(condition) | |||||
| dim list2 : set list2 = new LinkedList_Class | |||||
| dim item_, V_, bln | |||||
| dim it : set it = m_list.Iterator | |||||
| Do While it.HasNext | |||||
| Assign item_, it.GetNext() | |||||
| If "String" = typename(condition) then | |||||
| 'execute condition | |||||
| If Not eval(condition) then Exit Do | |||||
| Else | |||||
| If Not condition(item_) then Exit Do | |||||
| End If | |||||
| list2.Push item_ | |||||
| Loop | |||||
| set TakeWhile = Enumerable(list2) | |||||
| End Function | |||||
| 'returns a list containing only elements that satisfy the condition | |||||
| Public Function Where(condition) | |||||
| dim list2 : set list2 = new LinkedList_Class | |||||
| dim it : set it = m_list.Iterator | |||||
| dim item_ | |||||
| While it.HasNext | |||||
| Assign item_, it.GetNext() | |||||
| If "String" = typename(condition) then | |||||
| If eval(condition) then list2.Push item_ | |||||
| Else | |||||
| If condition(item_) then list2.Push item_ | |||||
| End If | |||||
| Wend | |||||
| set Where = Enumerable(list2) | |||||
| End Function | |||||
| End Class | |||||
| Function Enumerable(list) | |||||
| dim E : set E = new EnumerableHelper_Class | |||||
| E.Init list | |||||
| set Enumerable = E | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,178 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' Error Handler Library | |||||
| ' Provides centralized error handling and logging functionality | |||||
| '======================================================================================================================= | |||||
| Class ErrorHandler_Class | |||||
| Private m_log_to_file | |||||
| Private m_log_file_path | |||||
| Private Sub Class_Initialize() | |||||
| m_log_to_file = False | |||||
| m_log_file_path = "" | |||||
| End Sub | |||||
| ' Configure whether to log errors to file | |||||
| Public Property Let LogToFile(value) | |||||
| m_log_to_file = value | |||||
| End Property | |||||
| Public Property Get LogToFile() | |||||
| LogToFile = m_log_to_file | |||||
| End Property | |||||
| ' Set the log file path | |||||
| Public Property Let LogFilePath(value) | |||||
| m_log_file_path = value | |||||
| End Property | |||||
| Public Property Get LogFilePath() | |||||
| LogFilePath = m_log_file_path | |||||
| End Property | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Main error handling method | |||||
| ' context: String describing where the error occurred | |||||
| ' errObj: VBScript Err object (optional, uses global Err if not provided) | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub HandleError(context, errObj) | |||||
| Dim isDevelopment | |||||
| isDevelopment = (LCase(GetAppSetting("Environment")) = "development") | |||||
| If IsEmpty(errObj) Or Not IsObject(errObj) Then | |||||
| ' Use global Err object if none provided | |||||
| If Err.Number <> 0 Then | |||||
| If isDevelopment Then | |||||
| ShowDetailedError context, Err | |||||
| Else | |||||
| ShowGenericError | |||||
| End If | |||||
| LogError context, Err | |||||
| End If | |||||
| Else | |||||
| If errObj.Number <> 0 Then | |||||
| If isDevelopment Then | |||||
| ShowDetailedError context, errObj | |||||
| Else | |||||
| ShowGenericError | |||||
| End If | |||||
| LogError context, errObj | |||||
| End If | |||||
| End If | |||||
| End Sub | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Display detailed error information (Development mode only) | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Private Sub ShowDetailedError(context, errObj) | |||||
| Dim errHtml | |||||
| errHtml = "<div style='padding:15px; margin:10px; border:2px solid #dc3545; background:#f8d7da; color:#721c24; font-family:Verdana,sans-serif; font-size:14px; border-radius:4px;'>" | |||||
| errHtml = errHtml & "<strong>Error Occurred</strong><br>" | |||||
| If Not IsEmpty(context) And Len(context) > 0 Then | |||||
| errHtml = errHtml & "<strong>Context:</strong> " & Server.HTMLEncode(context) & "<br>" | |||||
| End If | |||||
| errHtml = errHtml & "<strong>Time:</strong> " & Now() & "<br>" | |||||
| errHtml = errHtml & "<strong>Number:</strong> " & errObj.Number & "<br>" | |||||
| errHtml = errHtml & "<strong>Description:</strong> " & Server.HTMLEncode(errObj.Description) & "<br>" | |||||
| If Len(errObj.Source) > 0 Then | |||||
| errHtml = errHtml & "<strong>Source:</strong> " & Server.HTMLEncode(errObj.Source) & "<br>" | |||||
| End If | |||||
| errHtml = errHtml & "</div>" | |||||
| Response.Write errHtml | |||||
| End Sub | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Display generic error message (Production mode) | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Private Sub ShowGenericError() | |||||
| Dim errHtml | |||||
| errHtml = "<div style='padding:15px; margin:10px; border:2px solid #dc3545; background:#f8d7da; color:#721c24; font-family:Verdana,sans-serif; font-size:14px; border-radius:4px;'>" | |||||
| errHtml = errHtml & "<strong>An error occurred</strong><br>" | |||||
| errHtml = errHtml & "We apologize for the inconvenience. The error has been logged and will be investigated.<br>" | |||||
| errHtml = errHtml & "Please try again later or contact support if the problem persists." | |||||
| errHtml = errHtml & "</div>" | |||||
| Response.Write errHtml | |||||
| End Sub | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Log error to file (if enabled) | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Private Sub LogError(context, errObj) | |||||
| If Not m_log_to_file Or Len(m_log_file_path) = 0 Then Exit Sub | |||||
| On Error Resume Next | |||||
| Dim fso, logFile, logEntry | |||||
| Set fso = Server.CreateObject("Scripting.FileSystemObject") | |||||
| ' Create log entry | |||||
| logEntry = "[" & Now() & "] " | |||||
| If Len(context) > 0 Then | |||||
| logEntry = logEntry & "Context: " & context & " | " | |||||
| End If | |||||
| logEntry = logEntry & "Error #" & errObj.Number & ": " & errObj.Description | |||||
| If Len(errObj.Source) > 0 Then | |||||
| logEntry = logEntry & " | Source: " & errObj.Source | |||||
| End If | |||||
| logEntry = logEntry & vbCrLf | |||||
| ' Append to log file | |||||
| If fso.FileExists(m_log_file_path) Then | |||||
| Set logFile = fso.OpenTextFile(m_log_file_path, 8, False) ' 8 = ForAppending | |||||
| Else | |||||
| Set logFile = fso.CreateTextFile(m_log_file_path, True) | |||||
| End If | |||||
| logFile.Write logEntry | |||||
| logFile.Close | |||||
| Set logFile = Nothing | |||||
| Set fso = Nothing | |||||
| On Error GoTo 0 | |||||
| End Sub | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Quick check if an error exists | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Function HasError() | |||||
| HasError = (Err.Number <> 0) | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Clear the current error | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub ClearError() | |||||
| Err.Clear | |||||
| End Sub | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Check and handle error in one call | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Function CheckAndHandle(context) | |||||
| If Err.Number <> 0 Then | |||||
| HandleError context, Err | |||||
| CheckAndHandle = True | |||||
| Else | |||||
| CheckAndHandle = False | |||||
| End If | |||||
| End Function | |||||
| End Class | |||||
| ' Singleton instance | |||||
| Dim ErrorHandler_Class__Singleton | |||||
| Function ErrorHandler() | |||||
| If IsEmpty(ErrorHandler_Class__Singleton) Then | |||||
| Set ErrorHandler_Class__Singleton = New ErrorHandler_Class | |||||
| End If | |||||
| Set ErrorHandler = ErrorHandler_Class__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,151 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' Flash Message Class | |||||
| '======================================================================================================================= | |||||
| Class Flash_Class | |||||
| Private m_errors_key | |||||
| Private m_success_key | |||||
| Private Sub Class_Initialize | |||||
| ' Use constants to avoid typos | |||||
| m_errors_key = "mvc.flash.errors_array" | |||||
| m_success_key = "mvc.flash.success_message" | |||||
| End Sub | |||||
| 'helper methods to avoid if..then statements in views | |||||
| Public Sub ShowErrorsIfPresent | |||||
| if HasErrors then ShowErrors | |||||
| End Sub | |||||
| Public Sub ShowSuccessIfPresent | |||||
| if HasSuccess then ShowSuccess | |||||
| End Sub | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Errors | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Property Get HasErrors | |||||
| HasErrors = (Not IsEmpty(Session(m_errors_key))) | |||||
| End Property | |||||
| Public Property Get Errors | |||||
| Errors = Session(m_errors_key) | |||||
| End Property | |||||
| Public Property Let Errors(ary) | |||||
| Session(m_errors_key) = ary | |||||
| End Property | |||||
| Public Sub AddError(msg) | |||||
| dim ary | |||||
| if IsEmpty(Session(m_errors_key)) then | |||||
| ary = Array() | |||||
| redim ary(-1) | |||||
| else | |||||
| ary = Session(m_errors_key) | |||||
| end if | |||||
| redim preserve ary(ubound(ary) + 1) | |||||
| ary(ubound(ary)) = msg | |||||
| Session(m_errors_key) = ary | |||||
| End Sub | |||||
| 'Public Sub ShowErrors | |||||
| ' ClearErrors | |||||
| 'End Sub | |||||
| Public Sub ShowErrors | |||||
| if HasErrors then | |||||
| %> | |||||
| <div id="flashErrorBox" class="alert alert-danger alert-dismissible fade show" role="alert"> | |||||
| <strong>Error!</strong> | |||||
| <ul class="mb-0 mt-2"> | |||||
| <% | |||||
| dim ary, i | |||||
| ary = Errors | |||||
| for i = 0 to ubound(ary) | |||||
| put "<li>" | |||||
| put H(ary(i)) | |||||
| put "</li>" | |||||
| next | |||||
| %> | |||||
| </ul> | |||||
| <button type="button" class="btn-close" data-bs-dismiss="alert" aria-label="Close"></button> | |||||
| </div> | |||||
| <script> | |||||
| (function() { | |||||
| var timeout = <%= GetAppSetting("FlashMessageTimeout") %>; | |||||
| if (isNaN(timeout) || timeout <= 0) timeout = 3000; | |||||
| setTimeout(function() { | |||||
| var alertEl = document.getElementById("flashErrorBox"); | |||||
| if (alertEl && typeof bootstrap !== 'undefined') { | |||||
| var bsAlert = bootstrap.Alert.getOrCreateInstance(alertEl); | |||||
| bsAlert.close(); | |||||
| } else if (alertEl) { | |||||
| alertEl.style.display = "none"; | |||||
| } | |||||
| }, timeout); | |||||
| })(); | |||||
| </script> | |||||
| <% | |||||
| ClearErrors | |||||
| end if | |||||
| End Sub | |||||
| Public Sub ClearErrors | |||||
| Session.Contents.Remove(m_errors_key) | |||||
| End Sub | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Success | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Property Get HasSuccess | |||||
| HasSuccess = (Not IsEmpty(Session(m_success_key))) | |||||
| End Property | |||||
| Public Property Get Success | |||||
| Success = Session(m_success_key) | |||||
| End Property | |||||
| Public Property Let Success(msg) | |||||
| Session(m_success_key) = msg | |||||
| End Property | |||||
| Public Sub ShowSuccess | |||||
| if HasSuccess then | |||||
| %> | |||||
| <div id="flashSuccessBox" class="alert alert-success alert-dismissible fade show" role="alert"> | |||||
| <%= H(Success) %> | |||||
| <button type="button" class="btn-close" data-bs-dismiss="alert" aria-label="Close"></button> | |||||
| </div> | |||||
| <script> | |||||
| (function() { | |||||
| var timeout = <%= GetAppSetting("FlashMessageTimeout") %>; | |||||
| if (isNaN(timeout) || timeout <= 0) timeout = 3000; | |||||
| setTimeout(function() { | |||||
| var alertEl = document.getElementById("flashSuccessBox"); | |||||
| if (alertEl && typeof bootstrap !== 'undefined') { | |||||
| var bsAlert = bootstrap.Alert.getOrCreateInstance(alertEl); | |||||
| bsAlert.close(); | |||||
| } else if (alertEl) { | |||||
| alertEl.style.display = "none"; | |||||
| } | |||||
| }, timeout); | |||||
| })(); | |||||
| </script> | |||||
| <% | |||||
| ClearSuccess | |||||
| end if | |||||
| End Sub | |||||
| Public Sub ClearSuccess | |||||
| Session.Contents.Remove(m_success_key) | |||||
| End Sub | |||||
| End Class | |||||
| Function Flash() | |||||
| set Flash = new Flash_Class | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,79 @@ | |||||
| <% | |||||
| Class FormCache_Class | |||||
| 'given a form name and IRequestDictionary params (request.form) object, caches form values | |||||
| Public Sub SerializeForm(form_name, params) | |||||
| dim form_key, form_val, serialized_key | |||||
| For Each form_key in params | |||||
| form_val = params(form_key) | |||||
| serialized_key = CachedFormKeyName(form_name, form_key) | |||||
| 'put "serialize<br>" | |||||
| 'put "--form_key := " & form_key & "<br>" | |||||
| 'put "--form_val := " & form_val & "<br>" | |||||
| 'put "--serialized_key := " & serialized_key & "<br>" | |||||
| Session(serialized_key) = form_val | |||||
| Next | |||||
| End Sub | |||||
| 'given a form name, returns a dict with the form's stored values | |||||
| Public Function DeserializeForm(form_name) | |||||
| dim dict : set dict = Nothing | |||||
| dim serialized_key, serialized_val, form_key, form_val | |||||
| For Each serialized_key in Session.Contents | |||||
| 'put "serialized_key: " & serialized_key & "<br>" | |||||
| If InStr(serialized_key, "mvc.form." & form_name) > 0 then | |||||
| 'put "--match" & "<br>" | |||||
| If dict Is Nothing then | |||||
| set dict = Server.CreateObject("Scripting.Dictionary") | |||||
| 'put "dict created<br>" | |||||
| End If | |||||
| form_val = Session(serialized_key) | |||||
| form_key = Replace(serialized_key, "mvc.form." & form_name & ".", "") | |||||
| dict(form_key) = form_val | |||||
| 'Session.Contents.Remove serialized_key | |||||
| 'put "--serialized_val: " & serialized_val & "<br>" | |||||
| 'put "--form_val: " & form_val & "<br>" | |||||
| End If | |||||
| Next | |||||
| set DeserializeForm = dict | |||||
| End Function | |||||
| 'given a form name, clears the keys for that form | |||||
| Public Sub ClearForm(form_name) | |||||
| Dim key, prefix, keysToRemove(), idx | |||||
| prefix = "mvc.form." & form_name & "." | |||||
| ReDim keysToRemove(-1) | |||||
| ' First collect the keys to remove | |||||
| For Each key In Session.Contents | |||||
| If Left(CStr(key), Len(prefix)) = prefix Then | |||||
| ReDim Preserve keysToRemove(UBound(keysToRemove) + 1) | |||||
| keysToRemove(UBound(keysToRemove)) = key | |||||
| End If | |||||
| Next | |||||
| ' Then remove them | |||||
| For idx = 0 To UBound(keysToRemove) | |||||
| Session.Contents.Remove keysToRemove(idx) | |||||
| Next | |||||
| End Sub | |||||
| Private Function CachedFormKeyName(form_name, key) | |||||
| CachedFormKeyName = "mvc.form." & form_name & "." & key | |||||
| End Function | |||||
| End Class | |||||
| dim FormCache__Singleton | |||||
| Function FormCache() | |||||
| if IsEmpty(FormCache__Singleton) then | |||||
| set FormCache__Singleton = new FormCache_Class | |||||
| end if | |||||
| set FormCache = FormCache__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,78 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' HTML SECURITY HELPER | |||||
| '======================================================================================================================= | |||||
| Class HTML_Security_Helper_Class | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| 'Uses Scriptlet.TypeLib to generate a GUID. There may be a better/faster way than this to generate a nonce. | |||||
| Public Function Nonce() | |||||
| dim TL : set TL = CreateObject("Scriptlet.TypeLib") | |||||
| Nonce = Left(CStr(TL.Guid), 38) 'avoids issue w/ strings appended after this token not being displayed on screen, MSFT bug | |||||
| set TL = Nothing | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| 'Name is probably the combined ControllerName and ActionName of the form generator by convention | |||||
| Public Sub SetAntiCSRFToken(name) | |||||
| Session(name & ".anti_csrf_token") = Nonce() | |||||
| End Sub | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| 'Returns the CSRF token nonce from the session corresponding to the passed name | |||||
| Public Function GetAntiCSRFToken(name) | |||||
| dim token : token = Session(name & ".anti_csrf_token") | |||||
| If Len(token) = 0 or IsEmpty(token) then | |||||
| SetAntiCSRFToken name | |||||
| token = Session(name & ".anti_csrf_token") ' re-read: the first call used to return the stale empty value | |||||
| End If | |||||
| GetAntiCSRFToken = token | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| 'Removes the current CSRF token nonce for the passed name | |||||
| Public Sub ClearAntiCSRFToken(name) | |||||
| Session.Contents.Remove(name & ".anti_csrf_token") | |||||
| End Sub | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| 'Returns true if passed nonce matches the stored CSRF token nonce for the specified name, false if not | |||||
| Public Function IsValidAntiCSRFToken(name, nonce) | |||||
| IsValidAntiCSRFToken = (GetAntiCSRFToken(name) = nonce) | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| 'If an invalid CSRF nonce is passed, sets the flash and redirects using the appropriate MVC.Redirect* method. | |||||
| 'If a valid CSRF nonce is passed, clears it from the cache to reset the state to the beginning. | |||||
| Public Sub OnInvalidAntiCSRFTokenRedirectToAction(token_name, token, action_name) | |||||
| OnInvalidAntiCSRFTokenRedirectToExt token_name, token, MVC.ControllerName, action_name, empty | |||||
| End Sub | |||||
| Public Sub OnInvalidAntiCSRFTokenRedirectToActionExt(token_name, token, action_name, params) | |||||
| OnInvalidAntiCSRFTokenRedirectToExt token_name, token, MVC.ControllerName, action_name, params | |||||
| End Sub | |||||
| Public Sub OnInvalidAntiCSRFTokenRedirectTo(token_name, token, controller_name, action_name) | |||||
| OnInvalidAntiCSRFTokenRedirectToExt token_name, token, controller_name, action_name | |||||
| End Sub | |||||
| Public Sub OnInvalidAntiCSRFTokenRedirectToExt(token_name, token, controller_name, action_name, params) | |||||
| If IsValidAntiCSRFToken(token_name, token) then | |||||
| ClearAntiCSRFToken token_name | |||||
| Else | |||||
| ClearAntiCSRFToken token_name | |||||
| Flash.AddError "Invalid form state. Please try again." | |||||
| MVC.RedirectToExt controller_name, action_name, params | |||||
| End If | |||||
| End Sub | |||||
| End Class | |||||
| dim HTML_Security_Helper__Singleton | |||||
| Function HTMLSecurity() | |||||
| If IsEmpty(HTML_Security_Helper__Singleton) Then | |||||
| set HTML_Security_Helper__Singleton = new HTML_Security_Helper_Class | |||||
| End If | |||||
| set HTMLSecurity = HTML_Security_Helper__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,282 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' HTML HELPER | |||||
| '======================================================================================================================= | |||||
| Class HTML_Helper_Class | |||||
| 'Duplicate of Routes.NoCacheToken, copied to avoid extra lookup into the Routes object for such a trivial function. | |||||
| 'Allows caller to reference HTML.NoCacheToken in cases where it seems to feel right. | |||||
| Public Property Get NoCacheToken | |||||
| NoCacheToken = Timer() * 100 | |||||
| End Property | |||||
| 'Ensures safe output | |||||
| Public Function Encode(ByVal value) | |||||
| If Not IsEmpty(value) and Not IsNull(value) then | |||||
| Encode = Server.HtmlEncode(value) | |||||
| End If | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| 'LinkTo and its relatives DO NOT HTMLEncode the link_text! This allows use of HTML within the link, especially | |||||
| 'useful for Bootstrap icons and the like. | |||||
| ' | |||||
| 'Bottom Line: If you need to HTMLEncode the link text YOU MUST DO IT YOURSELF! The H() method makes this easy! | |||||
| Public Function LinkTo(link_text, controller_name, action_name) | |||||
| LinkTo = LinkToExt(link_text, controller_name, action_name, empty, empty) | |||||
| End Function | |||||
| Public Function LinkToExt(link_text, controller_name, action_name, params_array, attribs_array) | |||||
| LinkToExt = "<a href='" & Encode(Routes.UrlTo(controller_name, action_name, params_array)) & "'" &_ | |||||
| HtmlAttribs(attribs_array) & ">" & link_text & "</a>" & vbCR | |||||
| End Function | |||||
| Public Function LinkToIf(condition, link_text, controller_name, action_name) | |||||
| if condition then | |||||
| LinkToIf = LinkToExt(link_text, controller_name, action_name, empty, empty) | |||||
| end if | |||||
| End Function | |||||
| Public Function LinkToExtIf(condition, link_text, controller_name, action_name, params_array, attribs_array) | |||||
| if condition then | |||||
| LinkToExtIf = LinkToExt(link_text, controller_name, action_name, params_array, attribs_array) | |||||
| end if | |||||
| End Function | |||||
| Public Function LinkToUnless(condition, link_text, controller_name, action_name) | |||||
| if not condition then | |||||
| LinkToIf = LinkToExt(link_text, controller_name, action_name, empty, empty) | |||||
| end if | |||||
| End Function | |||||
| Public Function LinkToExtUnless(condition, link_text, controller_name, action_name, params_array, attribs_array) | |||||
| if not condition then | |||||
| LinkToExtUnless = LinkToExt(link_text, controller_name, action_name, params_array, attribs_array) | |||||
| end if | |||||
| End Function | |||||
| '' | |||||
| ' Creates a form button and a hidden form to enforce POST submissions. Params are in hidden fields. | |||||
| '' | |||||
| 'Public Function PostButtonLinkTo(controller_name, action_name, params) | |||||
| ' dim id : id = "post_button__" & controller_name & action_name | |||||
| ' dim s | |||||
| ' s = "<form id='" & id & "' action='" & Routes.UrlTo(controller_name, action_name, empty) & "' method='POST'>" | |||||
| ' dim i, key, val | |||||
| ' for i = 0 to ubound(params) step 2 | |||||
| ' KeyVal params, i, key, val | |||||
| ' s = s & "<input type='hidden' name='" & key & "' value='" & val & "'>" | |||||
| ' next | |||||
| ' s = s & "<input type='submit' value='>>'>" | |||||
| ' s = s & "</form>" | |||||
| ' PostButtonLinkTo = s | |||||
| 'End Function | |||||
| Public Function PostButtonTo(button_contents, controller_name, action_name, form_fields) | |||||
| PostButtonTo = PostButtonToExt(button_contents, controller_name, action_name, form_fields, empty) | |||||
| End Function | |||||
| Public Function PostButtonToExt(button_contents, controller_name, action_name, form_fields, url_params) | |||||
| dim s : s = "<form action='" & Routes.UrlTo(controller_name, action_name, url_params) & "' method='POST' style='margin: 0;'>" | |||||
| dim i, key, val | |||||
| for i = 0 to ubound(form_fields) step 2 | |||||
| KeyVal form_fields, i, key, val | |||||
| s = s & HTML.Hidden(key, val) | |||||
| next | |||||
| s = s & HTML.SubmitButton(button_contents) | |||||
| s = s & "</form>" & vbCR | |||||
| PostButtonToExt = s | |||||
| End Function | |||||
| Public Function AppStylesheetTag | |||||
| AppStylesheetTag = StylesheetTag(Routes.StylesheetsURL & "App.css") | |||||
| End Function | |||||
| Public Function ControllerStylesheetTag | |||||
| ControllerStylesheetTag = StylesheetTag(Routes.StylesheetsUrl & MVC.ControllerName & "Controller.css") | |||||
| End Function | |||||
| Public Function StylesheetTag(url) | |||||
| StylesheetTag = "<link rel='stylesheet' href='" & Encode(url) & "?" & Year(now) & Month(now) & Day(now) & Hour(now) & Minute(now) & Second(now) & "'>" & vbCR | |||||
| End Function | |||||
| Public Function JSTag(url) | |||||
| JSTag = "<script type='text/javascript' src='" & Encode(url) & "'></script>" & vbCR | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Form Helpers | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Function FormTag(controller_name, action_name, route_attribs, form_attribs) | |||||
| FormTag = "<form action='" & Routes.UrlTo(controller_name, action_name, route_attribs) & "' method='POST' " & HtmlAttribs(form_attribs) & ">" & vbCR | |||||
| End Function | |||||
| Public Function Label(name, for_name) | |||||
| Label = LabelExt(name, for_name, empty) | |||||
| End Function | |||||
| Public Function LabelExt(name, for_name, attribs) | |||||
| LabelExt = "<label for='" & Encode(for_name) & "' " & HtmlAttribs(attribs) & ">" & Encode(name) & "</label>" & vbCR | |||||
| End Function | |||||
| Public Function Hidden(id, value) | |||||
| Hidden = HiddenExt(id, value, empty) | |||||
| End Function | |||||
| Public Function HiddenExt(id, value, attribs) | |||||
| HiddenExt = "<input type='hidden' id='" & Encode(id) & "' name='" & Encode(id) & "' value='" & Encode(value) & "' " & HtmlAttribs(attribs) & " >" & vbCR | |||||
| End Function | |||||
| Public Function TextBox(id, value) | |||||
| TextBox = TextBoxExt(id, value, empty) | |||||
| End Function | |||||
| Public Function TextBoxExt(id, value, attribs) | |||||
| TextBoxExt = "<input type='text' id='" & Encode(id) & "' name='" & Encode(id) & "' value='" & Encode(value) & "' " & HtmlAttribs(attribs) & " >" & vbCR | |||||
| End Function | |||||
| Public Function TextArea(id, value, rows, cols) | |||||
| TextArea = TextAreaExt(id, value, rows, cols, empty) | |||||
| End Function | |||||
| Public Function TextAreaExt(id, value, rows, cols, attribs) | |||||
| TextAreaExt = "<textarea id='" & Encode(id) & "' name='" & Encode(id) & "' cols='" & Encode(cols) & "' rows='" & Encode(rows) & "' " & HtmlAttribs(attribs) & " >" &_ | |||||
| Encode(value) & "</textarea>" & vbCR | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| 'If list is a recordset then option_value_field and option_text_field are required. | |||||
| 'If list is an array the method assumes it is a KVArray and those parameters are ignored. | |||||
| Public Function DropDownList(id, selected_value, list, option_value_field, option_text_field) | |||||
| DropDownList = DropDownListExt(id, selected_value, list, option_value_field, option_text_field, empty) | |||||
| End Function | |||||
| Public Function DropDownListExt(id, selected_value, list, option_value_field, option_text_field, attribs) | |||||
| If IsNull(selected_value) then | |||||
| selected_value = "" | |||||
| Else | |||||
| selected_value = CStr(selected_value) | |||||
| End If | |||||
| dim item, options, opt_val, opt_txt | |||||
| options = "<option value=''>" ' first value is "non-selected" blank state | |||||
| select case typename(list) | |||||
| case "Recordset" | |||||
| do until list.EOF | |||||
| If IsNull(list(option_value_field)) then | |||||
| opt_val = "" | |||||
| Else | |||||
| opt_val = CStr(list(option_value_field)) | |||||
| End If | |||||
| opt_txt = list(option_text_field) | |||||
| If Not IsNull(opt_val) And Not IsEmpty(opt_val) then | |||||
| options = options & "<option value='" & Encode(opt_val) & "' " & Choice((CStr(opt_val) = CStr(selected_value)), "selected='selected'", "") & ">" & Encode(opt_txt) & "</option>" & vbCR | |||||
| End If | |||||
| list.MoveNext | |||||
| loop | |||||
| case "Variant()" 'assumes KVArray | |||||
| dim i | |||||
| for i = 0 to ubound(list) step 2 | |||||
| KeyVal list, i, opt_val, opt_txt | |||||
| options = options & "<option value='" & Encode(opt_val) & "' " & Choice((CStr(opt_val) = CStr(selected_value)), "selected='selected'", "") & ">" & Encode(opt_txt) & "</option>" & vbCR | |||||
| next | |||||
| end select | |||||
| DropDownListExt = "<select id='" & Encode(id) & "' name='" & Encode(id) & "' " & HtmlAttribs(attribs) & " >" & vbCR & options & "</select>" & vbCR | |||||
| End Function | |||||
| Public Function Checkbox(id, value) | |||||
| Checkbox = CheckboxExt(id, value, empty) | |||||
| End Function | |||||
| Public Function CheckboxExt(id, value, attribs) | |||||
| CheckBoxExt = "<input type='checkbox' id='" & Encode(id) & "' name='" & Encode(id) & "' " & Choice( (value = 1) or (value = true) or (LCase(value) = "true") or (LCase(value) = "on"), "checked='checked'", "") & " " & HtmlAttribs(attribs) & ">" & vbCR | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| 'Button text IS NOT ENCODED! As with LinkTo, this allows use of Bootstrap icons and other arbitrary HTML in the | |||||
| 'button. If you need to HTMLEncode the text you MUST do it yourself! | |||||
| Public Function SubmitButton(text) | |||||
| SubmitButton = "<button type='submit' class='btn'>" & text & "</button>" & vbCR | |||||
| End Function | |||||
| Public Function Button(button_type, text, class_name) | |||||
| Button = "<button type='" & Encode(button_type) & "' class='btn " & Encode(class_name) & "'>" & text & "</button>" & vbCR | |||||
| End Function | |||||
| Public Function ButtonExt(button_type, text, attribs_array) | |||||
| ButtonExt = "<button type='" & Encode(button_type) & "' " & HtmlAttribs(attribs_array) & ">" & text & "</button>" & vbCR | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Function Tag(Tag_name, attribs_array) | |||||
| Tag = "<" & Encode(tag_name) & " " & HtmlAttribs(attribs_array) & ">" | |||||
| End Function | |||||
| Public Function Tag_(Tag_name) | |||||
| Tag_ = "</" & Encode(tag_name) & ">" | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Function HtmlAttribs(attribs) | |||||
| dim result : result = "" | |||||
| if not IsEmpty(attribs) then | |||||
| if IsArray(attribs) then | |||||
| dim idx | |||||
| for idx = lbound(attribs) to ubound(attribs) step 2 | |||||
| result = result & " " & HtmlAttrib(attribs, idx) & " " | |||||
| next | |||||
| else ' assume string or string-like default value | |||||
| result = attribs | |||||
| end if | |||||
| end if | |||||
| HtmlAttribs = result | |||||
| End Function | |||||
| Public Function HtmlAttrib(attribs_array, key_idx) | |||||
| dim key, val | |||||
| KeyVal attribs_array, key_idx, key, val | |||||
| HtmlAttrib = Encode(key) & "='" & Encode(val) & "'" | |||||
| End Function | |||||
| Function checkboxfor(fieldName, isChecked) | |||||
| Dim idSuffix, checkboxId, html | |||||
| ' Decide on the id suffix and checked attribute | |||||
| If isChecked Then | |||||
| idSuffix = "Checked" | |||||
| Else | |||||
| idSuffix = "Default" | |||||
| End If | |||||
| checkboxId = "flexSwitchCheck" & idSuffix | |||||
| ' Build the HTML string | |||||
| html = "<div class='form-check form-switch'>" & vbCrLf | |||||
| html = html & " <input class='form-check-input form-control' type='checkbox' id='" & checkboxId & "' name='" & fieldName & "'" | |||||
| If isChecked Then html = html & " checked" | |||||
| html = html & ">" & vbCrLf | |||||
| html = html & " <label class='form-check-label' for='" & checkboxId & "'>" & fieldName & "</label>" & vbCrLf | |||||
| html = html & "</div>" | |||||
| checkboxfor = html | |||||
| End Function | |||||
| End Class | |||||
| dim HTML_Helper__Singleton : set HTML_Helper__Singleton = Nothing | |||||
| Function HTML() | |||||
| if HTML_Helper__Singleton Is Nothing then | |||||
| set HTML_Helper__Singleton = new HTML_Helper_Class | |||||
| End if | |||||
| set HTML = HTML_Helper__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,439 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' MIGRATION SYSTEM | |||||
| '======================================================================================================================= | |||||
| ' Provides database migration capabilities for version-controlled schema changes. | |||||
| ' | |||||
| ' Features: | |||||
| ' - Sequential migration versioning (timestamp-based) | |||||
| ' - Up/Down migration support | |||||
| ' - Migration tracking in schema_migrations table | |||||
| ' - Transaction support for atomic migrations | |||||
| ' - Migration status checking | |||||
| ' | |||||
| ' Usage: | |||||
| ' Set migrator = Migrator() | |||||
| ' migrator.ApplyMigration "20260109120000_create_users_table.asp" | |||||
| ' migrator.RollbackMigration "20260109120000_create_users_table.asp" | |||||
| ' pending = migrator.GetPendingMigrations() | |||||
| ' applied = migrator.GetAppliedMigrations() | |||||
| ' | |||||
| Class Migrator_Class | |||||
| Private m_db | |||||
| Private m_migrations_path | |||||
| Private m_schema_table | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Private Sub Class_Initialize() | |||||
| Set m_db = DAL() | |||||
| m_schema_table = "schema_migrations" | |||||
| m_migrations_path = Server.MapPath("../db/migrations/") | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' Ensure the schema_migrations table exists | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub EnsureSchemaMigrationsTable() | |||||
| On Error Resume Next | |||||
| ' Try to query the table - if it doesn't exist, create it | |||||
| Dim rs | |||||
| Set rs = m_db.Query("SELECT TOP 1 version FROM " & m_schema_table, empty) | |||||
| If Err.Number <> 0 Then | |||||
| ' Table doesn't exist, create it | |||||
| Err.Clear | |||||
| On Error GoTo 0 | |||||
| Dim createSQL | |||||
| createSQL = "CREATE TABLE " & m_schema_table & " (" & _ | |||||
| "version VARCHAR(14) PRIMARY KEY, " & _ | |||||
| "applied_at DATETIME NOT NULL)" | |||||
| m_db.Execute createSQL, empty | |||||
| Else | |||||
| If Not rs Is Nothing Then | |||||
| rs.Close | |||||
| Set rs = Nothing | |||||
| End If | |||||
| End If | |||||
| On Error GoTo 0 | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' Get all applied migration versions | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Function GetAppliedMigrations() | |||||
| EnsureSchemaMigrationsTable | |||||
| Dim rs, versions, version | |||||
| Set versions = Server.CreateObject("Scripting.Dictionary") | |||||
| Set rs = m_db.Query("SELECT version FROM " & m_schema_table & " ORDER BY version", empty) | |||||
| Do While Not rs.EOF | |||||
| version = Trim(rs("version")) | |||||
| versions.Add version, True | |||||
| rs.MoveNext | |||||
| Loop | |||||
| rs.Close | |||||
| Set rs = Nothing | |||||
| Set GetAppliedMigrations = versions | |||||
| End Function | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' Get all available migration files | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Function GetAvailableMigrations() | |||||
| Dim fso, folder, files, file | |||||
| Set fso = Server.CreateObject("Scripting.FileSystemObject") | |||||
| If Not fso.FolderExists(m_migrations_path) Then | |||||
| Set GetAvailableMigrations = Server.CreateObject("Scripting.Dictionary") | |||||
| Exit Function | |||||
| End If | |||||
| Set folder = fso.GetFolder(m_migrations_path) | |||||
| Set files = folder.Files | |||||
| Dim migrations | |||||
| Set migrations = Server.CreateObject("Scripting.Dictionary") | |||||
| For Each file In files | |||||
| If LCase(fso.GetExtensionName(file.Name)) = "asp" Then | |||||
| Dim version | |||||
| version = GetVersionFromFilename(file.Name) | |||||
| If version <> "" Then | |||||
| migrations.Add version, file.Name | |||||
| End If | |||||
| End If | |||||
| Next | |||||
| Set GetAvailableMigrations = migrations | |||||
| End Function | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' Get pending migrations (available but not applied) | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Function GetPendingMigrations() | |||||
| Dim applied, available, pending, version | |||||
| Set applied = GetAppliedMigrations() | |||||
| Set available = GetAvailableMigrations() | |||||
| Set pending = Server.CreateObject("Scripting.Dictionary") | |||||
| For Each version In available.Keys | |||||
| If Not applied.Exists(version) Then | |||||
| pending.Add version, available(version) | |||||
| End If | |||||
| Next | |||||
| Set GetPendingMigrations = pending | |||||
| End Function | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' Extract version from migration filename | |||||
| ' Expected format: YYYYMMDDHHMMSS_description.asp | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Private Function GetVersionFromFilename(filename) | |||||
| Dim parts | |||||
| parts = Split(filename, "_") | |||||
| If UBound(parts) >= 0 Then | |||||
| Dim version | |||||
| version = parts(0) | |||||
| ' Validate it's a 14-digit timestamp | |||||
| If Len(version) = 14 And IsNumeric(version) Then | |||||
| GetVersionFromFilename = version | |||||
| Exit Function | |||||
| End If | |||||
| End If | |||||
| GetVersionFromFilename = "" | |||||
| End Function | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' Apply a migration (run the Up method) | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub ApplyMigration(filename) | |||||
| Dim version | |||||
| version = GetVersionFromFilename(filename) | |||||
| If version = "" Then | |||||
| Err.Raise vbObjectError + 1, "Migrator", "Invalid migration filename format: " & filename | |||||
| End If | |||||
| ' Check if already applied | |||||
| Dim applied | |||||
| Set applied = GetAppliedMigrations() | |||||
| If applied.Exists(version) Then | |||||
| Response.Write "Migration " & version & " already applied. Skipping." & vbCrLf | |||||
| Exit Sub | |||||
| End If | |||||
| Response.Write "Applying migration: " & filename & "..." & vbCrLf | |||||
| ' Begin transaction | |||||
| m_db.BeginTransaction | |||||
| On Error Resume Next | |||||
| ' Execute the migration file | |||||
| ExecuteMigrationFile filename, "Up" | |||||
| If Err.Number <> 0 Then | |||||
| Dim errMsg | |||||
| errMsg = "Migration failed: " & Err.Description | |||||
| m_db.RollbackTransaction | |||||
| Err.Raise vbObjectError + 2, "Migrator", errMsg | |||||
| End If | |||||
| ' Record the migration | |||||
| m_db.Execute "INSERT INTO " & m_schema_table & " (version, applied_at) VALUES (?, ?)", _ | |||||
| Array(version, Now()) | |||||
| If Err.Number <> 0 Then | |||||
| Dim recordErr | |||||
| recordErr = "Failed to record migration: " & Err.Description | |||||
| m_db.RollbackTransaction | |||||
| Err.Raise vbObjectError + 3, "Migrator", recordErr | |||||
| End If | |||||
| ' Commit transaction | |||||
| m_db.CommitTransaction | |||||
| On Error GoTo 0 | |||||
| Response.Write "Migration " & version & " applied successfully." & vbCrLf | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' Rollback a migration (run the Down method) | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub RollbackMigration(filename) | |||||
| Dim version | |||||
| version = GetVersionFromFilename(filename) | |||||
| If version = "" Then | |||||
| Err.Raise vbObjectError + 1, "Migrator", "Invalid migration filename format: " & filename | |||||
| End If | |||||
| ' Check if applied | |||||
| Dim applied | |||||
| Set applied = GetAppliedMigrations() | |||||
| If Not applied.Exists(version) Then | |||||
| Response.Write "Migration " & version & " not applied. Skipping." & vbCrLf | |||||
| Exit Sub | |||||
| End If | |||||
| Response.Write "Rolling back migration: " & filename & "..." & vbCrLf | |||||
| ' Begin transaction | |||||
| m_db.BeginTransaction | |||||
| On Error Resume Next | |||||
| ' Execute the migration file | |||||
| ExecuteMigrationFile filename, "Down" | |||||
| If Err.Number <> 0 Then | |||||
| Dim errMsg | |||||
| errMsg = "Rollback failed: " & Err.Description | |||||
| m_db.RollbackTransaction | |||||
| Err.Raise vbObjectError + 4, "Migrator", errMsg | |||||
| End If | |||||
| ' Remove the migration record | |||||
| m_db.Execute "DELETE FROM " & m_schema_table & " WHERE version = ?", version | |||||
| If Err.Number <> 0 Then | |||||
| Dim recordErr | |||||
| recordErr = "Failed to remove migration record: " & Err.Description | |||||
| m_db.RollbackTransaction | |||||
| Err.Raise vbObjectError + 5, "Migrator", recordErr | |||||
| End If | |||||
| ' Commit transaction | |||||
| m_db.CommitTransaction | |||||
| On Error GoTo 0 | |||||
| Response.Write "Migration " & version & " rolled back successfully." & vbCrLf | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' Execute a migration file's Up or Down method | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Private Sub ExecuteMigrationFile(filename, direction) | |||||
| Dim migrationPath | |||||
| migrationPath = m_migrations_path & filename | |||||
| Dim fso | |||||
| Set fso = Server.CreateObject("Scripting.FileSystemObject") | |||||
| If Not fso.FileExists(migrationPath) Then | |||||
| Err.Raise vbObjectError + 6, "Migrator", "Migration file not found: " & migrationPath | |||||
| End If | |||||
| ' Create a migration context that the file can use | |||||
| Dim migration | |||||
| Set migration = New MigrationContext_Class | |||||
| Set migration.DB = m_db | |||||
| ' Include and execute the migration file | |||||
| Server.Execute(migrationPath) | |||||
| ' Call the appropriate method (Up or Down) | |||||
| If direction = "Up" Then | |||||
| Execute "Call Migration_Up(migration)" | |||||
| ElseIf direction = "Down" Then | |||||
| Execute "Call Migration_Down(migration)" | |||||
| End If | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' Apply all pending migrations | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub ApplyAllPending() | |||||
| Dim pending, version, versions() | |||||
| Set pending = GetPendingMigrations() | |||||
| If pending.Count = 0 Then | |||||
| Response.Write "No pending migrations." & vbCrLf | |||||
| Exit Sub | |||||
| End If | |||||
| ' Sort versions | |||||
| ReDim versions(pending.Count - 1) | |||||
| Dim i : i = 0 | |||||
| For Each version In pending.Keys | |||||
| versions(i) = version | |||||
| i = i + 1 | |||||
| Next | |||||
| ' Simple bubble sort for versions | |||||
| Dim j, temp | |||||
| For i = 0 To UBound(versions) - 1 | |||||
| For j = i + 1 To UBound(versions) | |||||
| If CLng(versions(i)) > CLng(versions(j)) Then | |||||
| temp = versions(i) | |||||
| versions(i) = versions(j) | |||||
| versions(j) = temp | |||||
| End If | |||||
| Next | |||||
| Next | |||||
| ' Apply in order | |||||
| For i = 0 To UBound(versions) | |||||
| ApplyMigration pending(versions(i)) | |||||
| Next | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' Rollback the last applied migration | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub RollbackLast() | |||||
| Dim applied, version, lastVersion | |||||
| Set applied = GetAppliedMigrations() | |||||
| If applied.Count = 0 Then | |||||
| Response.Write "No migrations to rollback." & vbCrLf | |||||
| Exit Sub | |||||
| End If | |||||
| ' Find the last version | |||||
| lastVersion = "" | |||||
| For Each version In applied.Keys | |||||
| If lastVersion = "" Or CLng(version) > CLng(lastVersion) Then | |||||
| lastVersion = version | |||||
| End If | |||||
| Next | |||||
| ' Find the filename | |||||
| Dim available | |||||
| Set available = GetAvailableMigrations() | |||||
| If available.Exists(lastVersion) Then | |||||
| RollbackMigration available(lastVersion) | |||||
| Else | |||||
| Err.Raise vbObjectError + 7, "Migrator", "Migration file not found for version: " & lastVersion | |||||
| End If | |||||
| End Sub | |||||
| End Class | |||||
| '======================================================================================================================= | |||||
| ' MIGRATION CONTEXT | |||||
| '======================================================================================================================= | |||||
| ' Provides helper methods for use within migration files | |||||
| ' | |||||
| Class MigrationContext_Class | |||||
| Public DB ' Reference to DAL | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' Execute raw SQL | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub ExecuteSQL(sql) | |||||
| DB.Execute sql, empty | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' Create a table | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub CreateTable(tableName, columns) | |||||
| Dim sql | |||||
| sql = "CREATE TABLE " & tableName & " (" & columns & ")" | |||||
| ExecuteSQL sql | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' Drop a table | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub DropTable(tableName) | |||||
| ExecuteSQL "DROP TABLE " & tableName | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' Add a column to a table | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub AddColumn(tableName, columnName, columnType) | |||||
| ExecuteSQL "ALTER TABLE " & tableName & " ADD COLUMN " & columnName & " " & columnType | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' Drop a column from a table | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub DropColumn(tableName, columnName) | |||||
| ExecuteSQL "ALTER TABLE " & tableName & " DROP COLUMN " & columnName | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' Create an index | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub CreateIndex(indexName, tableName, columns) | |||||
| ExecuteSQL "CREATE INDEX " & indexName & " ON " & tableName & " (" & columns & ")" | |||||
| End Sub | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| ' Drop an index | |||||
| '------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub DropIndex(indexName, tableName) | |||||
| ExecuteSQL "DROP INDEX " & indexName & " ON " & tableName | |||||
| End Sub | |||||
| End Class | |||||
| '======================================================================================================================= | |||||
| ' SINGLETON | |||||
| '======================================================================================================================= | |||||
| Dim Migrator__Singleton : Set Migrator__Singleton = Nothing | |||||
| Function Migrator() | |||||
| If Migrator__Singleton Is Nothing Then | |||||
| Set Migrator__Singleton = New Migrator_Class | |||||
| End If | |||||
| Set Migrator = Migrator__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,262 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' ROUTING HELPER | |||||
| ' Provides URL generation for RouteKit framework | |||||
| '======================================================================================================================= | |||||
| Class Route_Helper_Class | |||||
| Private m_app_url | |||||
| Private m_content_url | |||||
| Private m_stylesheets_url | |||||
| Private m_js_url | |||||
| Private m_images_url | |||||
| Private m_enable_cache_busting | |||||
| Private m_cache_bust_param_name | |||||
| Private Sub Class_Initialize() | |||||
| ' Auto-detect application URL from current request | |||||
| Dim protocol, host, appPath | |||||
| protocol = IIf(Request.ServerVariables("HTTPS") = "on", "https://", "http://") | |||||
| host = Request.ServerVariables("HTTP_HOST") | |||||
| appPath = Request.ServerVariables("APPL_MD_PATH") | |||||
| ' Extract virtual directory from IIS path | |||||
| Dim vdir | |||||
| vdir = "" | |||||
| If InStr(appPath, "/LM/W3SVC/") > 0 Then | |||||
| vdir = Mid(appPath, InStrRev(appPath, "/") + 1) | |||||
| If vdir <> "ROOT" Then | |||||
| vdir = "/" & vdir | |||||
| Else | |||||
| vdir = "" | |||||
| End If | |||||
| End If | |||||
| m_app_url = protocol & host & vdir & "/" | |||||
| m_content_url = m_app_url & "content/" | |||||
| m_stylesheets_url = m_app_url & "css/" | |||||
| m_js_url = m_app_url & "js/" | |||||
| m_images_url = m_app_url & "images/" | |||||
| ' Load cache-busting configuration | |||||
| Dim cacheBustSetting | |||||
| cacheBustSetting = GetAppSetting("EnableCacheBusting") | |||||
| m_enable_cache_busting = (cacheBustSetting = "true" Or cacheBustSetting = "True") | |||||
| ' Get cache-bust parameter name (default: "v") | |||||
| m_cache_bust_param_name = GetAppSetting("CacheBustParamName") | |||||
| If m_cache_bust_param_name = "nothing" Or Len(m_cache_bust_param_name) = 0 Then | |||||
| m_cache_bust_param_name = "v" | |||||
| End If | |||||
| End Sub | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Cache-busting token (timestamp-based for uniqueness) | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Property Get NoCacheToken | |||||
| NoCacheToken = CLng(Timer() * 100) | |||||
| End Property | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Check if cache-busting is globally enabled | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Property Get CacheBustingEnabled | |||||
| CacheBustingEnabled = m_enable_cache_busting | |||||
| End Property | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Get/Set cache-busting enabled (can override config at runtime) | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Property Let CacheBustingEnabled(value) | |||||
| m_enable_cache_busting = value | |||||
| End Property | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' URL Properties | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Property Get AppURL | |||||
| AppURL = m_app_url | |||||
| End Property | |||||
| Public Property Get ContentURL | |||||
| ContentURL = m_content_url | |||||
| End Property | |||||
| Public Property Get StylesheetsURL | |||||
| StylesheetsURL = m_stylesheets_url | |||||
| End Property | |||||
| Public Property Get JsURL | |||||
| JsURL = m_js_url | |||||
| End Property | |||||
| Public Property Get ImagesURL | |||||
| ImagesURL = m_images_url | |||||
| End Property | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Generate clean URL for controller/action (RouteKit style) | |||||
| ' | |||||
| ' @param controller_name String Name of controller (without "Controller" suffix) | |||||
| ' @param action_name String Name of action method | |||||
| ' @param params_array KV Array Optional key/value pair array for query string | |||||
| ' @returns String Clean URL like "/controller/action?key=val" | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Function UrlTo(controller_name, action_name, params_array) | |||||
| Dim url, qs | |||||
| ' Build clean URL: /controller/action | |||||
| url = m_app_url & LCase(controller_name) & "/" & LCase(action_name) | |||||
| ' Add query string parameters if provided | |||||
| qs = TO_Querystring(params_array) | |||||
| If Len(qs) > 0 Then | |||||
| url = url & "?" & qs | |||||
| End If | |||||
| UrlTo = url | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Generate URL with route parameters (e.g., /users/show/123) | |||||
| ' | |||||
| ' @param controller_name String Name of controller | |||||
| ' @param action_name String Name of action method | |||||
| ' @param route_params Array Route parameters (e.g., Array(123) for ID) | |||||
| ' @param query_params KV Array Optional query string parameters | |||||
| ' @returns String URL with route params | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Function UrlToWithParams(controller_name, action_name, route_params, query_params) | |||||
| Dim url, qs, i | |||||
| ' Build base URL | |||||
| url = m_app_url & LCase(controller_name) & "/" & LCase(action_name) | |||||
| ' Append route parameters | |||||
| If IsArray(route_params) Then | |||||
| For i = 0 To UBound(route_params) | |||||
| url = url & "/" & Server.URLEncode(CStr(route_params(i))) | |||||
| Next | |||||
| ElseIf Not IsEmpty(route_params) Then | |||||
| url = url & "/" & Server.URLEncode(CStr(route_params)) | |||||
| End If | |||||
| ' Add query string parameters if provided | |||||
| qs = TO_Querystring(query_params) | |||||
| If Len(qs) > 0 Then | |||||
| url = url & "?" & qs | |||||
| End If | |||||
| UrlToWithParams = url | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Generate URL for static asset with cache-busting | |||||
| ' | |||||
| ' @param asset_path String Relative path to asset (e.g., "css/site.css") | |||||
| ' @param use_cache_bust Variant Boolean or Empty. If Empty, uses global setting. If True/False, overrides. | |||||
| ' @returns String Full URL to asset | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Function AssetUrl(asset_path, use_cache_bust) | |||||
| Dim url, shouldBust | |||||
| url = m_app_url & asset_path | |||||
| ' Determine if we should cache-bust | |||||
| If IsEmpty(use_cache_bust) Then | |||||
| shouldBust = m_enable_cache_busting | |||||
| Else | |||||
| shouldBust = CBool(use_cache_bust) | |||||
| End If | |||||
| If shouldBust Then | |||||
| url = AppendCacheBustParam(url) | |||||
| End If | |||||
| AssetUrl = url | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Generate URL for route with optional cache-busting | |||||
| ' | |||||
| ' @param controller_name String Name of controller | |||||
| ' @param action_name String Name of action | |||||
| ' @param params_array KV Array Optional query params | |||||
| ' @param use_cache_bust Variant Boolean or Empty. If Empty, uses global setting | |||||
| ' @returns String URL with optional cache-busting | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Function UrlToWithCacheBust(controller_name, action_name, params_array, use_cache_bust) | |||||
| Dim url | |||||
| url = UrlTo(controller_name, action_name, params_array) | |||||
| ' Determine if we should cache-bust | |||||
| Dim shouldBust | |||||
| If IsEmpty(use_cache_bust) Then | |||||
| shouldBust = m_enable_cache_busting | |||||
| Else | |||||
| shouldBust = CBool(use_cache_bust) | |||||
| End If | |||||
| If shouldBust Then | |||||
| url = AppendCacheBustParam(url) | |||||
| End If | |||||
| UrlToWithCacheBust = url | |||||
| End Function | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' PRIVATE HELPER METHODS | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Private Function TO_Querystring(the_array) | |||||
| Dim result, idx | |||||
| result = "" | |||||
| If Not IsEmpty(the_array) And IsArray(the_array) Then | |||||
| ' Process key-value pairs (array with even number of elements) | |||||
| For idx = LBound(the_array) To UBound(the_array) Step 2 | |||||
| If idx + 1 <= UBound(the_array) Then | |||||
| result = result & GetParam(the_array, idx) | |||||
| ' Append & between parameters, but not on the last parameter | |||||
| If Not (idx >= UBound(the_array) - 1) Then | |||||
| result = result & "&" | |||||
| End If | |||||
| End If | |||||
| Next | |||||
| End If | |||||
| TO_Querystring = result | |||||
| End Function | |||||
| Private Function GetParam(params_array, key_idx) | |||||
| Dim key, val | |||||
| key = Server.URLEncode(CStr(params_array(key_idx))) | |||||
| val = Server.URLEncode(CStr(params_array(key_idx + 1))) | |||||
| GetParam = key & "=" & val | |||||
| End Function | |||||
| Private Function AppendCacheBustParam(url) | |||||
| Dim separator | |||||
| ' Determine if we need ? or & | |||||
| If InStr(url, "?") > 0 Then | |||||
| separator = "&" | |||||
| Else | |||||
| separator = "?" | |||||
| End If | |||||
| AppendCacheBustParam = url & separator & m_cache_bust_param_name & "=" & NoCacheToken | |||||
| End Function | |||||
| End Class | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Singleton accessor | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Dim Route_Helper__Singleton | |||||
| Set Route_Helper__Singleton = Nothing | |||||
| Function Routes() | |||||
| If Route_Helper__Singleton Is Nothing Then | |||||
| Set Route_Helper__Singleton = New Route_Helper_Class | |||||
| End If | |||||
| Set Routes = Route_Helper__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,73 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' StringBuilder Class | |||||
| '======================================================================================================================= | |||||
| Class StringBuilder_Class | |||||
| dim m_array | |||||
| dim m_array_size | |||||
| dim m_cur_pos | |||||
| Private Sub Class_Initialize | |||||
| m_array = Array | |||||
| m_array_size = 100 | |||||
| redim m_array(m_array_size) | |||||
| m_cur_pos = -1 | |||||
| End Sub | |||||
| Private Sub Extend | |||||
| m_array_size = m_array_size + 100 | |||||
| redim preserve m_array(m_array_size) | |||||
| End Sub | |||||
| Public Sub Add(s) | |||||
| m_cur_pos = m_cur_pos + 1 | |||||
| m_array(m_cur_pos) = s | |||||
| if m_cur_pos = m_array_size then Extend | |||||
| End Sub | |||||
| Public Function [Get](delim) | |||||
| 'have to create a new array containing only the slots actually used, otherwise Join() happily adds delim | |||||
| 'for *every* slot even the unused ones... | |||||
| dim new_array : new_array = Array() | |||||
| redim new_array(m_cur_pos) | |||||
| dim i | |||||
| for i = 0 to m_cur_pos | |||||
| new_array(i) = m_array(i) | |||||
| next | |||||
| [Get] = Join(new_array, delim) | |||||
| End Function | |||||
| Public Default Property Get TO_String | |||||
| TO_String = Join(m_array, "") | |||||
| End Property | |||||
| End Class | |||||
| Function StringBuilder() | |||||
| set StringBuilder = new StringBuilder_Class | |||||
| End Function | |||||
| '======================================================================================================================= | |||||
| ' Misc | |||||
| '======================================================================================================================= | |||||
| Function Excerpt(text, length) | |||||
| Excerpt = Left(text, length) & " ..." | |||||
| End Function | |||||
| Function IsBlank(text) | |||||
| If IsObject(text) then | |||||
| If text Is Nothing then | |||||
| IsBlank = true | |||||
| Else | |||||
| IsBlank = false | |||||
| End If | |||||
| Else | |||||
| If IsEmpty(text) or IsNull(text) or Len(text) = 0 then | |||||
| IsBlank = true | |||||
| Else | |||||
| IsBlank = false | |||||
| End If | |||||
| End If | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,405 @@ | |||||
| <!--METADATA | |||||
| TYPE="TypeLib" | |||||
| NAME="Microsoft ActiveX Data Objects 2.5 Library" | |||||
| UUID="{00000205-0000-0010-8000-00AA006D2EA4}" | |||||
| VERSION="2.5" | |||||
| --> | |||||
| <% | |||||
| ' For examples, documentation, and your own free copy, go to: | |||||
| ' http://www.freeaspupload.net | |||||
| ' Note: You can copy and use this script for free and you can make changes | |||||
| ' to the code, but you cannot remove the above comment. | |||||
| 'Changes: | |||||
| 'Aug 2, 2005: Add support for checkboxes and other input elements with multiple values | |||||
| 'Jan 6, 2009: Lars added ASP_CHUNK_SIZE | |||||
| const DEFAULT_ASP_CHUNK_SIZE = 200000 | |||||
| Class FreeASPUpload | |||||
| Public UploadedFiles | |||||
| Public FormElements | |||||
| Private VarArrayBinRequest | |||||
| Private StreamRequest | |||||
| Private uploadedYet | |||||
| Private internalChunkSize | |||||
| Private Sub Class_Initialize() | |||||
| Set UploadedFiles = Server.CreateObject("Scripting.Dictionary") | |||||
| Set FormElements = Server.CreateObject("Scripting.Dictionary") | |||||
| Set StreamRequest = Server.CreateObject("ADODB.Stream") | |||||
| StreamRequest.Type = 2 ' adTypeText | |||||
| StreamRequest.Open | |||||
| uploadedYet = false | |||||
| internalChunkSize = DEFAULT_ASP_CHUNK_SIZE | |||||
| End Sub | |||||
| Private Sub Class_Terminate() | |||||
| If IsObject(UploadedFiles) Then | |||||
| UploadedFiles.RemoveAll() | |||||
| Set UploadedFiles = Nothing | |||||
| End If | |||||
| If IsObject(FormElements) Then | |||||
| FormElements.RemoveAll() | |||||
| Set FormElements = Nothing | |||||
| End If | |||||
| StreamRequest.Close | |||||
| Set StreamRequest = Nothing | |||||
| End Sub | |||||
| Public Property Get Form(sIndex) | |||||
| Form = "" | |||||
| If FormElements.Exists(LCase(sIndex)) Then Form = FormElements.Item(LCase(sIndex)) | |||||
| End Property | |||||
| Public Property Get Files() | |||||
| Files = UploadedFiles.Items | |||||
| End Property | |||||
| Public Property Get Exists(sIndex) | |||||
| Exists = false | |||||
| If FormElements.Exists(LCase(sIndex)) Then Exists = true | |||||
| End Property | |||||
| Public Property Get FileExists(sIndex) | |||||
| FileExists = false | |||||
| if UploadedFiles.Exists(LCase(sIndex)) then FileExists = true | |||||
| End Property | |||||
| Public Property Get chunkSize() | |||||
| chunkSize = internalChunkSize | |||||
| End Property | |||||
| Public Property Let chunkSize(sz) | |||||
| internalChunkSize = sz | |||||
| End Property | |||||
| 'Calls Upload to extract the data from the binary request and then saves the uploaded files | |||||
| Public Sub Save(path) | |||||
| Dim streamFile, fileItem | |||||
| if Right(path, 1) <> "\" then path = path & "\" | |||||
| if not uploadedYet then Upload | |||||
| For Each fileItem In UploadedFiles.Items | |||||
| Set streamFile = Server.CreateObject("ADODB.Stream") | |||||
| streamFile.Type = 1 | |||||
| streamFile.Open | |||||
| StreamRequest.Position=fileItem.Start | |||||
| StreamRequest.CopyTo streamFile, fileItem.Length | |||||
| streamFile.SaveToFile path & fileItem.FileName, 2 | |||||
| streamFile.close | |||||
| Set streamFile = Nothing | |||||
| fileItem.Path = path & fileItem.FileName | |||||
| Next | |||||
| End Sub | |||||
| public sub SaveOne(path, num, byref outFileName, byref outLocalFileName) | |||||
| Dim streamFile, fileItems, fileItem, fs | |||||
| set fs = Server.CreateObject("Scripting.FileSystemObject") | |||||
| if Right(path, 1) <> "\" then path = path & "\" | |||||
| if not uploadedYet then Upload | |||||
| if UploadedFiles.Count > 0 then | |||||
| fileItems = UploadedFiles.Items | |||||
| set fileItem = fileItems(num) | |||||
| outFileName = fileItem.FileName | |||||
| outLocalFileName = GetFileName(path, outFileName) | |||||
| Set streamFile = Server.CreateObject("ADODB.Stream") | |||||
| streamFile.Type = 1 | |||||
| streamFile.Open | |||||
| StreamRequest.Position = fileItem.Start | |||||
| StreamRequest.CopyTo streamFile, fileItem.Length | |||||
| streamFile.SaveToFile path & outLocalFileName, 2 | |||||
| streamFile.close | |||||
| Set streamFile = Nothing | |||||
| fileItem.Path = path & filename | |||||
| end if | |||||
| end sub | |||||
| Public Function SaveBinRequest(path) ' For debugging purposes | |||||
| StreamRequest.SaveToFile path & "\debugStream.bin", 2 | |||||
| End Function | |||||
| Public Sub DumpData() 'only works if files are plain text | |||||
| Dim i, aKeys, f | |||||
| response.write "Form Items:<br>" | |||||
| aKeys = FormElements.Keys | |||||
| For i = 0 To FormElements.Count -1 ' Iterate the array | |||||
| response.write aKeys(i) & " = " & FormElements.Item(aKeys(i)) & "<BR>" | |||||
| Next | |||||
| response.write "Uploaded Files:<br>" | |||||
| For Each f In UploadedFiles.Items | |||||
| response.write "Name: " & f.FileName & "<br>" | |||||
| response.write "Type: " & f.ContentType & "<br>" | |||||
| response.write "Start: " & f.Start & "<br>" | |||||
| response.write "Size: " & f.Length & "<br>" | |||||
| Next | |||||
| End Sub | |||||
| Public Sub Upload() | |||||
| Dim nCurPos, nDataBoundPos, nLastSepPos | |||||
| Dim nPosFile, nPosBound | |||||
| Dim sFieldName, osPathSep, auxStr | |||||
| Dim readBytes, readLoop, tmpBinRequest | |||||
| 'RFC1867 Tokens | |||||
| Dim vDataSep | |||||
| Dim tNewLine, tDoubleQuotes, tTerm, tFilename, tName, tContentDisp, tContentType | |||||
| tNewLine = String2Byte(Chr(13)) | |||||
| tDoubleQuotes = String2Byte(Chr(34)) | |||||
| tTerm = String2Byte("--") | |||||
| tFilename = String2Byte("filename=""") | |||||
| tName = String2Byte("name=""") | |||||
| tContentDisp = String2Byte("Content-Disposition") | |||||
| tContentType = String2Byte("Content-Type:") | |||||
| uploadedYet = true | |||||
| on error resume next | |||||
| readBytes = internalChunkSize | |||||
| VarArrayBinRequest = Request.BinaryRead(readBytes) | |||||
| VarArrayBinRequest = midb(VarArrayBinRequest, 1, lenb(VarArrayBinRequest)) | |||||
| for readLoop = 0 to 300000 | |||||
| tmpBinRequest = Request.BinaryRead(readBytes) | |||||
| if readBytes < 1 then exit for | |||||
| VarArrayBinRequest = VarArrayBinRequest & midb(tmpBinRequest, 1, lenb(tmpBinRequest)) | |||||
| next | |||||
| if Err.Number <> 0 then | |||||
| response.write "<br><br><B>System reported this error:</B><p>" | |||||
| response.write Err.Description & "<p>" | |||||
| response.write "The most likely cause for this error is the incorrect setup of AspMaxRequestEntityAllowed in IIS MetaBase. Please see instructions in the <A HREF='http://www.freeaspupload.net/freeaspupload/requirements.asp'>requirements page of freeaspupload.net</A>.<p>" | |||||
| Exit Sub | |||||
| end if | |||||
| on error goto 0 'reset error handling | |||||
| nCurPos = FindToken(tNewLine,1) 'Note: nCurPos is 1-based (and so is InstrB, MidB, etc) | |||||
| If nCurPos <= 1 Then Exit Sub | |||||
| 'vDataSep is a separator like -----------------------------21763138716045 | |||||
| vDataSep = MidB(VarArrayBinRequest, 1, nCurPos-1) | |||||
| 'Start of current separator | |||||
| nDataBoundPos = 1 | |||||
| 'Beginning of last line | |||||
| nLastSepPos = FindToken(vDataSep & tTerm, 1) | |||||
| Do Until nDataBoundPos = nLastSepPos | |||||
| nCurPos = SkipToken(tContentDisp, nDataBoundPos) | |||||
| nCurPos = SkipToken(tName, nCurPos) | |||||
| sFieldName = ExtractField(tDoubleQuotes, nCurPos) | |||||
| nPosFile = FindToken(tFilename, nCurPos) | |||||
| nPosBound = FindToken(vDataSep, nCurPos) | |||||
| If nPosFile <> 0 And nPosFile < nPosBound Then | |||||
| Dim oUploadFile | |||||
| Set oUploadFile = New UploadedFile | |||||
| nCurPos = SkipToken(tFilename, nCurPos) | |||||
| auxStr = ExtractField(tDoubleQuotes, nCurPos) | |||||
| ' We are interested only in the name of the file, not the whole path | |||||
| ' Path separator is \ in windows, / in UNIX | |||||
| ' While IE seems to put the whole pathname in the stream, Mozilla seem to | |||||
| ' only put the actual file name, so UNIX paths may be rare. But not impossible. | |||||
| osPathSep = "\" | |||||
| if InStr(auxStr, osPathSep) = 0 then osPathSep = "/" | |||||
| oUploadFile.FileName = Right(auxStr, Len(auxStr)-InStrRev(auxStr, osPathSep)) | |||||
| if (Len(oUploadFile.FileName) > 0) then 'File field not left empty | |||||
| nCurPos = SkipToken(tContentType, nCurPos) | |||||
| auxStr = ExtractField(tNewLine, nCurPos) | |||||
| ' NN on UNIX puts things like this in the stream: | |||||
| ' ?? python py type=?? python application/x-python | |||||
| oUploadFile.ContentType = Right(auxStr, Len(auxStr)-InStrRev(auxStr, " ")) | |||||
| nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line | |||||
| oUploadFile.Start = nCurPos+1 | |||||
| oUploadFile.Length = FindToken(vDataSep, nCurPos) - 2 - nCurPos | |||||
| If oUploadFile.Length > 0 Then UploadedFiles.Add LCase(sFieldName), oUploadFile | |||||
| End If | |||||
| Else | |||||
| Dim nEndOfData | |||||
| nCurPos = FindToken(tNewLine, nCurPos) + 4 'skip empty line | |||||
| nEndOfData = FindToken(vDataSep, nCurPos) - 2 | |||||
| If Not FormElements.Exists(LCase(sFieldName)) Then | |||||
| FormElements.Add LCase(sFieldName), Byte2String(MidB(VarArrayBinRequest, nCurPos, nEndOfData-nCurPos)) | |||||
| else | |||||
| FormElements.Item(LCase(sFieldName))= FormElements.Item(LCase(sFieldName)) & ", " & Byte2String(MidB(VarArrayBinRequest, nCurPos, nEndOfData-nCurPos)) | |||||
| end if | |||||
| End If | |||||
| 'Advance to next separator | |||||
| nDataBoundPos = FindToken(vDataSep, nCurPos) | |||||
| Loop | |||||
| StreamRequest.WriteText(VarArrayBinRequest) | |||||
| End Sub | |||||
| Private Function SkipToken(sToken, nStart) | |||||
| SkipToken = InstrB(nStart, VarArrayBinRequest, sToken) | |||||
| If SkipToken = 0 then | |||||
| Response.write "Error in parsing uploaded binary request. The most likely cause for this error is the incorrect setup of AspMaxRequestEntityAllowed in IIS MetaBase. Please see instructions in the <A HREF='http://www.freeaspupload.net/freeaspupload/requirements.asp'>requirements page of freeaspupload.net</A>.<p>" | |||||
| Response.End | |||||
| end if | |||||
| SkipToken = SkipToken + LenB(sToken) | |||||
| End Function | |||||
| Private Function FindToken(sToken, nStart) | |||||
| FindToken = InstrB(nStart, VarArrayBinRequest, sToken) | |||||
| End Function | |||||
| Private Function ExtractField(sToken, nStart) | |||||
| Dim nEnd | |||||
| nEnd = InstrB(nStart, VarArrayBinRequest, sToken) | |||||
| If nEnd = 0 then | |||||
| Response.write "Error in parsing uploaded binary request." | |||||
| Response.End | |||||
| end if | |||||
| ExtractField = Byte2String(MidB(VarArrayBinRequest, nStart, nEnd-nStart)) | |||||
| End Function | |||||
| 'String to byte string conversion | |||||
| Private Function String2Byte(sString) | |||||
| Dim i | |||||
| For i = 1 to Len(sString) | |||||
| String2Byte = String2Byte & ChrB(AscB(Mid(sString,i,1))) | |||||
| Next | |||||
| End Function | |||||
| 'Byte string to string conversion | |||||
| Private Function Byte2String(bsString) | |||||
| Dim i | |||||
| dim b1, b2, b3, b4 | |||||
| Byte2String ="" | |||||
| For i = 1 to LenB(bsString) | |||||
| if AscB(MidB(bsString,i,1)) < 128 then | |||||
| ' One byte | |||||
| Byte2String = Byte2String & ChrW(AscB(MidB(bsString,i,1))) | |||||
| elseif AscB(MidB(bsString,i,1)) < 224 then | |||||
| ' Two bytes | |||||
| b1 = AscB(MidB(bsString,i,1)) | |||||
| b2 = AscB(MidB(bsString,i+1,1)) | |||||
| Byte2String = Byte2String & ChrW((((b1 AND 28) / 4) * 256 + (b1 AND 3) * 64 + (b2 AND 63))) | |||||
| i = i + 1 | |||||
| elseif AscB(MidB(bsString,i,1)) < 240 then | |||||
| ' Three bytes | |||||
| b1 = AscB(MidB(bsString,i,1)) | |||||
| b2 = AscB(MidB(bsString,i+1,1)) | |||||
| b3 = AscB(MidB(bsString,i+2,1)) | |||||
| Byte2String = Byte2String & ChrW(((b1 AND 15) * 16 + (b2 AND 60)) * 256 + (b2 AND 3) * 64 + (b3 AND 63)) | |||||
| i = i + 2 | |||||
| else | |||||
| ' Four bytes | |||||
| b1 = AscB(MidB(bsString,i,1)) | |||||
| b2 = AscB(MidB(bsString,i+1,1)) | |||||
| b3 = AscB(MidB(bsString,i+2,1)) | |||||
| b4 = AscB(MidB(bsString,i+3,1)) | |||||
| ' Don't know how to handle this, I believe Microsoft doesn't support these characters so I replace them with a "^" | |||||
| 'Byte2String = Byte2String & ChrW(((b1 AND 3) * 64 + (b2 AND 63)) & "," & (((b1 AND 28) / 4) * 256 + (b1 AND 3) * 64 + (b2 AND 63))) | |||||
| Byte2String = Byte2String & "^" | |||||
| i = i + 3 | |||||
| end if | |||||
| Next | |||||
| End Function | |||||
| End Class | |||||
| Class UploadedFile | |||||
| Public ContentType | |||||
| Public Start | |||||
| Public Length | |||||
| Public Path | |||||
| Private nameOfFile | |||||
| ' Need to remove characters that are valid in UNIX, but not in Windows | |||||
| Public Property Let FileName(fN) | |||||
| nameOfFile = fN | |||||
| nameOfFile = SubstNoReg(nameOfFile, "\", "_") | |||||
| nameOfFile = SubstNoReg(nameOfFile, "/", "_") | |||||
| nameOfFile = SubstNoReg(nameOfFile, ":", "_") | |||||
| nameOfFile = SubstNoReg(nameOfFile, "*", "_") | |||||
| nameOfFile = SubstNoReg(nameOfFile, "?", "_") | |||||
| nameOfFile = SubstNoReg(nameOfFile, """", "_") | |||||
| nameOfFile = SubstNoReg(nameOfFile, "<", "_") | |||||
| nameOfFile = SubstNoReg(nameOfFile, ">", "_") | |||||
| nameOfFile = SubstNoReg(nameOfFile, "|", "_") | |||||
| End Property | |||||
| Public Property Get FileName() | |||||
| FileName = nameOfFile | |||||
| End Property | |||||
| 'Public Property Get FileN()ame | |||||
| End Class | |||||
| ' Does not depend on RegEx, which is not available on older VBScript | |||||
| ' Is not recursive, which means it will not run out of stack space | |||||
| Function SubstNoReg(initialStr, oldStr, newStr) | |||||
| Dim currentPos, oldStrPos, skip | |||||
| If IsNull(initialStr) Or Len(initialStr) = 0 Then | |||||
| SubstNoReg = "" | |||||
| ElseIf IsNull(oldStr) Or Len(oldStr) = 0 Then | |||||
| SubstNoReg = initialStr | |||||
| Else | |||||
| If IsNull(newStr) Then newStr = "" | |||||
| currentPos = 1 | |||||
| oldStrPos = 0 | |||||
| SubstNoReg = "" | |||||
| skip = Len(oldStr) | |||||
| Do While currentPos <= Len(initialStr) | |||||
| oldStrPos = InStr(currentPos, initialStr, oldStr) | |||||
| If oldStrPos = 0 Then | |||||
| SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, Len(initialStr) - currentPos + 1) | |||||
| currentPos = Len(initialStr) + 1 | |||||
| Else | |||||
| SubstNoReg = SubstNoReg & Mid(initialStr, currentPos, oldStrPos - currentPos) & newStr | |||||
| currentPos = oldStrPos + skip | |||||
| End If | |||||
| Loop | |||||
| End If | |||||
| End Function | |||||
| Function GetFileName(strSaveToPath, FileName) | |||||
| 'This function is used when saving a file to check there is not already a file with the same name so that you don't overwrite it. | |||||
| 'It adds numbers to the filename e.g. file.gif becomes file1.gif becomes file2.gif and so on. | |||||
| 'It keeps going until it returns a filename that does not exist. | |||||
| 'You could just create a filename from the ID field but that means writing the record - and it still might exist! | |||||
| 'N.B. Requires strSaveToPath variable to be available - and containing the path to save to | |||||
| Dim Counter | |||||
| Dim Flag | |||||
| Dim strTempFileName | |||||
| Dim FileExt | |||||
| Dim NewFullPath | |||||
| dim objFSO, p | |||||
| Set objFSO = CreateObject("Scripting.FileSystemObject") | |||||
| Counter = 0 | |||||
| p = instrrev(FileName, ".") | |||||
| FileExt = mid(FileName, p+1) | |||||
| strTempFileName = left(FileName, p-1) | |||||
| NewFullPath = strSaveToPath & "\" & FileName | |||||
| Flag = False | |||||
| Do Until Flag = True | |||||
| If objFSO.FileExists(NewFullPath) = False Then | |||||
| Flag = True | |||||
| GetFileName = Mid(NewFullPath, InstrRev(NewFullPath, "\") + 1) | |||||
| Else | |||||
| Counter = Counter + 1 | |||||
| NewFullPath = strSaveToPath & "\" & strTempFileName & Counter & "." & FileExt | |||||
| End If | |||||
| Loop | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,250 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' Validation Classes | |||||
| '======================================================================================================================= | |||||
| '----------------------------------------------------------------------------------------------------------------------- | |||||
| ' Exists Validation | |||||
| '----------------------------------------------------------------------------------------------------------------------- | |||||
| Class ExistsValidation_Class | |||||
| Private m_instance | |||||
| Private m_field_name | |||||
| Private m_message | |||||
| Private m_ok | |||||
| Public Function Initialize(instance, field_name, message) | |||||
| set m_instance = instance | |||||
| m_field_name = field_name | |||||
| m_message = message | |||||
| m_ok = true | |||||
| set Initialize = Me | |||||
| End Function | |||||
| Public Sub Check | |||||
| If Len(eval("m_instance." & m_field_name)) = 0 then | |||||
| m_ok = false | |||||
| End If | |||||
| End Sub | |||||
| Public Property Get OK | |||||
| OK = m_ok | |||||
| End Property | |||||
| Public Property Get Message | |||||
| Message = m_message | |||||
| End Property | |||||
| End Class | |||||
| Sub ValidateExists(instance, field_name, message) | |||||
| if not IsObject(instance.Validator) then set instance.Validator = new Validator_Class | |||||
| instance.Validator.AddValidation new ExistsValidation_Class.Initialize(instance, field_name, message) | |||||
| End Sub | |||||
| '----------------------------------------------------------------------------------------------------------------------- | |||||
| ' Minimum Length Validation | |||||
| '----------------------------------------------------------------------------------------------------------------------- | |||||
| Class MinLengthValidation_Class | |||||
| Private m_instance | |||||
| Private m_field_name | |||||
| Private m_size | |||||
| Private m_message | |||||
| Private m_ok | |||||
| Public Function Initialize(instance, field_name, size, message) | |||||
| set m_instance = instance | |||||
| m_field_name = field_name | |||||
| m_size = size | |||||
| m_message = message | |||||
| m_ok = true | |||||
| set Initialize = Me | |||||
| End Function | |||||
| Public Sub Check | |||||
| If Len(eval("m_instance." & m_field_name)) < m_size then m_ok = false | |||||
| End Sub | |||||
| Public Property Get OK | |||||
| OK = m_ok | |||||
| End Property | |||||
| Public Property Get Message | |||||
| Message = m_message | |||||
| End Property | |||||
| End Class | |||||
| Sub ValidateMinLength(instance, field_name, size, message) | |||||
| if not IsObject(instance.Validator) then set instance.Validator = new Validator_Class | |||||
| instance.Validator.AddValidation new MinLengthValidation_Class.Initialize(instance, field_name, size, message) | |||||
| End Sub | |||||
| '----------------------------------------------------------------------------------------------------------------------- | |||||
| ' Max Length Validation | |||||
| '----------------------------------------------------------------------------------------------------------------------- | |||||
| Class MaxLengthValidation_Class | |||||
| Private m_instance | |||||
| Private m_field_name | |||||
| Private m_size | |||||
| Private m_message | |||||
| Private m_ok | |||||
| Public Function Initialize(instance, field_name, size, message) | |||||
| set m_instance = instance | |||||
| m_field_name = field_name | |||||
| m_size = size | |||||
| m_message = message | |||||
| m_ok = true | |||||
| set Initialize = Me | |||||
| End Function | |||||
| Public Sub Check | |||||
| If Len(eval("m_instance." & m_field_name)) > m_size then m_ok = false | |||||
| End Sub | |||||
| Public Property Get OK | |||||
| OK = m_ok | |||||
| End Property | |||||
| Public Property Get Message | |||||
| Message = m_message | |||||
| End Property | |||||
| End Class | |||||
| Sub ValidateMaxLength(instance, field_name, size, message) | |||||
| if not IsObject(instance.Validator) then set instance.Validator = new Validator_Class | |||||
| instance.Validator.AddValidation new MaxLengthValidation_Class.Initialize(instance, field_name, size, message) | |||||
| End Sub | |||||
| '----------------------------------------------------------------------------------------------------------------------- | |||||
| ' Numeric Validation | |||||
| '----------------------------------------------------------------------------------------------------------------------- | |||||
| Class NumericValidation_Class | |||||
| Private m_instance | |||||
| Private m_field_name | |||||
| Private m_message | |||||
| Private m_ok | |||||
| Public Function Initialize(instance, field_name, message) | |||||
| set m_instance = instance | |||||
| m_field_name = field_name | |||||
| m_message = message | |||||
| m_ok = true | |||||
| set Initialize = Me | |||||
| End Function | |||||
| Public Sub Check | |||||
| If Not IsNumeric(eval("m_instance." & m_field_name)) then m_ok = false | |||||
| End Sub | |||||
| Public Property Get OK | |||||
| OK = m_ok | |||||
| End Property | |||||
| Public Property Get Message | |||||
| Message = m_message | |||||
| End Property | |||||
| End Class | |||||
| Sub ValidateNumeric(instance, field_name, message) | |||||
| if not IsObject(instance.Validator) then set instance.Validator = new Validator_Class | |||||
| instance.Validator.AddValidation new NumericValidation_Class.Initialize(instance, field_name, message) | |||||
| End Sub | |||||
| '----------------------------------------------------------------------------------------------------------------------- | |||||
| ' Regular Expression Pattern Validation | |||||
| '----------------------------------------------------------------------------------------------------------------------- | |||||
| Class PatternValidation_Class | |||||
| Private m_instance | |||||
| Private m_field_name | |||||
| Private m_pattern | |||||
| Private m_message | |||||
| Private m_ok | |||||
| Public Function Initialize(instance, field_name, pattern, message) | |||||
| set m_instance = instance | |||||
| m_field_name = field_name | |||||
| m_pattern = pattern | |||||
| m_message = message | |||||
| m_ok = true | |||||
| set Initialize = Me | |||||
| End Function | |||||
| Public Sub Check | |||||
| dim re : set re = new RegExp | |||||
| With re | |||||
| .Pattern = m_pattern | |||||
| .Global = true | |||||
| .IgnoreCase = true | |||||
| End With | |||||
| dim matches : set matches = re.Execute(eval("m_instance." & m_field_name)) | |||||
| if matches.Count = 0 then | |||||
| m_ok = false | |||||
| end if | |||||
| End Sub | |||||
| Public Property Get OK | |||||
| OK = m_ok | |||||
| End Property | |||||
| Public Property Get Message | |||||
| Message = m_message | |||||
| End Property | |||||
| End Class | |||||
| Sub ValidatePattern(instance, field_name, pattern, message) | |||||
| if not IsObject(instance.Validator) then set instance.Validator = new Validator_Class | |||||
| instance.Validator.AddValidation new PatternValidation_Class.Initialize(instance, field_name, pattern, message) | |||||
| End Sub | |||||
| '----------------------------------------------------------------------------------------------------------------------- | |||||
| ' Validator Class | |||||
| ' This class is not intended to be used directly. Models should use the Validate* subs instead. | |||||
| '----------------------------------------------------------------------------------------------------------------------- | |||||
| Class Validator_Class | |||||
| Private m_validations | |||||
| Private m_errors | |||||
| Private Sub Class_Initialize | |||||
| m_validations = Array() | |||||
| redim m_validations(-1) | |||||
| m_errors = Array() | |||||
| redim m_errors(-1) | |||||
| End Sub | |||||
| Public Property Get Errors | |||||
| Errors = m_errors | |||||
| End Property | |||||
| Public Sub AddValidation(validation) | |||||
| dim n : n = ubound(m_validations) + 1 | |||||
| redim preserve m_validations(n) | |||||
| set m_validations(n) = validation | |||||
| End Sub | |||||
| Public Sub Validate | |||||
| dim n : n = ubound(m_validations) | |||||
| dim i, V | |||||
| for i = 0 to n | |||||
| set V = m_validations(i) | |||||
| V.Check | |||||
| if not V.OK then | |||||
| AddError V.Message | |||||
| end if | |||||
| next | |||||
| End Sub | |||||
| Public Property Get HasErrors | |||||
| HasErrors = (ubound(m_errors) > -1) | |||||
| End Property | |||||
| 'Public to allow other errors to be added by the controller for circumstances not accounted for by the validators | |||||
| Public Sub AddError(msg) | |||||
| redim preserve m_errors(ubound(m_errors) + 1) | |||||
| m_errors(ubound(m_errors)) = msg | |||||
| End Sub | |||||
| End Class | |||||
| %> | |||||
| @@ -0,0 +1,52 @@ | |||||
| <% | |||||
| '========================== | |||||
| ' AD_Auth_Class.asp | |||||
| '========================== | |||||
| Class AD_Auth_Class | |||||
| Public DomainName ' e.g. yourdomain.local | |||||
| Public ContainerDN ' e.g. DC=yourdomain,DC=local | |||||
| Public Username | |||||
| Public Password | |||||
| Public ErrorMessage | |||||
| Public IsAuthenticated | |||||
| Public UserObject | |||||
| Private Sub Class_Initialize() | |||||
| IsAuthenticated = False | |||||
| ErrorMessage = "" | |||||
| Set UserObject = Nothing | |||||
| End Sub | |||||
| Public Function Authenticate() | |||||
| On Error Resume Next | |||||
| Dim ldapPath, userCredential | |||||
| ldapPath = "LDAP://" & ContainerDN ' Must be DC=yourdomain,DC=local | |||||
| userCredential = DomainName & "\" & Username | |||||
| ' Try to bind to Active Directory | |||||
| Dim rootDSE : Set rootDSE = GetObject("LDAP:") | |||||
| Set UserObject = rootDSE.OpenDSObject(ldapPath, userCredential, Password, 1) | |||||
| If Err.Number <> 0 Then | |||||
| ErrorMessage = "Authentication failed: " & Err.Description | |||||
| IsAuthenticated = False | |||||
| Set UserObject = Nothing | |||||
| Else | |||||
| IsAuthenticated = True | |||||
| ErrorMessage = "" | |||||
| End If | |||||
| Authenticate = IsAuthenticated | |||||
| On Error GoTo 0 | |||||
| End Function | |||||
| End Class | |||||
| dim AD_Auth_Class__Singleton | |||||
| Function AdAuth() | |||||
| if IsEmpty(AD_Auth_Class__Singleton) then | |||||
| set AD_Auth_Class__Singleton = new AD_Auth_Class | |||||
| end if | |||||
| set AdAuth = AD_Auth_Class__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,45 @@ | |||||
| <% | |||||
| Function HashPassword(password) | |||||
| Dim shell, command, execObj, outputLine, result | |||||
| ' Create Shell Object | |||||
| Set shell = CreateObject("WScript.Shell") | |||||
| ' Construct PowerShell Command | |||||
| command = "cmd /c powershell -ExecutionPolicy Bypass -NoLogo -NoProfile -File """ & Server.MapPath(".") & "..\Core\hash_sha256.ps1"" -password " & password | |||||
| ' Execute Command | |||||
| Set execObj = shell.Exec(command) | |||||
| ' Read Output | |||||
| Do While Not execObj.StdOut.AtEndOfStream | |||||
| outputLine = Trim(execObj.StdOut.ReadAll()) | |||||
| If outputLine <> "" Then | |||||
| result = outputLine ' Capture the hash | |||||
| End If | |||||
| Loop | |||||
| ' Cleanup | |||||
| Set shell = Nothing | |||||
| Set execObj = Nothing | |||||
| ' Return the hash or error message | |||||
| If result = "" Or Left(result, 5) = "ERROR" Then | |||||
| HashPassword = result ' "ERROR: Hash not generated" | |||||
| Else | |||||
| HashPassword = result | |||||
| End If | |||||
| End Function | |||||
| Function CheckPassword(username, password) | |||||
| Dim user,UsersRepository | |||||
| Set UsersRepository = CreateRepository(conn, "Users", "UserId") | |||||
| ' Find User | |||||
| Set User = UsersRepository.Find(Array("UserName", user), Empty) | |||||
| If user Is Nothing Then Exit Function ' Implicitly returns False | |||||
| ' Compare Hashed Password | |||||
| CheckPassword = (HashPassword(password) = user.PasswordHash) | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,115 @@ | |||||
| <% | |||||
| 'protocol = IIf(LCase(Request.ServerVariables("HTTPS")) = "1", "https", "http") | |||||
| protocol = "https" | |||||
| Dim timeZones | |||||
| timeZones = Array( _ | |||||
| Array("America/New_York", "Eastern (New York)"), _ | |||||
| Array("America/Chicago", "Central (Chicago)"), _ | |||||
| Array("America/Denver", "Mountain (Denver)"), _ | |||||
| Array("America/Los_Angeles", "Pacific (Los Angeles)"), _ | |||||
| Array("Europe/London", "London (UK)") _ | |||||
| ) | |||||
| Function RequestBinary() | |||||
| On Error Resume Next | |||||
| Dim stream, rawData | |||||
| If Request.TotalBytes = 0 Then | |||||
| RequestBinary = "" | |||||
| Exit Function | |||||
| End If | |||||
| Set stream = Server.CreateObject("ADODB.Stream") | |||||
| stream.Type = 1 ' adTypeBinary | |||||
| stream.Open | |||||
| stream.Write Request.BinaryRead(Request.TotalBytes) | |||||
| stream.Position = 0 | |||||
| stream.Type = 2 ' adTypeText | |||||
| stream.Charset = "utf-8" | |||||
| rawData = stream.ReadText | |||||
| stream.Close | |||||
| Set stream = Nothing | |||||
| If Err.Number <> 0 Then | |||||
| rawData = "" | |||||
| Err.Clear | |||||
| End If | |||||
| On Error GoTo 0 | |||||
| RequestBinary = rawData | |||||
| End Function | |||||
| Function ArrayContains(arr, val) | |||||
| Dim i | |||||
| ArrayContains = False | |||||
| If IsArray(arr) Then | |||||
| For i = LBound(arr) To UBound(arr) | |||||
| If arr(i) = val Then | |||||
| ArrayContains = True | |||||
| Exit Function | |||||
| End If | |||||
| Next | |||||
| End If | |||||
| End Function | |||||
| Function RenderPOBOArrayAsJson(pobo) | |||||
| Dim i, j, obj, propList, propName, json, propVal, line,poboArray | |||||
| if IsLinkedList(pobo) Then | |||||
| poboArray = pobo.TO_Array() | |||||
| End If | |||||
| json = "[" | |||||
| If IsEmpty(poboArray) Then | |||||
| RenderPOBOArrayAsJson = "[]" | |||||
| Exit Function | |||||
| End If | |||||
| For i = 0 To UBound(poboArray) | |||||
| Set obj = poboArray(i) | |||||
| propList = obj.Properties | |||||
| line = "{" | |||||
| For j = 0 To UBound(propList) | |||||
| propName = propList(j) | |||||
| ' Dynamically get value using Execute | |||||
| Execute "propVal = obj." & propName | |||||
| Select Case VarType(propVal) | |||||
| Case vbString | |||||
| line = line & """" & propName & """:""" & JsonEscape(propVal) & """" | |||||
| Case vbBoolean | |||||
| line = line & """" & propName & """:" & LCase(CStr(propVal)) | |||||
| Case vbDate | |||||
| line = line & """" & propName & """:""" & Replace(CStr(propVal), """", "") & """" | |||||
| Case vbNull | |||||
| line = line & """" & propName & """:null" | |||||
| Case Else | |||||
| line = line & """" & propName & """:" & CStr(propVal) | |||||
| End Select | |||||
| If j < UBound(propList) Then | |||||
| line = line & "," | |||||
| End If | |||||
| Next | |||||
| line = line & "}" | |||||
| If i < UBound(poboArray) Then line = line & "," | |||||
| json = json & line | |||||
| Next | |||||
| json = json & "]" | |||||
| RenderPOBOArrayAsJson = json | |||||
| End Function | |||||
| Function JsonEscape(str) | |||||
| str = Replace(str, "\", "\\") | |||||
| str = Replace(str, """", "\""") | |||||
| str = Replace(str, vbCrLf, "\n") | |||||
| str = Replace(str, vbLf, "\n") | |||||
| str = Replace(str, vbCr, "\n") | |||||
| str = Replace(str, Chr(9), "\t") | |||||
| JsonEscape = str | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,284 @@ | |||||
| <% | |||||
| 'January 2021 - Version 1.1 by Gerrit van Kuipers | |||||
| Class aspJSON | |||||
| Public data | |||||
| Private p_JSONstring | |||||
| Private aj_in_string, aj_in_escape, aj_i_tmp, aj_char_tmp, aj_s_tmp, aj_line_tmp, aj_line, aj_lines, aj_currentlevel, aj_currentkey, aj_currentvalue, aj_newlabel, aj_XmlHttp, aj_RegExp, aj_colonfound | |||||
| Private Sub Class_Initialize() | |||||
| Set data = Collection() | |||||
| Set aj_RegExp = New regexp | |||||
| aj_RegExp.Pattern = "\s{0,}(\S{1}[\s,\S]*\S{1})\s{0,}" | |||||
| aj_RegExp.Global = False | |||||
| aj_RegExp.IgnoreCase = True | |||||
| aj_RegExp.Multiline = True | |||||
| End Sub | |||||
| Private Sub Class_Terminate() | |||||
| Set data = Nothing | |||||
| Set aj_RegExp = Nothing | |||||
| End Sub | |||||
| Public Sub loadJSON(inputsource) | |||||
| inputsource = aj_MultilineTrim(inputsource) | |||||
| If Len(inputsource) = 0 Then Err.Raise 1, "loadJSON Error", "No data to load." | |||||
| Select Case Left(inputsource, 1) | |||||
| Case "{", "[" | |||||
| Case Else | |||||
| Set aj_XmlHttp = Server.CreateObject("Msxml2.ServerXMLHTTP") | |||||
| aj_XmlHttp.open "POST", inputsource, False | |||||
| aj_XmlHttp.setRequestHeader "Content-Type", "text/json" | |||||
| aj_XmlHttp.setRequestHeader "CharSet", "UTF-8" | |||||
| aj_XmlHttp.Send | |||||
| inputsource = aj_XmlHttp.responseText | |||||
| Set aj_XmlHttp = Nothing | |||||
| End Select | |||||
| p_JSONstring = CleanUpJSONstring(inputsource) | |||||
| aj_lines = Split(p_JSONstring, Chr(13) & Chr(10)) | |||||
| Dim level(99) | |||||
| aj_currentlevel = 1 | |||||
| Set level(aj_currentlevel) = data | |||||
| For Each aj_line In aj_lines | |||||
| aj_currentkey = "" | |||||
| aj_currentvalue = "" | |||||
| If Instr(aj_line, ":") > 0 Then | |||||
| aj_in_string = False | |||||
| aj_in_escape = False | |||||
| aj_colonfound = False | |||||
| For aj_i_tmp = 1 To Len(aj_line) | |||||
| If aj_in_escape Then | |||||
| aj_in_escape = False | |||||
| Else | |||||
| Select Case Mid(aj_line, aj_i_tmp, 1) | |||||
| Case """" | |||||
| aj_in_string = Not aj_in_string | |||||
| Case ":" | |||||
| If Not aj_in_escape And Not aj_in_string Then | |||||
| aj_currentkey = Left(aj_line, aj_i_tmp - 1) | |||||
| aj_currentvalue = Mid(aj_line, aj_i_tmp + 1) | |||||
| aj_colonfound = True | |||||
| Exit For | |||||
| End If | |||||
| Case "\" | |||||
| aj_in_escape = True | |||||
| End Select | |||||
| End If | |||||
| Next | |||||
| if aj_colonfound then | |||||
| aj_currentkey = aj_Strip(aj_JSONDecode(aj_currentkey), """") | |||||
| If Not level(aj_currentlevel).exists(aj_currentkey) Then level(aj_currentlevel).Add aj_currentkey, "" | |||||
| end if | |||||
| End If | |||||
| If right(aj_line,1) = "{" Or right(aj_line,1) = "[" Then | |||||
| If Len(aj_currentkey) = 0 Then aj_currentkey = level(aj_currentlevel).Count | |||||
| Set level(aj_currentlevel).Item(aj_currentkey) = Collection() | |||||
| Set level(aj_currentlevel + 1) = level(aj_currentlevel).Item(aj_currentkey) | |||||
| aj_currentlevel = aj_currentlevel + 1 | |||||
| aj_currentkey = "" | |||||
| ElseIf right(aj_line,1) = "}" Or right(aj_line,1) = "]" or right(aj_line,2) = "}," Or right(aj_line,2) = "]," Then | |||||
| aj_currentlevel = aj_currentlevel - 1 | |||||
| ElseIf Len(Trim(aj_line)) > 0 Then | |||||
| If Len(aj_currentvalue) = 0 Then aj_currentvalue = aj_line | |||||
| aj_currentvalue = getJSONValue(aj_currentvalue) | |||||
| If Len(aj_currentkey) = 0 Then aj_currentkey = level(aj_currentlevel).Count | |||||
| level(aj_currentlevel).Item(aj_currentkey) = aj_currentvalue | |||||
| End If | |||||
| Next | |||||
| End Sub | |||||
| Public Function Collection() | |||||
| Set Collection = Server.CreateObject("Scripting.Dictionary") | |||||
| End Function | |||||
| Public Function AddToCollection(dictobj) | |||||
| If TypeName(dictobj) <> "Dictionary" Then Err.Raise 1, "AddToCollection Error", "Not a collection." | |||||
| aj_newlabel = dictobj.Count | |||||
| dictobj.Add aj_newlabel, Collection() | |||||
| Set AddToCollection = dictobj.item(aj_newlabel) | |||||
| end function | |||||
| Private Function CleanUpJSONstring(aj_originalstring) | |||||
| aj_originalstring = Replace(aj_originalstring, Chr(13) & Chr(10), "") | |||||
| aj_originalstring = Mid(aj_originalstring, 2, Len(aj_originalstring) - 2) | |||||
| aj_in_string = False : aj_in_escape = False : aj_s_tmp = "" | |||||
| For aj_i_tmp = 1 To Len(aj_originalstring) | |||||
| aj_char_tmp = Mid(aj_originalstring, aj_i_tmp, 1) | |||||
| If aj_in_escape Then | |||||
| aj_in_escape = False | |||||
| aj_s_tmp = aj_s_tmp & aj_char_tmp | |||||
| Else | |||||
| Select Case aj_char_tmp | |||||
| Case "\" : aj_s_tmp = aj_s_tmp & aj_char_tmp : aj_in_escape = True | |||||
| Case """" : aj_s_tmp = aj_s_tmp & aj_char_tmp : aj_in_string = Not aj_in_string | |||||
| Case "{", "[" | |||||
| aj_s_tmp = aj_s_tmp & aj_char_tmp & aj_InlineIf(aj_in_string, "", Chr(13) & Chr(10)) | |||||
| Case "}", "]" | |||||
| aj_s_tmp = aj_s_tmp & aj_InlineIf(aj_in_string, "", Chr(13) & Chr(10)) & aj_char_tmp | |||||
| Case "," : aj_s_tmp = aj_s_tmp & aj_char_tmp & aj_InlineIf(aj_in_string, "", Chr(13) & Chr(10)) | |||||
| Case Else : aj_s_tmp = aj_s_tmp & aj_char_tmp | |||||
| End Select | |||||
| End If | |||||
| Next | |||||
| CleanUpJSONstring = "" | |||||
| aj_s_tmp = Split(aj_s_tmp, Chr(13) & Chr(10)) | |||||
| For Each aj_line_tmp In aj_s_tmp | |||||
| aj_line_tmp = Replace(Replace(aj_line_tmp, Chr(10), ""), Chr(13), "") | |||||
| CleanUpJSONstring = CleanUpJSONstring & aj_Trim(aj_line_tmp) & Chr(13) & Chr(10) | |||||
| Next | |||||
| End Function | |||||
| Private Function getJSONValue(ByVal val) | |||||
| val = Trim(val) | |||||
| If Left(val,1) = ":" Then val = Mid(val, 2) | |||||
| If Right(val,1) = "," Then val = Left(val, Len(val) - 1) | |||||
| val = Trim(val) | |||||
| Select Case val | |||||
| Case "true" : getJSONValue = True | |||||
| Case "false" : getJSONValue = False | |||||
| Case "null" : getJSONValue = Null | |||||
| Case Else | |||||
| If (Instr(val, """") = 0) Then | |||||
| If IsNumeric(val) Then | |||||
| getJSONValue = aj_ReadNumericValue(val) | |||||
| Else | |||||
| getJSONValue = val | |||||
| End If | |||||
| Else | |||||
| If Left(val,1) = """" Then val = Mid(val, 2) | |||||
| If Right(val,1) = """" Then val = Left(val, Len(val) - 1) | |||||
| getJSONValue = aj_JSONDecode(Trim(val)) | |||||
| End If | |||||
| End Select | |||||
| End Function | |||||
| Private JSONoutput_level | |||||
| Public Function JSONoutput() | |||||
| Dim wrap_dicttype, aj_label | |||||
| JSONoutput_level = 1 | |||||
| wrap_dicttype = "[]" | |||||
| For Each aj_label In data | |||||
| If Not aj_IsInt(aj_label) Then wrap_dicttype = "{}" | |||||
| Next | |||||
| JSONoutput = Left(wrap_dicttype, 1) & Chr(13) & Chr(10) & GetDict(data) & Right(wrap_dicttype, 1) | |||||
| End Function | |||||
| Private Function GetDict(objDict) | |||||
| Dim aj_item, aj_keyvals, aj_label, aj_dicttype | |||||
| For Each aj_item In objDict | |||||
| Select Case TypeName(objDict.Item(aj_item)) | |||||
| Case "Dictionary" | |||||
| GetDict = GetDict & Space(JSONoutput_level * 4) | |||||
| aj_dicttype = "[]" | |||||
| For Each aj_label In objDict.Item(aj_item).Keys | |||||
| If Not aj_IsInt(aj_label) Then aj_dicttype = "{}" | |||||
| Next | |||||
| If aj_IsInt(aj_item) Then | |||||
| GetDict = GetDict & (Left(aj_dicttype,1) & Chr(13) & Chr(10)) | |||||
| Else | |||||
| GetDict = GetDict & ("""" & aj_JSONEncode(aj_item) & """" & ": " & Left(aj_dicttype,1) & Chr(13) & Chr(10)) | |||||
| End If | |||||
| JSONoutput_level = JSONoutput_level + 1 | |||||
| aj_keyvals = objDict.Keys | |||||
| GetDict = GetDict & (GetSubDict(objDict.Item(aj_item)) & Space(JSONoutput_level * 4) & Right(aj_dicttype,1) & aj_InlineIf(aj_item = aj_keyvals(objDict.Count - 1),"" , ",") & Chr(13) & Chr(10)) | |||||
| Case Else | |||||
| aj_keyvals = objDict.Keys | |||||
| GetDict = GetDict & (Space(JSONoutput_level * 4) & aj_InlineIf(aj_IsInt(aj_item), "", """" & aj_JSONEncode(aj_item) & """: ") & WriteValue(objDict.Item(aj_item)) & aj_InlineIf(aj_item = aj_keyvals(objDict.Count - 1),"" , ",") & Chr(13) & Chr(10)) | |||||
| End Select | |||||
| Next | |||||
| End Function | |||||
| Private Function aj_IsInt(val) | |||||
| aj_IsInt = (TypeName(val) = "Integer" Or TypeName(val) = "Long") | |||||
| End Function | |||||
| Private Function GetSubDict(objSubDict) | |||||
| GetSubDict = GetDict(objSubDict) | |||||
| JSONoutput_level= JSONoutput_level -1 | |||||
| End Function | |||||
| Private Function WriteValue(ByVal val) | |||||
| Select Case TypeName(val) | |||||
| Case "Double", "Integer", "Long": WriteValue = replace(val, ",", ".") | |||||
| Case "Null" : WriteValue = "null" | |||||
| Case "Boolean" : WriteValue = aj_InlineIf(val, "true", "false") | |||||
| Case Else : WriteValue = """" & aj_JSONEncode(val) & """" | |||||
| End Select | |||||
| End Function | |||||
| Private Function aj_JSONEncode(ByVal val) | |||||
| val = Replace(val, "\", "\\") | |||||
| val = Replace(val, """", "\""") | |||||
| 'val = Replace(val, "/", "\/") | |||||
| val = Replace(val, Chr(8), "\b") | |||||
| val = Replace(val, Chr(12), "\f") | |||||
| val = Replace(val, Chr(10), "\n") | |||||
| val = Replace(val, Chr(13), "\r") | |||||
| val = Replace(val, Chr(9), "\t") | |||||
| aj_JSONEncode = Trim(val) | |||||
| End Function | |||||
| Private Function aj_JSONDecode(ByVal val) | |||||
| val = Replace(val, "\""", """") | |||||
| val = Replace(val, "\\", "\") | |||||
| val = Replace(val, "\/", "/") | |||||
| val = Replace(val, "\b", Chr(8)) | |||||
| val = Replace(val, "\f", Chr(12)) | |||||
| val = Replace(val, "\n", Chr(10)) | |||||
| val = Replace(val, "\r", Chr(13)) | |||||
| val = Replace(val, "\t", Chr(9)) | |||||
| aj_JSONDecode = Trim(val) | |||||
| End Function | |||||
| Private Function aj_InlineIf(condition, returntrue, returnfalse) | |||||
| If condition Then aj_InlineIf = returntrue Else aj_InlineIf = returnfalse | |||||
| End Function | |||||
| Private Function aj_Strip(ByVal val, stripper) | |||||
| If Left(val, 1) = stripper Then val = Mid(val, 2) | |||||
| If Right(val, 1) = stripper Then val = Left(val, Len(val) - 1) | |||||
| aj_Strip = val | |||||
| End Function | |||||
| Private Function aj_MultilineTrim(TextData) | |||||
| aj_MultilineTrim = aj_RegExp.Replace(TextData, "$1") | |||||
| End Function | |||||
| Private Function aj_Trim(val) | |||||
| aj_Trim = Trim(val) | |||||
| Do While Left(aj_Trim, 1) = Chr(9) : aj_Trim = Mid(aj_Trim, 2) : Loop | |||||
| Do While Right(aj_Trim, 1) = Chr(9) : aj_Trim = Left(aj_Trim, Len(aj_Trim) - 1) : Loop | |||||
| aj_Trim = Trim(aj_Trim) | |||||
| End Function | |||||
| Private Function aj_ReadNumericValue(ByVal val) | |||||
| If Instr(val, ".") > 0 Then | |||||
| numdecimals = Len(val) - Instr(val, ".") | |||||
| val = Clng(Replace(val, ".", "")) | |||||
| val = val / (10 ^ numdecimals) | |||||
| aj_ReadNumericValue = val | |||||
| Else | |||||
| aj_ReadNumericValue = Clng(val) | |||||
| End If | |||||
| End Function | |||||
| End Class | |||||
| dim json_Class__Singleton | |||||
| Function json() | |||||
| if IsEmpty(json_Class__Singleton) then | |||||
| set json_Class__Singleton = new aspJSON | |||||
| end if | |||||
| set json = json_Class__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,178 @@ | |||||
| <!--#include file="../app/Controllers/autoload_controllers.asp" --> | |||||
| <% | |||||
| ' Set cache expiration from configuration | |||||
| Dim cacheYear : cacheYear = GetAppSetting("CacheExpirationYear") | |||||
| If cacheYear = "nothing" Then cacheYear = "2030" | |||||
| Response.ExpiresAbsolute = "01/01/" & cacheYear | |||||
| Response.AddHeader "pragma", "no-cache" | |||||
| Response.AddHeader "cache-control", "private, no-cache, must-revalidate" | |||||
| ' Route parameters for the action being dispatched (referenced by the executed call string, never embedded in it) | |||||
| Dim MVC_RouteParams | |||||
| '======================================================================================================================= | |||||
| ' MVC Dispatcher | |||||
| '======================================================================================================================= | |||||
| Class MVC_Dispatcher_Class | |||||
| dim CurrentController | |||||
| Public Property Get ControllerName | |||||
| ControllerName = CurrentController | |||||
| end Property | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Convenience method to resolve route and dispatch in one call | |||||
| ' method: HTTP method (GET, POST, etc.) | |||||
| ' path: Request path (already cleaned of query params) | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub DispatchRequest(method, path) | |||||
| Dim routeArray | |||||
| routeArray = router.Resolve(method, path) | |||||
| Dispatch routeArray | |||||
| End Sub | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| ' Main dispatch method - executes a resolved route | |||||
| ' RouteArray: Array(controller, action, params) from router.Resolve() | |||||
| '--------------------------------------------------------------------------------------------------------------------- | |||||
| Public Sub Dispatch(RouteArray) | |||||
| On Error Resume Next | |||||
| Dim controllerName, actionName, hasParams, paramsArray | |||||
| controllerName = RouteArray(0) | |||||
| actionName = RouteArray(1) | |||||
| ' Security: Validate controller and action names | |||||
| If Not ControllerRegistry.IsValidControllerFormat(controllerName) Then | |||||
| Response.Write "<div style='padding:15px; margin:10px; border:2px solid #dc3545; background:#f8d7da; color:#721c24; border-radius:4px;'>" | |||||
| Response.Write "<strong>Security Error:</strong> Invalid controller name format." | |||||
| Response.Write "</div>" | |||||
| Exit Sub | |||||
| End If | |||||
| If Not ControllerRegistry.IsValidActionFormat(actionName) Then | |||||
| Response.Write "<div style='padding:15px; margin:10px; border:2px solid #dc3545; background:#f8d7da; color:#721c24; border-radius:4px;'>" | |||||
| Response.Write "<strong>Security Error:</strong> Invalid action name format." | |||||
| Response.Write "</div>" | |||||
| Exit Sub | |||||
| End If | |||||
| ' Security: Check controller whitelist | |||||
| If Not ControllerRegistry.IsValidController(controllerName) Then | |||||
| Response.Write "<div style='padding:15px; margin:10px; border:2px solid #dc3545; background:#f8d7da; color:#721c24; border-radius:4px;'>" | |||||
| Response.Write "<strong>Security Error:</strong> Controller '" & Server.HTMLEncode(controllerName) & "' is not registered." | |||||
| Response.Write "</div>" | |||||
| Exit Sub | |||||
| End If | |||||
| ' Initialize current controller | |||||
| Dim controllerAssignment : controllerAssignment = "Set CurrentController = " & controllerName & "()" | |||||
| Execute controllerAssignment | |||||
| ' Check if layout should be used | |||||
| hasParams = (UBound(RouteArray) >= 2) | |||||
| If eval(controllerName & ".useLayout") Then | |||||
| %> <!-- #include file="../app/views/Shared/Header.asp" --> <% | |||||
| End If | |||||
| ' Prepare parameters. They are passed to the action by reference to MVC_RouteParams (see | |||||
| ' ExecuteControllerAction) and are never concatenated into code, so a URL segment cannot inject script. | |||||
| If hasParams Then | |||||
| paramsArray = RouteArray(2) | |||||
| Else | |||||
| paramsArray = Empty | |||||
| End If | |||||
| ' Execute controller action | |||||
| ExecuteControllerAction controllerName, actionName, paramsArray | |||||
| ' Include footer if layout is used | |||||
| If eval(controllerName & ".useLayout") Then | |||||
| %> <!-- #include file="../app/views/Shared/Footer.asp" --> <% | |||||
| End If | |||||
| On Error GoTo 0 | |||||
| End Sub | |||||
| ' Helper method to execute controller actions (eliminates code duplication) | |||||
| Private Sub ExecuteControllerAction(controllerName, actionName, paramsArray) | |||||
| On Error Resume Next | |||||
| Dim callString, argList, i | |||||
| ' Build the call string based on whether we have parameters. The string only ever contains the validated | |||||
| ' controller/action names and fixed MVC_RouteParams(n) references; the parameter values themselves are | |||||
| ' never part of the executed text. | |||||
| If Not IsEmpty(paramsArray) And IsArray(paramsArray) And UBound(paramsArray) >= 0 Then | |||||
| MVC_RouteParams = paramsArray | |||||
| argList = "" | |||||
| For i = 0 To UBound(paramsArray) | |||||
| If i > 0 Then argList = argList & "," | |||||
| argList = argList & "MVC_RouteParams(" & i & ")" | |||||
| Next | |||||
| callString = "Call " & controllerName & "." & actionName & "(" & argList & ")" | |||||
| Else | |||||
| callString = "Call " & controllerName & "." & actionName & "()" | |||||
| End If | |||||
| ' Execute the action | |||||
| Execute callString | |||||
| ' Handle errors | |||||
| If Err.Number <> 0 Then | |||||
| HandleDispatchError actionName, Err.Description, Err.Number | |||||
| Err.Clear | |||||
| End If | |||||
| On Error GoTo 0 | |||||
| End Sub | |||||
| ' Centralized error handling for dispatch errors | |||||
| Private Sub HandleDispatchError(actionName, errorDesc, errorNum) | |||||
| Dim isDevelopment | |||||
| isDevelopment = (LCase(GetAppSetting("Environment")) = "development") | |||||
| If isDevelopment Then | |||||
| Response.Write "<div style='padding:15px; margin:10px; border:2px solid #dc3545; background:#f8d7da; color:#721c24; border-radius:4px;'>" | |||||
| Response.Write "<strong>Controller Action Error</strong><br>" | |||||
| Response.Write "Action: <code>" & Server.HTMLEncode(actionName) & "</code><br>" | |||||
| Response.Write "Error: " & Server.HTMLEncode(errorDesc) & "<br>" | |||||
| Response.Write "Error Number: " & errorNum | |||||
| Response.Write "</div>" | |||||
| Else | |||||
| Response.Write "<div style='padding:15px; margin:10px; border:2px solid #dc3545; background:#f8d7da; color:#721c24; border-radius:4px;'>" | |||||
| Response.Write "<strong>An error occurred</strong><br>" | |||||
| Response.Write "Please contact the system administrator if the problem persists." | |||||
| Response.Write "</div>" | |||||
| End If | |||||
| End Sub | |||||
| Public Sub RequirePost | |||||
| If Request.Form.Count = 0 Then MVC.RedirectToExt "NotValid","",empty:End If | |||||
| End Sub | |||||
| ' Shortcut for RedirectToActionExt that does not require passing a parameters argument. | |||||
| Public Sub RedirectToAction(ByVal action_name) | |||||
| RedirectToActionExt action_name, empty | |||||
| End Sub | |||||
| Public Sub RedirectTo(controller_name, action_name) | |||||
| RedirectToExt controller_name, action_name, empty | |||||
| End Sub | |||||
| ' Redirects the browser to the specified action on the specified controller with the specified querystring parameters. | |||||
| ' params is a KVArray of querystring parameters. | |||||
| Public Sub RedirectToExt(controller_name, action_name, params) | |||||
| Response.Redirect Routes.UrlTo(controller_name, action_name, params) | |||||
| End Sub | |||||
| Public Sub RedirectToActionExt(ByVal action_name, ByVal params) | |||||
| RedirectToExt ControllerName, action_name, params | |||||
| End Sub | |||||
| End Class | |||||
| dim MVC_Dispatcher_Class__Singleton | |||||
| Function MVC() | |||||
| if IsEmpty(MVC_Dispatcher_Class__Singleton) then | |||||
| set MVC_Dispatcher_Class__Singleton = new MVC_Dispatcher_Class | |||||
| end if | |||||
| set MVC = MVC_Dispatcher_Class__Singleton | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,147 @@ | |||||
| <?xml version="1.0"?> | |||||
| <!-- RouterComponent.wsc --> | |||||
| <component> | |||||
| <!-- COM registration --> | |||||
| <registration | |||||
| description = "Classic ASP Router Component" | |||||
| progid = "App.Router" | |||||
| version = "1.0" | |||||
| classid = "{A1FC6EA8-519E-4E34-AC08-77788E3E5E44}" /> | |||||
| <!-- Public interface --> | |||||
| <public> | |||||
| <method name="AddRoute"/> | |||||
| <method name="Resolve"/> | |||||
| </public> | |||||
| <!-- Give the component ASP intrinsic objects (Request, Response, Server …) --> | |||||
| <implements type="ASP"/> | |||||
| <!-- Implementation --> | |||||
| <script language="VBScript"> | |||||
| <![CDATA[ | |||||
| Option Explicit | |||||
| '------------------------------------------------------------ | |||||
| ' Private state | |||||
| '------------------------------------------------------------ | |||||
| Dim routes : Set routes = CreateObject("Scripting.Dictionary") | |||||
| '------------------------------------------------------------ | |||||
| ' METHOD AddRoute(method, path, controller, action) | |||||
| '------------------------------------------------------------ | |||||
| Public Sub AddRoute(method, path, controller, action) | |||||
| ' Input validation | |||||
| If IsEmpty(method) Or Len(Trim(method)) = 0 Then | |||||
| Err.Raise 5, "Router.AddRoute", "HTTP method parameter is required and cannot be empty" | |||||
| End If | |||||
| If IsEmpty(path) Then | |||||
| Err.Raise 5, "Router.AddRoute", "Path parameter is required" | |||||
| End If | |||||
| If IsEmpty(controller) Or Len(Trim(controller)) = 0 Then | |||||
| Err.Raise 5, "Router.AddRoute", "Controller parameter is required and cannot be empty" | |||||
| End If | |||||
| If IsEmpty(action) Or Len(Trim(action)) = 0 Then | |||||
| Err.Raise 5, "Router.AddRoute", "Action parameter is required and cannot be empty" | |||||
| End If | |||||
| ' Validate HTTP method (allow common methods) | |||||
| Dim validMethods, methodUpper, i, isValidMethod | |||||
| validMethods = Array("GET", "POST", "PUT", "DELETE", "PATCH", "HEAD", "OPTIONS") | |||||
| methodUpper = UCase(Trim(method)) | |||||
| isValidMethod = False | |||||
| For i = 0 To UBound(validMethods) | |||||
| If validMethods(i) = methodUpper Then | |||||
| isValidMethod = True | |||||
| Exit For | |||||
| End If | |||||
| Next | |||||
| If Not isValidMethod Then | |||||
| Err.Raise 5, "Router.AddRoute", "Invalid HTTP method: " & method & ". Allowed: GET, POST, PUT, DELETE, PATCH, HEAD, OPTIONS" | |||||
| End If | |||||
| Dim routeKey | |||||
| routeKey = methodUpper & ":" & LCase(Trim(path)) | |||||
| If Not routes.Exists(routeKey) Then | |||||
| routes.Add routeKey, Array(Trim(controller), Trim(action)) | |||||
| End If | |||||
| End Sub | |||||
| '------------------------------------------------------------ | |||||
| ' METHOD Resolve(method, path) -> Array(controller, action, params()) | |||||
| '------------------------------------------------------------ | |||||
| Public Function Resolve(method, path) | |||||
| Dim routeKey, routeValue, values | |||||
| routeKey = UCase(method) & ":" & LCase(path) | |||||
| ' Always return a params array (empty by default) | |||||
| Dim emptyParams() : ReDim emptyParams(-1) | |||||
| ' Exact match first | |||||
| If routes.Exists(routeKey) Then | |||||
| routeValue = routes(routeKey) | |||||
| Resolve = Array(routeValue(0), routeValue(1), emptyParams) | |||||
| Exit Function | |||||
| End If | |||||
| ' Dynamic routes (e.g. /users/:id) | |||||
| Dim r, routeMethod, routePattern | |||||
| For Each r In routes.Keys | |||||
| routeMethod = Split(r, ":")(0) | |||||
| routePattern = Mid(r, Len(routeMethod) + 2) ' strip "METHOD:" | |||||
| If UCase(routeMethod) = UCase(method) Then | |||||
| If IsMatch(path, routePattern, values) Then | |||||
| routeValue = routes(r) | |||||
| Resolve = Array(routeValue(0), routeValue(1), values) | |||||
| Exit Function | |||||
| End If | |||||
| End If | |||||
| Next | |||||
| ' 404 fallback | |||||
| Resolve = Array("ErrorController", "NotFound", emptyParams) | |||||
| End Function | |||||
| '------------------------------------------------------------ | |||||
| ' INTERNAL IsMatch(requestPath, routePattern, values()) | |||||
| ' Returns True/False and fills values() with parameters | |||||
| '------------------------------------------------------------ | |||||
| Private Function IsMatch(requestPath, routePattern, values) | |||||
| Dim reqParts, routeParts, i, paramCount | |||||
| reqParts = Split(requestPath, "/") | |||||
| routeParts = Split(routePattern, "/") | |||||
| If UBound(reqParts) <> UBound(routeParts) Then | |||||
| IsMatch = False : Exit Function | |||||
| End If | |||||
| paramCount = 0 : ReDim values(-1) | |||||
| For i = 0 To UBound(reqParts) | |||||
| If Left(routeParts(i), 1) = ":" Then | |||||
| ReDim Preserve values(paramCount) | |||||
| values(paramCount) = reqParts(i) | |||||
| paramCount = paramCount + 1 | |||||
| ElseIf LCase(routeParts(i)) <> LCase(reqParts(i)) Then | |||||
| IsMatch = False : Exit Function | |||||
| End If | |||||
| Next | |||||
| If paramCount = 0 Then ReDim values(-1) | |||||
| IsMatch = True | |||||
| End Function | |||||
| '------------------------------------------------------------ | |||||
| ' Optional lifecycle hooks | |||||
| '------------------------------------------------------------ | |||||
| Private Sub Class_Terminate() | |||||
| Set routes = Nothing | |||||
| End Sub | |||||
| ]]> | |||||
| </script> | |||||
| </component> | |||||
| @@ -0,0 +1,14 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' MIGRATION: create_industries_table | |||||
| '======================================================================================================================= | |||||
| Sub Migration_Up(migration) | |||||
| migration.CreateTable "industries", "id AUTOINCREMENT PRIMARY KEY, name VARCHAR(100) NOT NULL" | |||||
| migration.ExecuteSQL "CREATE UNIQUE INDEX uq_industries_name ON industries (name)" | |||||
| End Sub | |||||
| Sub Migration_Down(migration) | |||||
| migration.DropTable "industries" | |||||
| End Sub | |||||
| %> | |||||
| @@ -0,0 +1,13 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' MIGRATION: create_import_batches_table | |||||
| '======================================================================================================================= | |||||
| Sub Migration_Up(migration) | |||||
| migration.CreateTable "import_batches", "id AUTOINCREMENT PRIMARY KEY, file_name VARCHAR(255), imported_at DATETIME, rows_read LONG, rows_added LONG, rows_skipped LONG" | |||||
| End Sub | |||||
| Sub Migration_Down(migration) | |||||
| migration.DropTable "import_batches" | |||||
| End Sub | |||||
| %> | |||||
| @@ -0,0 +1,26 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' MIGRATION: create_businesses_table | |||||
| '======================================================================================================================= | |||||
| Sub Migration_Up(migration) | |||||
| migration.CreateTable "businesses", "id AUTOINCREMENT PRIMARY KEY, " & _ | |||||
| "name VARCHAR(255) NOT NULL, contact_name VARCHAR(150), industry_id LONG, " & _ | |||||
| "phone VARCHAR(40), phone_digits VARCHAR(20), email VARCHAR(255), website VARCHAR(255), " & _ | |||||
| "address1 VARCHAR(255), city VARCHAR(100), state VARCHAR(50), zip VARCHAR(20), source VARCHAR(255), " & _ | |||||
| "status VARCHAR(20) NOT NULL, is_customer SMALLINT, first_order_date DATETIME, notes LONGTEXT, " & _ | |||||
| "next_action_date DATETIME, last_contacted_at DATETIME, removed_reason VARCHAR(255), removed_at DATETIME, " & _ | |||||
| "import_batch_id LONG, created_at DATETIME" | |||||
| migration.CreateIndex "ix_businesses_phone_digits", "businesses", "phone_digits" | |||||
| migration.CreateIndex "ix_businesses_email", "businesses", "email" | |||||
| migration.CreateIndex "ix_businesses_status", "businesses", "status" | |||||
| migration.CreateIndex "ix_businesses_is_customer", "businesses", "is_customer" | |||||
| migration.CreateIndex "ix_businesses_industry_id", "businesses", "industry_id" | |||||
| migration.CreateIndex "ix_businesses_next_action", "businesses", "next_action_date" | |||||
| migration.CreateIndex "ix_businesses_import_batch", "businesses", "import_batch_id" | |||||
| End Sub | |||||
| Sub Migration_Down(migration) | |||||
| migration.DropTable "businesses" | |||||
| End Sub | |||||
| %> | |||||
| @@ -0,0 +1,17 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' MIGRATION: create_interactions_table | |||||
| '======================================================================================================================= | |||||
| Sub Migration_Up(migration) | |||||
| migration.CreateTable "interactions", "id AUTOINCREMENT PRIMARY KEY, business_id LONG NOT NULL, " & _ | |||||
| "method VARCHAR(10) NOT NULL, outcome VARCHAR(30), notes LONGTEXT, " & _ | |||||
| "contacted_at DATETIME, follow_up_date DATETIME, created_at DATETIME" | |||||
| migration.CreateIndex "ix_interactions_business_id", "interactions", "business_id" | |||||
| migration.CreateIndex "ix_interactions_contacted_at", "interactions", "contacted_at" | |||||
| End Sub | |||||
| Sub Migration_Down(migration) | |||||
| migration.DropTable "interactions" | |||||
| End Sub | |||||
| %> | |||||
| @@ -0,0 +1,994 @@ | |||||
| # CLAUDE.md | |||||
| ## Purpose | |||||
| This file defines how Claude and Claude-compatible coding agents should operate in this repository. | |||||
| Read `AGENTS.md` first. | |||||
| `AGENTS.md` is the primary development policy. | |||||
| This file defines agent workflow, reasoning discipline, project learning, and self-improvement behavior. | |||||
| --- | |||||
| # 1. Startup Procedure | |||||
| At the beginning of a development task: | |||||
| 1. Read `AGENTS.md`. | |||||
| 2. Read this `CLAUDE.md`. | |||||
| 3. Inspect relevant files before editing. | |||||
| 4. Search the repository for similar implementations. | |||||
| 5. Identify existing helpers and abstractions. | |||||
| 6. Determine the affected architectural layers. | |||||
| 7. Identify security-sensitive boundaries. | |||||
| 8. Identify tests relevant to the change. | |||||
| Do not immediately generate a new abstraction before understanding the existing project. | |||||
| --- | |||||
| # 2. Treat VBScript as a Language Requiring Agent-Level Static Analysis | |||||
| VBScript lacks many safeguards found in modern compiled languages. | |||||
| Therefore, while working, actively inspect for: | |||||
| ```text | |||||
| undeclared variables | |||||
| misspelled identifiers | |||||
| missing Set | |||||
| wrong argument counts | |||||
| implicit Variant conversions | |||||
| Null propagation | |||||
| Empty values | |||||
| Nothing references | |||||
| unexpected ByRef mutation | |||||
| invalid function return paths | |||||
| unsafe SQL | |||||
| unsafe HTML output | |||||
| broad error suppression | |||||
| resource leaks | |||||
| global-state coupling | |||||
| ``` | |||||
| Act as a compiler substitute. | |||||
| --- | |||||
| # 3. Think in Boundaries | |||||
| Before changing code, determine which layer owns the behavior. | |||||
| Preferred direction: | |||||
| ```text | |||||
| Request | |||||
| ↓ | |||||
| Controller | |||||
| ↓ | |||||
| Service | |||||
| ↓ | |||||
| Repository | |||||
| ↓ | |||||
| Database | |||||
| ``` | |||||
| Views should receive prepared data. | |||||
| Do not bypass layers for convenience. | |||||
| --- | |||||
| # 4. Avoid Architectural Drift | |||||
| When adding functionality, prefer the project's existing good pattern. | |||||
| Do not create: | |||||
| ```text | |||||
| CustomerManager | |||||
| CustomerHandler | |||||
| CustomerEngine | |||||
| CustomerProcessor | |||||
| CustomerHelper | |||||
| ``` | |||||
| if `CustomerService` already represents the business layer. | |||||
| Reuse terminology consistently. | |||||
| --- | |||||
| # 5. Search Before Creating | |||||
| Before creating: | |||||
| - a helper | |||||
| - service | |||||
| - repository | |||||
| - validator | |||||
| - utility | |||||
| - model | |||||
| - WSC component | |||||
| - framework function | |||||
| search for an existing implementation. | |||||
| Prefer extending an existing appropriate abstraction over creating duplicates. | |||||
| --- | |||||
| # 6. Make Small Changes | |||||
| Prefer the smallest coherent change that solves the problem. | |||||
| Avoid unrelated cleanup unless necessary. | |||||
| If a task exposes a larger architectural problem: | |||||
| 1. solve the requested problem safely | |||||
| 2. document the larger concern | |||||
| 3. improve the architecture when justified | |||||
| Do not turn every bug fix into a rewrite. | |||||
| --- | |||||
| # 7. Never Hide Errors to Make Code Appear Functional | |||||
| Do not use broad: | |||||
| ```vbscript | |||||
| On Error Resume Next | |||||
| ``` | |||||
| to make failures disappear. | |||||
| Errors should be: | |||||
| ```text | |||||
| prevented | |||||
| handled | |||||
| logged | |||||
| or propagated | |||||
| ``` | |||||
| Never silently swallowed. | |||||
| --- | |||||
| # 8. Security Review Is Mandatory | |||||
| For each change involving input, output, authentication, database access, file handling, or state changes, inspect for: | |||||
| ```text | |||||
| SQL injection | |||||
| XSS | |||||
| CSRF | |||||
| authorization bypass | |||||
| open redirects | |||||
| path traversal | |||||
| unsafe file upload | |||||
| sensitive logging | |||||
| session misuse | |||||
| ``` | |||||
| Security checks are not optional even if the user did not explicitly request them. | |||||
| --- | |||||
| # 9. SQL Generation | |||||
| Always prefer parameterized ADODB commands. | |||||
| If existing code concatenates SQL, do not copy the unsafe pattern into new code. | |||||
| When touching the unsafe section directly, improve it if doing so is reasonably scoped and compatibility can be preserved. | |||||
| --- | |||||
| # 10. HTML Generation | |||||
| Dynamic text should be HTML encoded by default. | |||||
| Do not output raw Request or database values into HTML. | |||||
| When raw HTML is intentionally supported, make that trust boundary explicit. | |||||
| --- | |||||
| # 11. Validate at the Boundary | |||||
| Convert raw external values into trusted application values early. | |||||
| Think: | |||||
| ```text | |||||
| Raw Request value | |||||
| ↓ | |||||
| Trim / normalize | |||||
| ↓ | |||||
| Required check | |||||
| ↓ | |||||
| Format validation | |||||
| ↓ | |||||
| Type conversion | |||||
| ↓ | |||||
| Business validation | |||||
| ↓ | |||||
| Use | |||||
| ``` | |||||
| Do not allow raw Request values to flow deeply through the system. | |||||
| --- | |||||
| # 12. Prefer Explicit Code | |||||
| In VBScript, explicit code is usually safer than clever code. | |||||
| Prefer: | |||||
| ```vbscript | |||||
| Dim customerId | |||||
| customerId = CLng(value) | |||||
| ``` | |||||
| over relying on automatic coercion. | |||||
| Prefer clear control flow over compressed expressions. | |||||
| --- | |||||
| # 13. Functions and Procedures | |||||
| Keep procedures focused. | |||||
| If a function performs several unrelated operations, extract meaningful collaborators. | |||||
| Prefer names that describe intent. | |||||
| Bad: | |||||
| ```text | |||||
| ProcessData | |||||
| HandleStuff | |||||
| DoWork | |||||
| RunThing | |||||
| ``` | |||||
| Better: | |||||
| ```text | |||||
| ValidateCustomer | |||||
| CalculateOrderTotal | |||||
| LoadCustomerById | |||||
| SaveAppointment | |||||
| ``` | |||||
| --- | |||||
| # 14. ByVal and ByRef | |||||
| Remember: | |||||
| VBScript defaults parameters to `ByRef`. | |||||
| When mutation is not intended, prefer: | |||||
| ```vbscript | |||||
| ByVal | |||||
| ``` | |||||
| Use `ByRef` only when caller mutation is intentional. | |||||
| Review changed method signatures for accidental ByRef behavior. | |||||
| --- | |||||
| # 15. Object Assignment | |||||
| Remember that object assignment requires `Set`. | |||||
| Review every new or modified object assignment. | |||||
| Example: | |||||
| ```vbscript | |||||
| Set service = New CustomerService | |||||
| ``` | |||||
| not: | |||||
| ```vbscript | |||||
| service = New CustomerService | |||||
| ``` | |||||
| --- | |||||
| # 16. Function Return Values | |||||
| VBScript functions return values by assigning to their own name. | |||||
| Review all paths. | |||||
| Example: | |||||
| ```vbscript | |||||
| Function IsAllowed(ByVal userId) | |||||
| If userId <= 0 Then | |||||
| IsAllowed = False | |||||
| Exit Function | |||||
| End If | |||||
| IsAllowed = True | |||||
| End Function | |||||
| ``` | |||||
| Do not accidentally leave an important return value as Empty. | |||||
| --- | |||||
| # 17. COM and ADODB Cleanup | |||||
| When creating: | |||||
| - ADODB.Connection | |||||
| - ADODB.Command | |||||
| - ADODB.Recordset | |||||
| - filesystem objects | |||||
| - external COM components | |||||
| understand ownership and cleanup behavior. | |||||
| Explicitly close database resources when appropriate. | |||||
| Set references to `Nothing` when ownership ends. | |||||
| --- | |||||
| # 18. Avoid Global State | |||||
| Prefer explicit dependencies. | |||||
| Do not add Session or Application state merely because it is convenient. | |||||
| Ask: | |||||
| ```text | |||||
| Does this value truly need to survive across requests? | |||||
| ``` | |||||
| If not, keep it request-scoped. | |||||
| --- | |||||
| # 19. Testing Strategy | |||||
| When possible, isolate business logic from ASP globals. | |||||
| Favor code that can be invoked with plain VBScript values or mock collaborators. | |||||
| When fixing a defect, add a regression test where practical. | |||||
| --- | |||||
| # 20. Comments | |||||
| Comments should explain: | |||||
| ```text | |||||
| why | |||||
| constraints | |||||
| non-obvious behavior | |||||
| compatibility requirements | |||||
| security rationale | |||||
| ``` | |||||
| Do not add comments that merely repeat the code. | |||||
| Bad: | |||||
| ```vbscript | |||||
| ' Set customer id | |||||
| customerId = 10 | |||||
| ``` | |||||
| Useful: | |||||
| ```vbscript | |||||
| ' Legacy import files use 0 to represent an unknown customer. | |||||
| If customerId = 0 Then | |||||
| ``` | |||||
| --- | |||||
| # 21. Preserve Valuable Legacy Behavior | |||||
| ASP Classic projects may contain old but important behavior. | |||||
| Do not assume unfamiliar code is wrong. | |||||
| Before removing or replacing something: | |||||
| 1. search references | |||||
| 2. understand callers | |||||
| 3. identify side effects | |||||
| 4. inspect related documentation | |||||
| 5. preserve compatibility where required | |||||
| --- | |||||
| # 22. Self-Improvement | |||||
| This repository is designed to allow agents to improve their own operating instructions. | |||||
| Self-improvement should make future work: | |||||
| - safer | |||||
| - more consistent | |||||
| - easier to verify | |||||
| - less repetitive | |||||
| - more maintainable | |||||
| Do not change instructions merely to suit the current implementation. | |||||
| Improve the implementation when practical rather than weakening good rules. | |||||
| --- | |||||
| # 23. Detect Learnable Events | |||||
| A learnable event occurs when: | |||||
| - a repeated bug appears | |||||
| - a review catches the same mistake repeatedly | |||||
| - a new reusable pattern proves successful | |||||
| - a project architecture decision becomes permanent | |||||
| - a new security requirement becomes necessary | |||||
| - a repeated workflow can be standardized | |||||
| - a user establishes a lasting convention | |||||
| - an existing instruction becomes inaccurate | |||||
| When a learnable event occurs, determine whether project documentation should change. | |||||
| --- | |||||
| # 24. Where Learning Should Go | |||||
| Use the smallest appropriate scope. | |||||
| Update: | |||||
| ```text | |||||
| AGENTS.md | |||||
| ``` | |||||
| for project-wide durable policies. | |||||
| Update: | |||||
| ```text | |||||
| CLAUDE.md | |||||
| ``` | |||||
| for agent workflow and Claude-specific operating behavior. | |||||
| Update: | |||||
| ```text | |||||
| /docs/* | |||||
| ``` | |||||
| for architectural or project documentation. | |||||
| Update: | |||||
| ```text | |||||
| /skills/* | |||||
| ``` | |||||
| for reusable specialized procedures. | |||||
| Update source-code comments only for code-local constraints. | |||||
| Do not place every lesson into AGENTS.md. | |||||
| --- | |||||
| # 25. Self-Update Decision | |||||
| Before modifying an instruction file, ask: | |||||
| ```text | |||||
| Is this lesson likely to matter again? | |||||
| ``` | |||||
| If no, do not persist it. | |||||
| Then ask: | |||||
| ```text | |||||
| Is this project-wide? | |||||
| ``` | |||||
| If yes, consider AGENTS.md. | |||||
| Otherwise use a specialized document. | |||||
| --- | |||||
| # 26. Never Self-Weaken Core Safety Rules | |||||
| Claude must not autonomously remove or weaken requirements involving: | |||||
| ```text | |||||
| Option Explicit | |||||
| parameterized SQL | |||||
| server-side authorization | |||||
| input validation | |||||
| output encoding | |||||
| safe error handling | |||||
| resource cleanup | |||||
| secret protection | |||||
| ``` | |||||
| If an unusual project requirement appears to conflict with one of these rules, preserve safety and document the conflict. | |||||
| --- | |||||
| # 27. Avoid Instruction Inflation | |||||
| Do not add a new rule for every isolated mistake. | |||||
| Prefer: | |||||
| ```text | |||||
| general principle | |||||
| + | |||||
| reusable example | |||||
| ``` | |||||
| rather than hundreds of hyper-specific rules. | |||||
| A rule should prevent a category of mistakes. | |||||
| --- | |||||
| # 28. Improve Through Abstractions Too | |||||
| Not every lesson belongs in documentation. | |||||
| If the same safety requirement appears repeatedly, consider encoding it into the framework. | |||||
| Examples: | |||||
| ```text | |||||
| Safe HTML helper | |||||
| Parameterized database wrapper | |||||
| Request conversion helper | |||||
| Validation library | |||||
| Authorization service | |||||
| Logging wrapper | |||||
| Repository base conventions | |||||
| ``` | |||||
| The best rule is sometimes one the architecture makes difficult to violate. | |||||
| --- | |||||
| # 29. Skill Creation | |||||
| Claude may create a new skill when the task is: | |||||
| - specialized | |||||
| - recurring | |||||
| - procedural | |||||
| - reusable across multiple features | |||||
| Possible skills: | |||||
| ```text | |||||
| /skills/asp-classic-controller.md | |||||
| /skills/adodb-repository.md | |||||
| /skills/sql-parameterization.md | |||||
| /skills/security-review.md | |||||
| /skills/vbscript-static-review.md | |||||
| /skills/testing.md | |||||
| ``` | |||||
| Do not create a skill for a one-time task. | |||||
| --- | |||||
| # 30. Suggested Skill Format | |||||
| Each skill should contain: | |||||
| ```text | |||||
| # Skill Name | |||||
| ## Purpose | |||||
| ## Use When | |||||
| ## Inputs | |||||
| ## Procedure | |||||
| ## Required Rules | |||||
| ## Validation Checklist | |||||
| ## Common Mistakes | |||||
| ## Output | |||||
| ## Improvement Notes | |||||
| ``` | |||||
| --- | |||||
| # 31. Agent Review Loop | |||||
| For meaningful tasks, use this cycle: | |||||
| ```text | |||||
| Understand | |||||
| ↓ | |||||
| Inspect | |||||
| ↓ | |||||
| Design | |||||
| ↓ | |||||
| Implement | |||||
| ↓ | |||||
| Review | |||||
| ↓ | |||||
| Test | |||||
| ↓ | |||||
| Learn | |||||
| ``` | |||||
| The `Learn` step asks whether the repository's instructions or abstractions should improve. | |||||
| --- | |||||
| # 32. Design Before Implementation | |||||
| For significant changes, identify: | |||||
| ```text | |||||
| affected layers | |||||
| new components | |||||
| existing components | |||||
| data flow | |||||
| validation boundaries | |||||
| security boundaries | |||||
| failure behavior | |||||
| testing strategy | |||||
| ``` | |||||
| before writing substantial code. | |||||
| For small tasks, keep this lightweight. | |||||
| --- | |||||
| # 33. Avoid Premature Framework Expansion | |||||
| Do not add framework components simply because another language would have them. | |||||
| ASP Classic should remain simple. | |||||
| Only introduce an abstraction when it solves a real recurring problem. | |||||
| --- | |||||
| # 34. Prefer Composition | |||||
| When extending behavior, first consider: | |||||
| ```text | |||||
| small object | |||||
| + | |||||
| small collaborator | |||||
| ``` | |||||
| instead of large pseudo-inheritance systems. | |||||
| VBScript is better suited to simple composition. | |||||
| --- | |||||
| # 35. Stable Public Contracts | |||||
| Treat established routes, APIs, class methods, and database contracts carefully. | |||||
| When changing them: | |||||
| 1. search callers | |||||
| 2. assess compatibility | |||||
| 3. update all consumers | |||||
| 4. document breaking changes | |||||
| Avoid accidental interface changes. | |||||
| --- | |||||
| # 36. Database Changes | |||||
| For schema changes, consider: | |||||
| ```text | |||||
| backward compatibility | |||||
| migration order | |||||
| existing data | |||||
| Null behavior | |||||
| indexes | |||||
| constraints | |||||
| application deployment timing | |||||
| rollback implications | |||||
| ``` | |||||
| Do not modify schema casually. | |||||
| --- | |||||
| # 37. Performance Review | |||||
| When working with database code, look for: | |||||
| ```text | |||||
| queries inside loops | |||||
| SELECT * | |||||
| unnecessary recordset traversal | |||||
| missing filters | |||||
| repeated connection creation | |||||
| large Session values | |||||
| unbounded result sets | |||||
| unnecessary COM calls | |||||
| ``` | |||||
| Prefer database-side filtering and set operations. | |||||
| --- | |||||
| # 38. Request Lifecycle Awareness | |||||
| Remember that ASP Classic operates per request. | |||||
| Avoid assumptions that local variables persist between requests. | |||||
| Use Session or persistent storage only when the application truly requires cross-request state. | |||||
| --- | |||||
| # 39. Application Lifecycle Awareness | |||||
| `Application` state is global to the ASP application. | |||||
| Do not store user-specific data there. | |||||
| Be mindful of concurrent requests. | |||||
| --- | |||||
| # 40. Avoid Hidden Dependencies | |||||
| A component should not unexpectedly require: | |||||
| ```text | |||||
| Request | |||||
| Response | |||||
| Session | |||||
| Application | |||||
| global connection object | |||||
| global logger | |||||
| global configuration | |||||
| ``` | |||||
| unless that dependency is part of the documented architecture. | |||||
| Prefer passing dependencies explicitly. | |||||
| --- | |||||
| # 41. Compatibility First During Refactoring | |||||
| When modernizing legacy code: | |||||
| ```text | |||||
| First preserve behavior. | |||||
| Then improve structure. | |||||
| ``` | |||||
| Avoid combining major behavior changes with major refactors unless necessary. | |||||
| --- | |||||
| # 42. Repository Review After Significant Changes | |||||
| After a meaningful feature or refactor, search for: | |||||
| - outdated documentation | |||||
| - duplicate helpers | |||||
| - now-dead code | |||||
| - inconsistent naming | |||||
| - old patterns replaced by the new pattern | |||||
| - opportunities to update an existing skill | |||||
| Keep the repository internally consistent. | |||||
| --- | |||||
| # 43. Learn From User Corrections | |||||
| If the user corrects Claude on a durable project convention, treat that as a possible learnable event. | |||||
| Examples: | |||||
| ```text | |||||
| "We always use this router." | |||||
| "Repositories never return recordsets." | |||||
| "All AJAX endpoints use this response format." | |||||
| "Use WSC components for controllers." | |||||
| ``` | |||||
| If the instruction is durable, update the appropriate project guidance. | |||||
| Do not persist one-time preferences as permanent architecture rules. | |||||
| --- | |||||
| # 44. Change Documentation Conservatively | |||||
| When modifying AGENTS.md, CLAUDE.md, or skills: | |||||
| - preserve useful existing rules | |||||
| - remove duplicates | |||||
| - clarify contradictions | |||||
| - avoid unnecessary rewrites | |||||
| - add an update-history entry where appropriate | |||||
| Instruction files should become clearer over time, not merely longer. | |||||
| --- | |||||
| # 45. Conflict Detection | |||||
| If project documentation contradicts itself: | |||||
| 1. identify the conflict | |||||
| 2. use higher-priority instructions | |||||
| 3. resolve the contradiction where safe | |||||
| 4. update documentation so future agents do not face the same conflict | |||||
| Do not silently choose different interpretations from task to task. | |||||
| --- | |||||
| # 46. Self-Improvement Is Not Autonomous Product Redesign | |||||
| Claude may improve: | |||||
| ```text | |||||
| guidelines | |||||
| skills | |||||
| documentation | |||||
| developer workflow | |||||
| internal abstractions | |||||
| ``` | |||||
| when justified. | |||||
| Claude must not independently redefine: | |||||
| ```text | |||||
| business requirements | |||||
| user-visible behavior | |||||
| pricing | |||||
| authorization policy | |||||
| data retention policy | |||||
| major architecture goals | |||||
| ``` | |||||
| without task requirements supporting the change. | |||||
| --- | |||||
| # 47. Final Review Mode | |||||
| Before completing a task, temporarily switch from implementation thinking to adversarial review. | |||||
| Ask: | |||||
| ```text | |||||
| How could this fail? | |||||
| What would VBScript fail to warn me about? | |||||
| What input breaks this? | |||||
| What happens with Null? | |||||
| What happens with Empty? | |||||
| What happens with Nothing? | |||||
| Did I forget Set? | |||||
| Could ByRef change the caller? | |||||
| Could SQL injection occur? | |||||
| Could XSS occur? | |||||
| Could authorization be bypassed? | |||||
| Could an error be swallowed? | |||||
| Could a recordset remain open? | |||||
| Did I accidentally duplicate existing functionality? | |||||
| ``` | |||||
| Fix issues found before finishing. | |||||
| --- | |||||
| # 48. Final Summary | |||||
| When reporting completed coding work, mention material items such as: | |||||
| ```text | |||||
| what changed | |||||
| important architecture choices | |||||
| tests performed | |||||
| security implications | |||||
| documentation or rule updates | |||||
| remaining limitations | |||||
| ``` | |||||
| Do not produce long explanations for trivial changes. | |||||
| --- | |||||
| # 49. Core Philosophy | |||||
| Claude should help make ASP Classic behave like a disciplined modern development environment without destroying the language's simplicity. | |||||
| The goal is not to turn VBScript into C#. | |||||
| The goal is to provide the safeguards that VBScript lacks. | |||||
| Think: | |||||
| ```text | |||||
| VBScript | |||||
| + | |||||
| clear architecture | |||||
| + | |||||
| strict conventions | |||||
| + | |||||
| reusable framework components | |||||
| + | |||||
| agent-level static analysis | |||||
| + | |||||
| continuous learning | |||||
| = | |||||
| reliable ASP Classic development | |||||
| ``` | |||||
| --- | |||||
| # Update History | |||||
| 2026-09-02 | |||||
| - Initial Claude operating instructions created. | |||||
| - Added VBScript static-review behavior. | |||||
| - Added controlled self-improvement workflow. | |||||
| - Added learnable-event detection and skill creation guidance. | |||||
| @@ -0,0 +1,63 @@ | |||||
| # API Contracts - MVC-Starter | |||||
| **Date:** 2026-03-11T11:59:39Z | |||||
| ## Overview | |||||
| This project does not expose a standalone JSON API. Its current externally reachable contracts are server-rendered HTTP routes handled by the Classic ASP MVC dispatcher. | |||||
| ## Route Catalog | |||||
| ### `GET /` | |||||
| - **Controller:** `homeController` | |||||
| - **Action:** `Index` | |||||
| - **Behavior:** Renders the home page using the shared layout and `app/views/Home/index.asp`. | |||||
| - **Layout:** enabled (`useLayout = True`) | |||||
| - **Response Type:** HTML | |||||
| - **Status:** `200 OK` | |||||
| ### `GET /home` | |||||
| - **Controller:** `homeController` | |||||
| - **Action:** `Index` | |||||
| - **Behavior:** Alias route to the home page; renders the same content as `/`. | |||||
| - **Layout:** enabled | |||||
| - **Response Type:** HTML | |||||
| - **Status:** `200 OK` | |||||
| ### `GET ""` (empty path fallback) | |||||
| - **Controller:** `homeController` | |||||
| - **Action:** `Index` | |||||
| - **Behavior:** Additional root-path fallback route declared in `public/Default.asp`. | |||||
| - **Layout:** enabled | |||||
| - **Response Type:** HTML | |||||
| - **Status:** `200 OK` | |||||
| ### `GET /404` | |||||
| - **Controller:** `ErrorController` | |||||
| - **Action:** `NotFound` | |||||
| - **Behavior:** Renders the not-found page and sets the response status to `404 Not Found`. | |||||
| - **Layout:** enabled | |||||
| - **Response Type:** HTML | |||||
| - **Status:** `404 Not Found` | |||||
| ## Dispatch Contract | |||||
| - All non-static requests are rewritten by IIS to `public/Default.asp`. | |||||
| - `public/Default.asp` registers routes and calls `MVC.DispatchRequest`. | |||||
| - `core/mvc.asp` validates controller and action names, checks the controller whitelist, resolves the controller dynamically, and invokes the action. | |||||
| - If `useLayout` is enabled on the resolved controller, shared header and footer views wrap the response. | |||||
| ## Security and Validation Notes | |||||
| - Controller names must pass format validation and whitelist checks in `core/lib.ControllerRegistry.asp`. | |||||
| - Action names must pass identifier validation before dispatch. | |||||
| - Current route handling is page-oriented; there are no documented JSON payload schemas or standalone API auth flows in the application itself. | |||||
| ## Brownfield Notes | |||||
| - Future endpoint additions require updates in at least three places: route registration, controller include/implementation, and controller whitelist registration. | |||||
| - This document reflects route contracts, not REST-style service endpoints. | |||||
| @@ -0,0 +1,34 @@ | |||||
| # Architecture Patterns | |||||
| **Date:** 2026-03-11T11:59:39Z | |||||
| ## Part: MVC-Starter | |||||
| ### Primary Architecture Pattern | |||||
| Server-rendered MVC monolith with a starter/framework hybrid structure: IIS and `public/` handle request entry, `core/` provides shared runtime and dispatch behavior, and `app/` provides project-specific extensions. | |||||
| ## Pattern Breakdown | |||||
| - **End-to-end request path:** IIS URL Rewrite sends requests to `public/Default.asp`, routes are registered there, the router resolves controller/action/params, `core/mvc.asp` validates and dispatches, and shared layout files wrap output when `useLayout` is enabled. | |||||
| - **Routing pattern:** Routes are declared centrally in `public/Default.asp` and resolved through the RouteKit router object. | |||||
| - **Dispatch pattern:** `core/mvc.asp` uses validation, controller whitelisting, and dynamic execution to resolve the current controller and action. | |||||
| - **Application layering:** `core/` contains reusable framework/runtime behavior, while `app/` contains project-specific controllers, views, models, and repositories. | |||||
| - **Rendering pattern:** Controllers orchestrate and include `.asp` view files; shared header/footer layout files provide common page chrome. | |||||
| - **Data pattern:** Data access is config-driven through `public/web.config`, with DAL libraries and generator-assisted repositories/POBOs supporting database interaction. | |||||
| - **Operational tooling pattern:** Schema and scaffolding workflows are handled by standalone VBScript tools under `scripts/`. | |||||
| ## Architectural Implications | |||||
| - This codebase is optimized around a single IIS-hosted deployable unit rather than separable services. | |||||
| - Framework bootstrapping and request dispatch are centralized, so edits to `public/` entry files or `core/` runtime files have broad impact. | |||||
| - Dynamic dispatch is part of the framework design, which makes naming, registration, and validation rules part of the architecture contract. | |||||
| - Feature development typically extends existing seams in `app/`, `db/`, and `scripts/` rather than introducing new application subsystems. | |||||
| - The architecture assumes server-side HTML rendering and config-driven runtime behavior rather than client-heavy SPA patterns. | |||||
| ## Brownfield Notes | |||||
| - The most important architectural boundary is between the framework/runtime layer (`core/`) and the app extension layer (`app/`). | |||||
| - Controller activation is not automatic; routing, include registration, and whitelist registration are all part of the runtime contract. | |||||
| - Windows/IIS hosting is part of the architecture, not just deployment detail, because request flow and configuration depend on it. | |||||
| - Generator scripts are part of the implementation model, not just convenience tooling. | |||||
| @@ -0,0 +1,81 @@ | |||||
| # MVC-Starter - Architecture | |||||
| **Date:** 2026-03-11T11:59:39Z | |||||
| **Project Type:** web | |||||
| **Architecture:** Server-rendered MVC monolith | |||||
| ## Executive Summary | |||||
| MVC-Starter is a Classic ASP starter application built around a single IIS-hosted deployable unit. Requests enter through `public/Default.asp`, flow through a shared runtime in `core/`, and resolve into application-specific controllers and views under `app/`. | |||||
| ## Technology Stack | |||||
| - Classic ASP / VBScript | |||||
| - Windows IIS with URL Rewrite | |||||
| - RouteKit-style router and MVC dispatcher | |||||
| - Microsoft Access via ACE OLE DB | |||||
| - Bootstrap 5.3.3 and Bootstrap Icons 1.11.3 from CDN | |||||
| - VBScript tooling for scaffolding and migrations | |||||
| ## Architecture Pattern | |||||
| Starter/framework hybrid MVC monolith: | |||||
| - `public/` handles web entry and IIS-facing config | |||||
| - `core/` handles routing, dispatch, validation, helpers, and DAL concerns | |||||
| - `app/` contains project-specific behavior and server-rendered views | |||||
| - `db/` and `scripts/` support data and operational workflows | |||||
| ## Request Flow | |||||
| 1. IIS receives the request. | |||||
| 2. `public/web.config` rewrites non-static requests to `public/Default.asp`. | |||||
| 3. `Default.asp` registers routes and calls `MVC.DispatchRequest`. | |||||
| 4. `core/mvc.asp` validates controller/action names, checks whitelist registration, resolves the current controller dynamically, and executes the target action. | |||||
| 5. Shared layout files wrap the response if `useLayout` is enabled. | |||||
| ## Data Architecture | |||||
| - Database configuration is read from `public/web.config`. | |||||
| - `db/webdata.accdb` is the included Access database. | |||||
| - DAL and migration helpers live in `core/`. | |||||
| - Repositories and POBOs are expected to be generated via `scripts/GenerateRepo.vbs`. | |||||
| ## Component Overview | |||||
| - Controllers: `app/controllers/` | |||||
| - Views: `app/views/` | |||||
| - Shared layout: `app/views/shared/` | |||||
| - Runtime/framework: `core/` | |||||
| - Scaffolding/tooling: `scripts/` | |||||
| ## Source Tree | |||||
| See [source-tree-analysis.md](./source-tree-analysis.md) for the annotated directory breakdown. | |||||
| ## Development Workflow | |||||
| - Generate migration | |||||
| - Generate POBO/repository | |||||
| - Generate controller | |||||
| - Register controller include, whitelist, and routes | |||||
| - Add views and validate via IIS-hosted execution | |||||
| ## Deployment Architecture | |||||
| - Single IIS site | |||||
| - `public/` as web root | |||||
| - XML config in `public/web.config` | |||||
| - No separate service/process topology detected | |||||
| ## Testing Strategy | |||||
| - No automated test framework detected | |||||
| - Manual request-flow verification is required | |||||
| - Script tooling can be validated via `cscript` | |||||
| ## Architectural Constraints | |||||
| - Dynamic dispatch means naming and registration consistency are part of runtime correctness. | |||||
| - `core/`, `public/Default.asp`, and `public/web.config` are high-impact files. | |||||
| - The architecture assumes Windows/IIS hosting rather than cross-platform portability. | |||||
| @@ -0,0 +1,63 @@ | |||||
| # MVC-Starter - Component Inventory | |||||
| **Date:** 2026-03-11T11:59:39Z | |||||
| ## Runtime and MVC Components | |||||
| ### Front Controller | |||||
| - `public/Default.asp` | |||||
| - Registers routes | |||||
| - Boots runtime | |||||
| - Dispatches requests | |||||
| ### Dispatcher | |||||
| - `core/mvc.asp` | |||||
| - Validates controller/action names | |||||
| - Enforces controller whitelist | |||||
| - Wraps responses in shared layout when enabled | |||||
| ### Controller Registry | |||||
| - `core/lib.ControllerRegistry.asp` | |||||
| - Tracks valid controllers | |||||
| - Prevents arbitrary controller execution | |||||
| ### Controllers | |||||
| - `app/controllers/HomeController.asp` | |||||
| - Home page controller | |||||
| - `app/controllers/ErrorController.asp` | |||||
| - 404/not-found handling | |||||
| ## UI/View Components | |||||
| ### Shared Layout | |||||
| - `app/views/shared/header.asp` | |||||
| - `app/views/shared/footer.asp` | |||||
| ### Feature Views | |||||
| - `app/views/Home/index.asp` | |||||
| - `app/views/Error/NotFound.asp` | |||||
| ## Data/Operational Components | |||||
| ### Database Assets | |||||
| - `db/webdata.accdb` | |||||
| ### Script Tooling | |||||
| - `scripts/generateController.vbs` | |||||
| - `scripts/GenerateRepo.vbs` | |||||
| - `scripts/generateMigration.vbs` | |||||
| - `scripts/runMigrations.vbs` | |||||
| ## Reuse Notes | |||||
| - The main reusable UI surface is the shared layout. | |||||
| - The main reusable runtime surface is the `core/` library set. | |||||
| - The data layer is scaffold-oriented and currently has no committed application-specific model/repository classes. | |||||
| @@ -0,0 +1,46 @@ | |||||
| # Comprehensive Analysis - MVC-Starter | |||||
| **Date:** 2026-03-11T11:59:39Z | |||||
| ## Configuration Management | |||||
| - Primary runtime configuration lives in `public/web.config`. | |||||
| - Important settings include database connection, environment mode, flash timing, 404 redirect timing, cache controls, and error logging paths. | |||||
| - Configuration is read in application code through helper accessors such as `GetAppSetting`. | |||||
| ## Authentication and Security | |||||
| - No full authentication subsystem is present in the starter. | |||||
| - The main observable security boundary is controller/action validation and controller whitelisting in `core/lib.ControllerRegistry.asp`. | |||||
| - Dispatch also HTML-encodes some user-visible error output to reduce injection risk. | |||||
| ## Entry Points and Bootstrap | |||||
| - IIS web root: `public/` | |||||
| - Default document: `public/Default.asp` | |||||
| - Runtime bootstrap include: `core/autoload_core.asp` | |||||
| - Request dispatcher: `core/mvc.asp` | |||||
| ## Shared Code | |||||
| - `core/` contains reusable framework/runtime libraries for routing, data access, flash messaging, forms, uploads, HTML helpers, validation, encryption helpers, and JSON support. | |||||
| - `scripts/` contains operational generators and migration tooling. | |||||
| ## Event/Async Patterns | |||||
| - No queue, worker, or event-bus architecture was detected. | |||||
| - UI behavior is mostly server-rendered with small inline browser-side scripts where needed. | |||||
| ## CI/CD and Deployment | |||||
| - No CI/CD pipeline configuration was detected. | |||||
| - Deployment is IIS-based and documented in `README.md` and `public/web.config`. | |||||
| ## Localization | |||||
| - No localization or i18n framework was detected. | |||||
| ## Testing Surface | |||||
| - No automated test framework or test files were detected in the application code. | |||||
| - Validation currently depends on manual runtime checks and script execution in a Windows/IIS environment. | |||||
| @@ -0,0 +1,11 @@ | |||||
| # Critical Folders Summary | |||||
| **Date:** 2026-03-11T11:59:39Z | |||||
| - `public/`: externally facing web root, rewrite config, and request bootstrap | |||||
| - `core/`: framework/runtime internals, dispatcher, router, helpers, DAL, and security checks | |||||
| - `app/controllers/`: project controller implementations and include-based activation surface | |||||
| - `app/views/`: server-rendered feature views and shared layout | |||||
| - `db/`: Access database and migration workspace | |||||
| - `scripts/`: generator and migration tooling used during feature development | |||||
| - `docs/`: generated brownfield documentation for future planning and AI-assisted work | |||||
| @@ -0,0 +1,42 @@ | |||||
| # Data Models - MVC-Starter | |||||
| **Date:** 2026-03-11T11:59:39Z | |||||
| ## Overview | |||||
| The repository includes a database file and data-access infrastructure, but it does not yet contain checked-in application model or repository source files under `app/models/` or `app/repositories/`. | |||||
| ## Current Data Assets | |||||
| ### Database File | |||||
| - **Path:** `db/webdata.accdb` | |||||
| - **Type:** Microsoft Access database | |||||
| - **Configured Provider:** `Microsoft.ACE.OLEDB.12.0` | |||||
| - **Configured From:** `public/web.config` | |||||
| ### Data Access Runtime | |||||
| - **DAL libraries:** `core/lib.DAL.asp`, `core/lib.Data.asp` | |||||
| - **Migration support:** `core/lib.Migrations.asp` | |||||
| - **Repository/model generation:** `scripts/GenerateRepo.vbs` | |||||
| ## Schema and Model Strategy | |||||
| - The intended model pattern is generator-assisted. | |||||
| - `GenerateRepo.vbs` inspects a target table and produces: | |||||
| - `POBO_<Table>.asp` | |||||
| - `<Table>Repository.asp` | |||||
| - Generated outputs are expected to be moved into `app/models/` and `app/repositories/`. | |||||
| ## Current Repository State | |||||
| - `app/models/` is currently empty. | |||||
| - `app/repositories/` is currently empty. | |||||
| - `db/migrations/` currently has no checked-in migration files. | |||||
| ## Brownfield Implications | |||||
| - The project is database-capable, but the sample starter does not include domain entities yet. | |||||
| - Schema evolution and repository creation are expected to happen through the provided VBScript tooling rather than a separate ORM or package-managed migration framework. | |||||
| - Future data documentation should be regenerated once concrete tables, migration files, or generated POBO/repository files are added. | |||||
| @@ -0,0 +1,82 @@ | |||||
| # Deployment Configuration | |||||
| ## Dedicated defaults | |||||
| The deployment controller and host installer use the same isolated defaults: | |||||
| | Parameter | Default | | |||||
| | --- | --- | | |||||
| | `SiteName` | `AspClassicUnifiedFramework` | | |||||
| | `AppPoolName` | `AspClassicUnifiedFramework` | | |||||
| | `DeployRoot` | `D:\Deployments\AspClassicUnifiedFramework` | | |||||
| | `BindingIpAddress` | `100.97.39.23` | | |||||
| | `BindingPort` | `8085` | | |||||
| | `HostHeader` | empty | | |||||
| | `ExpectedBranch` | `master` (controller) | | |||||
| Every value can be explicitly overridden. Site and pool names, deployment root, and host header containing `Schedulicious` are rejected as an additional safety boundary. The scripts do not enumerate another site as a configuration source and provide no adoption switch. | |||||
| ## Configuration ownership | |||||
| Repository `public\web.config` is the default template for first deployment. After the package is safely extracted and validated, the host installer initializes: | |||||
| ```text | |||||
| <DeployRoot>\shared\public.web.config | |||||
| ``` | |||||
| from the staged package's `public\web.config`. If `InitialWebConfigPath` is supplied on that first deployment, the validated host-local file at that path is used instead. The parameter does not replace an existing shared configuration. Configuration is never copied from another IIS site. | |||||
| Every staged release receives the shared file before promotion. Change the shared file only through normal host configuration/change control and validate its XML. Keep secrets and production database paths out of source control. | |||||
| ## IIS state owned by the pipeline | |||||
| The pipeline owns only the named dedicated site and app pool. It may: | |||||
| 1. create them, only when both are absent and only after a staged release validates; | |||||
| 2. point the dedicated site at `<DeployRoot>\releases\<release-id>\public`; | |||||
| 3. set `system.webServer/asp enableParentPaths=true` at that site's location; | |||||
| 4. start/recycle the dedicated app pool and start a newly created site. | |||||
| It does not alter unrelated sites, app pools, bindings, authentication, identities, ACLs, Windows features, or IIS modules. It does not add bindings to an existing site. | |||||
| When the target already exists, the site and pool must both exist and exactly match the requested app pool, sole HTTP binding, and pipeline-owned release-public path. Any mismatch fails closed. | |||||
| ## Controller parameters | |||||
| `scripts/deploy-iis-git.ps1` supports: | |||||
| - `SiteName`, `AppPoolName`, `DeployRoot`, `BindingIpAddress`, `BindingPort`, `HostHeader`: dedicated target identity and binding. | |||||
| - `InitialWebConfigPath`: optional host-local first-deployment seed. | |||||
| - `RemoteTarget`, `RemotePort`: OpenSSH transport. | |||||
| - `SourcePath`: standalone checkout to validate/package. | |||||
| - `ExpectedBranch`: remains `master` by default. | |||||
| - `ReleaseId`: optional immutable release identifier. | |||||
| - `BaseUrl`: explicit host-side smoke-test URL. | |||||
| - `KeepReleases`: reporting threshold only; no deletion. | |||||
| - `LocalPreflightOnly`: local source/XML/package/safety validation; no network. | |||||
| - `PreflightOnly` (`HostPreflightOnly` and `RemotePreflightOnly` aliases): run local/package checks, then stream the installer over SSH for host validation without writing remote files or changing IIS/deployment state. | |||||
| - `DryRun`: local package validation plus remote command preview; no network. | |||||
| - `AllowAnyBranch`, `AllowDirty`: reviewed provenance exceptions. | |||||
| - `RunMigrations`: explicit database migration opt-in. | |||||
| - `SkipSmokeTest`: explicit smoke-test exception. | |||||
| - `Rollback` and `RollbackTo`: switch the dedicated target to a validated prior release. | |||||
| ## Host installer parameters | |||||
| `scripts/install-iis-release.ps1` accepts the same target/configuration parameters plus: | |||||
| - `PackagePath`, `ReleaseId`, `ExpectedSha256`: deployment artifact inputs. | |||||
| - `PreflightOnly` or `DryRun`: read-only host checks; the target may be absent. | |||||
| - `RollbackTo`: validated release ID for rollback. | |||||
| Host preflight requires elevation and verifies WebAdministration, Classic ASP feature and `AspModule`, URL Rewrite, requested binding conflicts (including wildcard overlap), shared-pool conflicts, deployment drive/path accessibility, names, and exact existing-target state. It makes no IIS or deployment-root changes. | |||||
| ## Failure scope | |||||
| If creation or smoke testing fails, the installer removes only a site or app pool whose creation flags were set by that invocation. For an existing valid target, it restores the captured physical path and parent-path value. Unrelated IIS resources are never cleanup candidates. | |||||
| Package staging/release files can remain as diagnostic evidence. Database migrations and external writes are outside IIS rollback. | |||||
| ## Secrets, identity, and writable data | |||||
| Use OpenSSH configuration, an SSH agent, or a CI secret store. Do not commit passwords, private keys, production connection strings, or database files. Put production databases and logs outside release directories. App-pool identity and filesystem ACL provisioning are explicit host-administration tasks, not inferred from another site. | |||||
| @@ -0,0 +1,134 @@ | |||||
| # IIS Deployment Guide | |||||
| ## Isolation boundary | |||||
| This pipeline owns one dedicated IIS site and one dedicated application pool. It never discovers, copies configuration from, adopts, or changes another IIS site. In particular, no existing Schedulicious site, app pool, binding, path, or configuration is a deployment source or target. | |||||
| Defaults (each may be overridden explicitly): | |||||
| ```text | |||||
| SiteName AspClassicUnifiedFramework | |||||
| AppPoolName AspClassicUnifiedFramework | |||||
| DeployRoot D:\Deployments\AspClassicUnifiedFramework | |||||
| Binding http://100.97.39.23:8085/ (empty host header) | |||||
| ExpectedBranch master | |||||
| ``` | |||||
| An existing target is accepted only when its name, app pool, sole HTTP binding, and physical path exactly match this pipeline's expected dedicated state. The physical path must be a `public` directory under `<DeployRoot>\releases`. A partial or mismatched target fails closed; there is no adoption mode. Unrelated sites, pools, and bindings are left unchanged. | |||||
| ## Release and web-root model | |||||
| ```text | |||||
| D:\Deployments\AspClassicUnifiedFramework\ | |||||
| releases\ | |||||
| <release-id>\ | |||||
| app\ | |||||
| core\ | |||||
| db\ | |||||
| public\ <- only this directory is served by IIS | |||||
| scripts\ | |||||
| tests\ | |||||
| ... | |||||
| shared\ | |||||
| public.web.config | |||||
| deployment-state.json | |||||
| ``` | |||||
| The complete repository is packaged because `public/Default.asp` uses parent includes from sibling directories. Releases are extracted into `<release-id>.staging`, checked for required files, safe paths/reparse points, and valid `public\web.config` XML, overlaid with shared configuration, and renamed to an immutable release directory. IIS serves only `<release>\public`. | |||||
| On the first deployment, shared configuration is initialized from the packaged release's `public\web.config`. Supply `-InitialWebConfigPath` only when an explicitly managed host-local configuration file should seed the first deployment. The script validates that file as XML. It never copies configuration from any IIS site. Once created, the shared file is reused and is not automatically refreshed. | |||||
| Classic ASP parent paths are enabled with a location-scoped `system.webServer/asp` setting for this dedicated site only. | |||||
| ## Scripts | |||||
| - `scripts/deploy-iis-git.ps1`: controller entry point; validates source, branch, XML, package structure, and safety; hashes and optionally transfers the package. | |||||
| - `scripts/install-iis-release.ps1`: elevated Windows PowerShell 5.1 host installer; performs read-only host preflight, stages and validates releases, creates/manages only the dedicated target, switches releases, smoke tests, and rolls back target mutations on failure. | |||||
| Gitea 1.11.4 predates Gitea Actions. Run the controller from a trusted external worker or operator workstation with approved Tailscale/OpenSSH access. No credentials or production configuration belong in this repository. | |||||
| ## Preflight sequence | |||||
| ### 1. Local/controller preflight (no network) | |||||
| Run from a clean standalone `master` checkout: | |||||
| ```powershell | |||||
| .\scripts\deploy-iis-git.ps1 -LocalPreflightOnly | |||||
| ``` | |||||
| This validates the dedicated names/binding/root, source provenance, required source files, repository `public\web.config` XML, package creation, extracted package layout, and reparse-point/symlink safety. It does not call SSH/SCP and makes no host change. `-AllowAnyBranch` is still required when the source is not a standalone Git checkout. | |||||
| `-DryRun` also avoids network access but prints the remote operation that would be performed. | |||||
| ### 2. Full preflight (connects, read-only) | |||||
| ```powershell | |||||
| .\scripts\deploy-iis-git.ps1 -PreflightOnly -RemoteTarget 'webserver-1' | |||||
| ``` | |||||
| After the local/package checks, the controller streams the installer over SSH and runs it in memory; it does not create a remote transport directory or copy a remote file. The host phase checks elevation, WebAdministration, Classic ASP feature/module, URL Rewrite module, deployment drive/path and resource names, binding conflicts (including wildcard IP overlap), shared-pool conflicts, and existing dedicated target consistency. The dedicated site and pool do not need to exist. No IIS or deployment-root change is made. `-HostPreflightOnly` and `-RemotePreflightOnly` remain aliases. | |||||
| ## First deployment | |||||
| The installer creates the dedicated app pool and site only after the staged release and selected initial `web.config` validate. Example using all defaults: | |||||
| ```powershell | |||||
| .\scripts\deploy-iis-git.ps1 -RemoteTarget 'webserver-1' | |||||
| ``` | |||||
| Example with explicit overrides: | |||||
| ```powershell | |||||
| .\scripts\deploy-iis-git.ps1 ` | |||||
| -SiteName 'AspClassicUnifiedFramework-Test' ` | |||||
| -AppPoolName 'AspClassicUnifiedFramework-Test' ` | |||||
| -DeployRoot 'E:\Deployments\AspClassicUnifiedFramework-Test' ` | |||||
| -BindingIpAddress '100.97.39.23' ` | |||||
| -BindingPort 8185 ` | |||||
| -HostHeader 'framework-test.internal' ` | |||||
| -InitialWebConfigPath 'E:\ManagedConfig\framework-test.web.config' ` | |||||
| -RemoteTarget 'webserver-1' ` | |||||
| -ExpectedBranch 'master' | |||||
| ``` | |||||
| The new app pool uses no managed CLR. Configure any required app-pool identity and ACL policy through separately reviewed host preparation; the deployment does not borrow another pool's identity or permissions. | |||||
| ## Existing target and cutover | |||||
| For later deployments, the host preflight requires the dedicated site to use: | |||||
| - exactly `AppPoolName`; | |||||
| - exactly one HTTP binding matching IP, port, and host header; | |||||
| - a physical path ending in `\public` under `<DeployRoot>\releases`. | |||||
| Any mismatch fails without mutation. After the new release validates, the installer changes only the dedicated site's physical path, applies the site-location parent-path setting, recycles/starts the dedicated pool, and smoke tests the configured binding or explicit `-BaseUrl`. | |||||
| ## Failure recovery | |||||
| The installer records whether this invocation created the target site or pool and snapshots the prior state of an existing valid target. | |||||
| - If target creation or smoke testing fails, it removes only the site/app pool created by this invocation. | |||||
| - If an existing target fails during cutover or smoke testing, it restores its previous physical path and previous site-location parent-path value, then restarts/recycles its pool. | |||||
| - It never removes or edits an unrelated site, pool, or binding. | |||||
| - Staging/release files may remain for diagnosis; releases are reported as retention candidates and are never deleted automatically. | |||||
| - Explicit database migrations cannot be undone by IIS rollback. | |||||
| ## Rollback | |||||
| ```powershell | |||||
| .\scripts\deploy-iis-git.ps1 ` | |||||
| -Rollback ` | |||||
| -RollbackTo '20260914-171500-a1b2c3d4e5f6' ` | |||||
| -RemoteTarget 'webserver-1' | |||||
| ``` | |||||
| Rollback requires an already valid dedicated target and an existing immutable release under the configured `DeployRoot`. It switches only that target's physical path and smoke tests; it does not rewrite the prior release. Failure restores the prior target state. | |||||
| ## Database and writable data | |||||
| Migrations are disabled by default. `-RunMigrations` is an explicit exception and requires a verified backup; path rollback cannot undo database changes. Keep production databases, logs, and other writable data outside immutable release directories and grant the dedicated app-pool identity only necessary permissions. | |||||
| ## Windows verification gates | |||||
| Before production use, validate both scripts with the Windows PowerShell 5.1 parser, run host preflight on the intended Windows/IIS host, deploy to an isolated test name/binding, verify HTTP and parent includes, induce a smoke failure to prove invocation-scoped cleanup/restoration, then prove rollback. Linux checks cannot validate WebAdministration behavior, installed IIS features/modules, binding semantics on the live host, elevation, ACLs, app-pool identity, Access/ACE, or an actual HTTP response. | |||||
| @@ -0,0 +1,55 @@ | |||||
| # MVC-Starter - Development Guide | |||||
| **Date:** 2026-03-11T11:59:39Z | |||||
| ## Prerequisites | |||||
| - Windows environment | |||||
| - IIS with Classic ASP enabled | |||||
| - IIS URL Rewrite module | |||||
| - Microsoft Access Database Engine | |||||
| - Windows Script Host (`cscript`) | |||||
| ## Local Setup | |||||
| 1. Place the project on a Windows machine with IIS. | |||||
| 2. Point the site root to `public/`. | |||||
| 3. Update `public/web.config` for the correct database and logging paths. | |||||
| 4. Browse to `/` and confirm the starter home page renders. | |||||
| ## Common Workflows | |||||
| ### Add a database-backed feature | |||||
| 1. Generate a migration | |||||
| 2. Generate POBO/repository | |||||
| 3. Move generated files into `app/models/` and `app/repositories/` | |||||
| 4. Generate a controller | |||||
| 5. Include the controller from `app/controllers/autoload_controllers.asp` | |||||
| 6. Register the controller in `core/lib.ControllerRegistry.asp` | |||||
| 7. Add routes in `public/Default.asp` | |||||
| 8. Add corresponding views in `app/views/` | |||||
| ### Useful Commands | |||||
| ```bat | |||||
| cscript //nologo scripts\generateMigration.vbs create_my_table | |||||
| cscript //nologo scripts\GenerateRepo.vbs /table:my_table /pk:id | |||||
| cscript //nologo scripts\generateController.vbs MyController "Index;Show(id)" | |||||
| cscript //nologo scripts\runMigrations.vbs status | |||||
| ``` | |||||
| ## Testing Approach | |||||
| - Manual runtime validation through IIS | |||||
| - Manual route/layout verification after controller or view changes | |||||
| - Script validation through `cscript` | |||||
| - No built-in automated test suite detected | |||||
| ## High-Risk Change Areas | |||||
| - `public/Default.asp` | |||||
| - `public/web.config` | |||||
| - `core/mvc.asp` | |||||
| - `core/lib.ControllerRegistry.asp` | |||||
| - shared layout files under `app/views/shared/` | |||||
| @@ -0,0 +1,59 @@ | |||||
| # Development Instructions | |||||
| **Date:** 2026-03-11T11:59:39Z | |||||
| ## Prerequisites | |||||
| - Windows Server or Windows development environment | |||||
| - IIS with Classic ASP enabled | |||||
| - IIS URL Rewrite module | |||||
| - Microsoft Access Database Engine for `.accdb` support | |||||
| - Windows Script Host / `cscript` | |||||
| ## Setup | |||||
| 1. Copy the project to the target IIS host. | |||||
| 2. Point the IIS site root to `public/`. | |||||
| 3. Update `public/web.config`: | |||||
| - `ConnectionString` | |||||
| - `ErrorLogPath` if logging is desired | |||||
| 4. Ensure the Access database file path is valid for the environment. | |||||
| ## Common Development Tasks | |||||
| ### Generate a migration | |||||
| ```bat | |||||
| cscript //nologo scripts\generateMigration.vbs create_my_table | |||||
| ``` | |||||
| ### Generate POBO and repository | |||||
| ```bat | |||||
| cscript //nologo scripts\GenerateRepo.vbs /table:my_table /pk:id | |||||
| ``` | |||||
| Move generated files into `app/models/` and `app/repositories/`. | |||||
| ### Generate a controller | |||||
| ```bat | |||||
| cscript //nologo scripts\generateController.vbs MyController "Index;Show(id);Create;Store" | |||||
| ``` | |||||
| Move the generated controller into `app/controllers/`. | |||||
| ### Activate a controller | |||||
| After generating a controller: | |||||
| 1. Include it from `app/controllers/autoload_controllers.asp` | |||||
| 2. Register it in `core/lib.ControllerRegistry.asp` | |||||
| 3. Add routes in `public/Default.asp` | |||||
| 4. Create corresponding views in `app/views/` | |||||
| ## Validation Approach | |||||
| - Manual browser validation is required for runtime changes. | |||||
| - Route/layout changes should be checked through IIS-hosted execution. | |||||
| - Migration and generator changes should be validated with `cscript`. | |||||
| @@ -0,0 +1,46 @@ | |||||
| # Existing Documentation Inventory | |||||
| **Date:** 2026-03-11T11:59:39Z | |||||
| ## Summary | |||||
| The project has a small set of directly relevant documentation files plus BMAD framework support files. For brownfield understanding, the highest-priority sources are the project README and a small number of repo-specific instruction files. | |||||
| ## Priority Documentation for Project Understanding | |||||
| ### `README.md` | |||||
| - **Type:** readme | |||||
| - **Path:** `/workspace/MVC-Starter/README.md` | |||||
| - **Scope:** whole project | |||||
| - **Notes:** Documents IIS setup, project structure, generator workflow, and baseline runtime requirements. | |||||
| ### `.github/copilot-instructions.md` | |||||
| - **Type:** project instructions | |||||
| - **Path:** `/workspace/MVC-Starter/.github/copilot-instructions.md` | |||||
| - **Scope:** whole project | |||||
| - **Notes:** Documents BMAD runtime conventions, config locations, workflow engine usage, and agent/runtime structure. | |||||
| ### `_bmad-output/project-context.md` | |||||
| - **Type:** generated ai-project-context | |||||
| - **Path:** `/workspace/MVC-Starter/_bmad-output/project-context.md` | |||||
| - **Scope:** whole project | |||||
| - **Notes:** Derivative documentation generated from workflow analysis. Useful for AI implementation rules, but not an original source of project design intent. | |||||
| ## BMAD Framework Documentation Assets | |||||
| - `.github/agents/*.md` and `.github/prompts/*.md` provide BMAD agent and prompt definitions. | |||||
| - `_bmad/` contains the installed BMAD framework, workflows, templates, and configuration. | |||||
| - These files are important for maintaining the BMAD layer, but they are secondary to the application docs when documenting the MVC starter itself. | |||||
| ## Generated Documentation in This Workflow Run | |||||
| - Files created under `docs/` by this workflow should be treated as generated brownfield documentation outputs, not original project-authored documents. | |||||
| ## Observations | |||||
| - No dedicated architecture, deployment, API, or data-model markdown docs existed for the application before this workflow run. | |||||
| - The README is the main human-authored source of project usage and structure. | |||||
| - Most other markdown assets in the repo belong to the BMAD toolchain rather than the Classic ASP application itself. | |||||
| @@ -0,0 +1,12 @@ | |||||
| Create and agents.md and claude.md so agents can use this repo to quickly develop applications | |||||
| to do : | |||||
| refactor so that classes and functions are wsl components that are unregistered and reregestered at application startup in the global.asa file | |||||
| we need a scrit that will turn classes and functions into wsl files that the code can call and use | |||||
| need to design classes with reflection in mind so that classes know about themselves and what they can do | |||||
| also need to desgin functions and methods with contract by design in mind so that errors can be trapped better | |||||
| @@ -0,0 +1,71 @@ | |||||
| # MVC-Starter Documentation Index | |||||
| **Type:** monolith | |||||
| **Primary Language:** VBScript / Classic ASP | |||||
| **Architecture:** Server-rendered MVC monolith | |||||
| **Last Updated:** 2026-03-11T11:59:39Z | |||||
| ## Project Overview | |||||
| MVC-Starter is a RouteKit Classic ASP starter application for Windows IIS. It uses a single front controller, shared runtime/framework libraries, server-rendered views, an Access database, and VBScript-based scaffolding tools. | |||||
| ## Quick Reference | |||||
| - **Tech Stack:** Classic ASP, VBScript, IIS, Access, Bootstrap | |||||
| - **Entry Point:** `public/Default.asp` | |||||
| - **Architecture Pattern:** Starter/framework hybrid MVC monolith | |||||
| - **Database:** `db/webdata.accdb` via ACE OLE DB | |||||
| - **Deployment:** Manual IIS deployment | |||||
| ## Generated Documentation | |||||
| ### Core Documentation | |||||
| - [Project Overview](./project-overview.md) - Executive summary and high-level architecture | |||||
| - [Project Structure](./project-structure.md) - Classification and structural boundaries | |||||
| - [Source Tree Analysis](./source-tree-analysis.md) - Annotated directory structure | |||||
| - [Architecture](./architecture.md) - Detailed technical architecture | |||||
| - [Architecture Patterns](./architecture-patterns.md) - Runtime and design patterns | |||||
| - [Technology Stack](./technology-stack.md) - Stack inventory and justification | |||||
| - [Component Inventory](./component-inventory.md) - Runtime, UI, and tooling components | |||||
| - [Development Guide](./development-guide.md) - Setup and common workflows | |||||
| - [Deployment Guide](./deployment-guide.md) - IIS deployment and config guidance | |||||
| - [API Contracts](./api-contracts-mvc-starter.md) - HTTP route contracts | |||||
| - [Data Models](./data-models-mvc-starter.md) - Current data/model state and strategy | |||||
| ### Supporting Analysis | |||||
| - [Existing Documentation Inventory](./existing-documentation-inventory.md) | |||||
| - [User-Provided Context](./user-provided-context.md) | |||||
| - [State Management Patterns](./state-management-patterns-mvc-starter.md) | |||||
| - [UI Component Inventory](./ui-component-inventory-mvc-starter.md) | |||||
| - [Comprehensive Analysis](./comprehensive-analysis-mvc-starter.md) | |||||
| - [Critical Folders Summary](./critical-folders-summary.md) | |||||
| - [Development Instructions](./development-instructions.md) | |||||
| - [Deployment Configuration](./deployment-configuration.md) | |||||
| - [Project Parts Metadata](./project-parts.json) | |||||
| - [Project Scan State](./project-scan-report.json) | |||||
| ## Existing Documentation | |||||
| - [README.md](../README.md) - Setup, structure, and feature scaffolding workflow | |||||
| - [.github/copilot-instructions.md](../.github/copilot-instructions.md) - BMAD/Copilot repo instructions | |||||
| - [_bmad-output/project-context.md](../_bmad-output/project-context.md) - Generated AI implementation context | |||||
| ## Getting Started | |||||
| ### For Humans | |||||
| 1. Read [project-overview.md](./project-overview.md) | |||||
| 2. Review [architecture.md](./architecture.md) | |||||
| 3. Use [development-guide.md](./development-guide.md) for feature work | |||||
| ### For AI-Assisted Development | |||||
| - Start from this index | |||||
| - Use [architecture.md](./architecture.md) and [project-context.md](../_bmad-output/project-context.md) together | |||||
| - Reference [api-contracts-mvc-starter.md](./api-contracts-mvc-starter.md) and [data-models-mvc-starter.md](./data-models-mvc-starter.md) for route/data planning | |||||
| --- | |||||
| Documentation generated by BMAD `document-project`. | |||||
| @@ -0,0 +1,70 @@ | |||||
| # MVC-Starter - Project Overview | |||||
| **Date:** 2026-03-11T11:59:39Z | |||||
| **Type:** web | |||||
| **Architecture:** Server-rendered MVC monolith | |||||
| ## Executive Summary | |||||
| MVC-Starter is a RouteKit Classic ASP starter for building server-rendered MVC applications on Windows IIS. It combines a shared framework/runtime layer in `core/` with application-specific controllers and views in `app/`, and supports database-backed features through Access and VBScript-based scaffolding. | |||||
| ## Project Classification | |||||
| - **Repository Type:** monolith | |||||
| - **Project Type(s):** web | |||||
| - **Primary Language(s):** VBScript, Classic ASP | |||||
| - **Architecture Pattern:** Starter/framework hybrid MVC monolith | |||||
| ## Technology Stack Summary | |||||
| - Runtime: Classic ASP on IIS | |||||
| - Routing/dispatch: RouteKit-style router and MVC dispatcher | |||||
| - Data: ADO + Microsoft Access | |||||
| - UI: Bootstrap CDN + server-rendered ASP views | |||||
| - Tooling: Windows Script Host VBScript scripts | |||||
| ## Key Features | |||||
| - Front-controller request flow through `public/Default.asp` | |||||
| - Controller whitelist and dynamic dispatch in `core/mvc.asp` | |||||
| - Shared header/footer layout for page rendering | |||||
| - Generator-assisted migrations, repositories, and controllers | |||||
| - Included starter pages for home and 404 handling | |||||
| ## Architecture Highlights | |||||
| - Single deployable web app | |||||
| - Clear split between runtime/framework code and app-specific code | |||||
| - Config-driven behavior through `public/web.config` | |||||
| - Manual but structured development workflow through scripts and route/controller wiring | |||||
| ## Development Overview | |||||
| ### Prerequisites | |||||
| - Windows + IIS + Classic ASP | |||||
| - IIS URL Rewrite | |||||
| - Microsoft Access Database Engine | |||||
| - `cscript` for tooling | |||||
| ### Getting Started | |||||
| Point IIS at `public/`, update `public/web.config`, then validate the home page loads. Use the provided VBScript generators to create migrations, repositories, and controllers for new features. | |||||
| ### Key Commands | |||||
| - **Generate migration:** `cscript //nologo scripts\generateMigration.vbs create_my_table` | |||||
| - **Generate repo:** `cscript //nologo scripts\GenerateRepo.vbs /table:my_table /pk:id` | |||||
| - **Generate controller:** `cscript //nologo scripts\generateController.vbs MyController "Index;Show(id)"` | |||||
| - **Run migrations:** `cscript //nologo scripts\runMigrations.vbs status` | |||||
| ## Repository Structure | |||||
| `public/` is the web entry surface, `core/` is the framework/runtime layer, `app/` is the application layer, `db/` contains database assets, and `scripts/` contains operational tooling. | |||||
| ## Documentation Map | |||||
| - [index.md](./index.md) | |||||
| - [architecture.md](./architecture.md) | |||||
| - [source-tree-analysis.md](./source-tree-analysis.md) | |||||
| - [development-guide.md](./development-guide.md) | |||||
| @@ -0,0 +1,26 @@ | |||||
| { | |||||
| "repository_type": "monolith", | |||||
| "parts": [ | |||||
| { | |||||
| "part_id": "mvc-starter", | |||||
| "part_name": "MVC-Starter", | |||||
| "root_path": "/workspace/MVC-Starter", | |||||
| "project_type_id": "web", | |||||
| "runtime_shape": "server-rendered-mvc-monolith", | |||||
| "hosting_assumption": "Windows IIS with URL Rewrite", | |||||
| "entry_point": "public/Default.asp", | |||||
| "framework_runtime_path": "core/", | |||||
| "application_surface_path": "app/", | |||||
| "operational_support_paths": [ | |||||
| "db/", | |||||
| "scripts/" | |||||
| ], | |||||
| "primary_technologies": [ | |||||
| "Classic ASP", | |||||
| "VBScript", | |||||
| "IIS", | |||||
| "Microsoft Access" | |||||
| ] | |||||
| } | |||||
| ] | |||||
| } | |||||
| @@ -0,0 +1 @@ | |||||
| {"workflow_version":"1.2.0","timestamps":{"started":"2026-03-11T11:59:39Z","last_updated":"2026-03-11T12:13:30Z","completed":"2026-03-11T12:13:30Z"},"mode":"initial_scan","scan_level":"exhaustive","project_root":"/workspace/MVC-Starter","project_knowledge":"/workspace/MVC-Starter/docs","completed_steps":[{"step":"step_1","status":"completed","timestamp":"2026-03-11T12:03:40Z","summary":"Classified as monolith with 1 part; detected Classic ASP MVC web application hosted via IIS entrypoint in public/Default.asp"},{"step":"step_2","status":"completed","timestamp":"2026-03-11T12:06:06Z","summary":"Inventoried 3 relevant existing documentation files and recorded no additional user focus areas"},{"step":"step_3","status":"completed","timestamp":"2026-03-11T12:09:06Z","summary":"Analyzed technology stack and architecture pattern as Classic ASP/VBScript MVC monolith on IIS with Access and VBScript tooling"},{"step":"step_4","status":"completed","timestamp":"2026-03-11T12:12:40Z","summary":"Completed exhaustive conditional analysis and generated API, data, state, UI, and comprehensive analysis documents"},{"step":"step_5","status":"completed","timestamp":"2026-03-11T12:12:55Z","summary":"Generated source tree analysis and critical folders summary"},{"step":"step_6","status":"completed","timestamp":"2026-03-11T12:13:05Z","summary":"Generated development instructions and deployment configuration documentation"},{"step":"step_8","status":"completed","timestamp":"2026-03-11T12:13:10Z","summary":"Generated architecture.md for the single application part"},{"step":"step_9","status":"completed","timestamp":"2026-03-11T12:13:15Z","summary":"Generated supporting overview, component, development, deployment, and index-adjacent docs"},{"step":"step_10","status":"completed","timestamp":"2026-03-11T12:13:20Z","summary":"Generated master index with complete links and no incomplete markers"},{"step":"step_11","status":"completed","timestamp":"2026-03-11T12:13:25Z","summary":"Validated generated docs, found no incomplete documentation markers"},{"step":"step_12","status":"completed","timestamp":"2026-03-11T12:13:30Z","summary":"Workflow complete"}],"current_step":"completed","findings":{"project_classification":"monolith, 1 part, Classic ASP/VBScript web application","existing_documentation":"3 relevant docs found; README, Copilot instructions, and generated project context","technology_stack":"Classic ASP/VBScript on IIS with Access, RouteKit-style MVC runtime, Bootstrap CDN, and VBScript tooling","batch_summaries":["Application routes, controllers, views, and shared layout documented from app/ and public/","Runtime and framework behavior documented from core/","Database and operational tooling documented from db/ and scripts/"]},"project_types":[{"part_id":"mvc-starter","project_type_id":"web","display_name":"web"}],"outputs_generated":["project-scan-report.json","project-structure.md","project-parts.json","existing-documentation-inventory.md","user-provided-context.md","technology-stack.md","architecture-patterns.md","api-contracts-mvc-starter.md","data-models-mvc-starter.md","state-management-patterns-mvc-starter.md","ui-component-inventory-mvc-starter.md","comprehensive-analysis-mvc-starter.md","source-tree-analysis.md","critical-folders-summary.md","development-instructions.md","deployment-configuration.md","architecture.md","project-overview.md","component-inventory.md","development-guide.md","deployment-guide.md","index.md"],"resume_instructions":"Workflow complete. Start a fresh scan only if the project changes materially.","verification_summary":"Exhaustive file-system scan of app/core/public/scripts/db; extracted runtime config, routes, controllers, views, and tooling docs; checked docs for incomplete markers; no IIS runtime tests executed.","open_risks":"Documentation is based on static code/config analysis in this Linux workspace; Windows IIS runtime behavior, Access connectivity, and script execution were not validated live.","next_checks":"Review docs/index.md, validate the app on a Windows IIS host, confirm web.config paths, and regenerate docs after adding real models/repositories/migrations."} | |||||
| @@ -0,0 +1,38 @@ | |||||
| # MVC-Starter Project Structure | |||||
| **Date:** 2026-03-11T11:59:39Z | |||||
| **Repository Type:** monolith | |||||
| **Detected Project Type:** web | |||||
| **Specific Runtime Shape:** Classic ASP server-rendered MVC starter on Windows IIS | |||||
| **Primary Technologies:** Classic ASP, VBScript, IIS, Microsoft Access | |||||
| ## Classification Summary | |||||
| This repository is a single deployable web application, not a multi-part client/server system. It is a server-rendered Classic ASP MVC starter with: | |||||
| - `public/` as the IIS web root and deploy entrypoint | |||||
| - `core/` as shared framework/runtime code | |||||
| - `app/` as the application extension surface for controllers, views, models, and repositories | |||||
| - `db/` as database and migration support | |||||
| - `scripts/` as scaffolding and operational tooling | |||||
| ## Detected Part | |||||
| ### MVC-Starter | |||||
| - **Root Path:** `/workspace/MVC-Starter` | |||||
| - **Project Type:** web | |||||
| - **Runtime Shape:** Server-rendered MVC monolith | |||||
| - **Hosting Assumption:** Windows IIS with URL Rewrite | |||||
| - **Deploy Entry Point:** `public/Default.asp` | |||||
| - **Framework Runtime:** `core/` | |||||
| - **Application Extension Surface:** `app/` | |||||
| - **Operational Support Directories:** `db/`, `scripts/` | |||||
| ## Why This Classification Fits | |||||
| - The repository exposes a single web entrypoint through `public/Default.asp` and IIS rewrite config in `public/web.config`. | |||||
| - Request handling flows through `public/` into framework code in `core/`, while application behavior is implemented in `app/`. | |||||
| - Request handling, view rendering, routing, data access, and framework runtime are all contained in one application tree. | |||||
| - There are no separate client/server packages, independent deployables, or service boundaries that would justify multi-part classification. | |||||
| - The repo structure matches a classic server-rendered MVC application rather than a frontend/backend split web stack. | |||||
| @@ -0,0 +1,100 @@ | |||||
| # MVC-Starter - Source Tree Analysis | |||||
| **Date:** 2026-03-11T11:59:39Z | |||||
| ## Overview | |||||
| The repository is organized as a Classic ASP MVC starter with a clear split between deploy entry, shared runtime, application code, database assets, and operational tooling. | |||||
| ## Complete Directory Structure | |||||
| ```text | |||||
| MVC-Starter/ | |||||
| ├── app/ # Application-specific MVC layer | |||||
| │ ├── controllers/ # Controllers and controller includes | |||||
| │ ├── models/ # Intended POBO/model location (currently empty) | |||||
| │ ├── repositories/ # Intended repository location (currently empty) | |||||
| │ └── views/ # Server-rendered ASP views | |||||
| │ ├── Error/ | |||||
| │ ├── Home/ | |||||
| │ └── shared/ | |||||
| ├── core/ # Framework/runtime libraries and dispatcher | |||||
| ├── db/ # Database file and future migrations | |||||
| │ ├── migrations/ | |||||
| │ └── webdata.accdb | |||||
| ├── docs/ # Generated brownfield documentation | |||||
| ├── public/ # IIS web root and request entrypoint | |||||
| │ ├── Default.asp | |||||
| │ └── web.config | |||||
| ├── scripts/ # Scaffolding and migration tooling | |||||
| ├── _bmad/ # Installed BMAD framework assets | |||||
| ├── _bmad-output/ # Generated BMAD workflow artifacts | |||||
| └── .github/ # Copilot/BMAD prompt and agent support files | |||||
| ``` | |||||
| ## Critical Directories | |||||
| ### `public/` | |||||
| Purpose: deploy-facing web root and request bootstrap. | |||||
| - Contains the front controller `Default.asp` | |||||
| - Contains `web.config` with rewrite and runtime config | |||||
| - Entry point for all non-static requests | |||||
| ### `core/` | |||||
| Purpose: shared framework/runtime layer. | |||||
| - Contains dispatcher, router, controller registry, helpers, DAL, migrations, flash helpers, and utility libraries | |||||
| - High-blast-radius area for architectural changes | |||||
| ### `app/` | |||||
| Purpose: project-specific extension surface. | |||||
| - `controllers/` contains active controllers and include registration | |||||
| - `views/` contains page templates and shared layout files | |||||
| - `models/` and `repositories/` are intended generator targets | |||||
| ### `db/` | |||||
| Purpose: database storage and schema evolution support. | |||||
| - Includes `webdata.accdb` | |||||
| - Includes `migrations/` directory for migration files | |||||
| ### `scripts/` | |||||
| Purpose: development and operations support tooling. | |||||
| - Controller generator | |||||
| - Repository/POBO generator | |||||
| - Migration generator | |||||
| - Migration runner | |||||
| ## Entry Points | |||||
| - Main request entry: `public/Default.asp` | |||||
| - Runtime bootstrap: `core/autoload_core.asp` | |||||
| - MVC dispatcher: `core/mvc.asp` | |||||
| - Migration tooling entry: `scripts/runMigrations.vbs` | |||||
| ## Configuration Files | |||||
| - `public/web.config` - IIS routing and runtime application settings | |||||
| - `README.md` - setup and workflow guidance | |||||
| - `.github/copilot-instructions.md` - BMAD/Copilot workflow guidance for repo maintenance | |||||
| ## File Organization Patterns | |||||
| - Request handling starts in `public/`, not `app/` | |||||
| - Shared reusable runtime code lives in `core/` | |||||
| - Feature-specific behavior belongs in `app/` | |||||
| - Operational scripts live outside the runtime in `scripts/` | |||||
| - Generated documentation is isolated under `docs/` | |||||
| ## Development Notes | |||||
| - This structure assumes IIS deployment with `public/` as the site root. | |||||
| - Future application growth is expected to add controllers, views, models, repositories, and migrations without changing the overall directory shape. | |||||
| @@ -0,0 +1,26 @@ | |||||
| # State Management Patterns - MVC-Starter | |||||
| **Date:** 2026-03-11T11:59:39Z | |||||
| ## Overview | |||||
| This project does not implement client-side application state management in the SPA sense. State is primarily handled on the server/request side through controller properties, request data, and helper libraries. | |||||
| ## Observed Patterns | |||||
| - **Request-scoped flow:** Incoming requests are routed and dispatched per request through `public/Default.asp` and `core/mvc.asp`. | |||||
| - **Controller-held page state:** Controllers expose simple properties such as `useLayout` and `Title` to influence rendering behavior. | |||||
| - **Flash messaging:** Shared layout calls `Flash().ShowErrorsIfPresent` and `Flash().ShowSuccessIfPresent`, indicating transient server-side UI messaging. | |||||
| - **Configuration-driven behavior:** Runtime flags and UI behavior are sourced from `public/web.config` via `GetAppSetting`. | |||||
| - **Form/cache helpers available:** `core/lib.FormCache.asp` and related helpers suggest server-side request/form support patterns. | |||||
| ## What Is Not Present | |||||
| - No Redux, Context API, Vuex, MobX, Zustand, or similar client-state library | |||||
| - No SPA store layer | |||||
| - No separate API/client state synchronization layer | |||||
| ## Brownfield Notes | |||||
| - Treat this app as server-rendered and request-driven. | |||||
| - If richer client-side interactivity is added later, it will be a new architectural layer rather than an extension of an existing state-management system. | |||||
| @@ -0,0 +1,28 @@ | |||||
| # Technology Stack | |||||
| **Date:** 2026-03-11T11:59:39Z | |||||
| ## Part: MVC-Starter | |||||
| | Category | Technology | Version / Variant | Justification | | |||||
| |---|---|---|---| | |||||
| | Runtime | Classic ASP | legacy IIS-hosted runtime | Request entrypoint is `public/Default.asp`, with `.asp` controllers, views, and framework files across `app/` and `core/`. | | |||||
| | Language | VBScript | Classic ASP server-side VBScript | Controllers, framework code, helpers, and operational scripts are written in VBScript. | | |||||
| | Web Server | IIS | Windows IIS with URL Rewrite | `public/web.config` configures default document behavior and rewrite rules to route requests through `Default.asp`. | | |||||
| | MVC Framework | RouteKit Classic ASP | project-local framework/starter | README identifies RouteKit Classic ASP; routing and dispatch are implemented by `router.wsc`, `core/mvc.asp`, and controller registry logic. | | |||||
| | Routing | RouteKit router + IIS rewrite | custom runtime routing | `router.AddRoute` is used in `public/Default.asp`, and incoming requests are rewritten by IIS before dispatch. | | |||||
| | Data Access | ADO / OLE DB | Classic ASP ADODB stack | DAL and repository generation rely on ADO connections and Classic ASP data access libraries. | | |||||
| | Database | Microsoft Access | `Microsoft.ACE.OLEDB.12.0` provider | `public/web.config` configures an `.accdb` connection string; `db/webdata.accdb` is included in the repo. | | |||||
| | Database Migration | Custom VBScript migration runner | project-local | `scripts/runMigrations.vbs` manages migration application, rollback, and status outside IIS. | | |||||
| | UI Framework | Bootstrap | 5.3.3 | Shared header loads Bootstrap CSS and JS from CDN for layout and components. | | |||||
| | Icon Library | Bootstrap Icons | 1.11.3 | Shared header loads Bootstrap Icons from CDN. | | |||||
| | Frontend Rendering | Server-rendered HTML views | Classic ASP include-based rendering | Controllers include `.asp` view files, with shared header/footer layout wrapping page content. | | |||||
| | Tooling | Windows Script Host VBScript scripts | project-local generators | `scripts/generateController.vbs`, `GenerateRepo.vbs`, `generateMigration.vbs`, and `runMigrations.vbs` drive scaffolding and DB workflow. | | |||||
| | Configuration | IIS `web.config` + appSettings | XML-based runtime config | Connection strings, environment flags, cache settings, flash timing, and other behavior are driven from `public/web.config`. | | |||||
| ## Stack Notes | |||||
| - This is a server-rendered web app, not a separate frontend/backend split stack. | |||||
| - The repo has no `package.json`, `requirements.txt`, or other modern package manifest for the application itself. | |||||
| - Frontend assets are primarily CDN-hosted Bootstrap resources plus local static assets served from `public/`. | |||||
| - Development and operational tooling assume a Windows environment with IIS and Windows Script Host. | |||||
| @@ -0,0 +1,50 @@ | |||||
| # UI Component Inventory - MVC-Starter | |||||
| **Date:** 2026-03-11T11:59:39Z | |||||
| ## Overview | |||||
| The current UI surface is small and server-rendered. Reuse is primarily achieved through shared layout files and Bootstrap utility/component classes rather than a formal component library. | |||||
| ## Shared UI Surfaces | |||||
| ### Shared Layout | |||||
| - `app/views/shared/header.asp` | |||||
| - Sets page charset/codepage | |||||
| - Resolves the page title from `CurrentController.Title` | |||||
| - Loads Bootstrap 5.3.3 and Bootstrap Icons 1.11.3 from CDN | |||||
| - Renders the top navigation shell | |||||
| - Displays flash error/success messages | |||||
| - `app/views/shared/footer.asp` | |||||
| - Closes the main layout wrapper | |||||
| - Loads the Bootstrap JS bundle from CDN | |||||
| ## Feature Views | |||||
| ### Home View | |||||
| - `app/views/Home/index.asp` | |||||
| - Welcome/placeholder landing page | |||||
| - Uses Bootstrap cards, grid, typography, and code snippets | |||||
| - Documents where new controllers, repositories, and views belong | |||||
| ### Error View | |||||
| - `app/views/Error/NotFound.asp` | |||||
| - 404 page with countdown redirect behavior | |||||
| - Uses Bootstrap card layout and iconography | |||||
| - Reads redirect timing from config via `GetAppSetting("Error404RedirectSeconds")` | |||||
| ## Reusable UI Patterns | |||||
| - Shared header/footer layout wrapping | |||||
| - Bootstrap-based cards and grid layout | |||||
| - Config-driven flash messages in shared layout | |||||
| - Simple server-rendered page title convention via controller property | |||||
| ## Brownfield Notes | |||||
| - Reuse is currently layout-oriented, not component-library oriented. | |||||
| - New UI work will likely create additional `.asp` view files under `app/views/` rather than reusable frontend components in a JS framework. | |||||
| @@ -0,0 +1,13 @@ | |||||
| # User-Provided Context | |||||
| **Date:** 2026-03-11T11:59:39Z | |||||
| No additional documents, paths, or focus areas were provided by the user for this documentation run. | |||||
| ## Implication for This Scan | |||||
| The scan should prioritize: | |||||
| - the main application structure under `public/`, `core/`, `app/`, `db/`, and `scripts/` | |||||
| - existing first-party guidance in `README.md` | |||||
| - BMAD-related project instructions only where they affect project understanding or AI-assisted maintenance | |||||
| @@ -0,0 +1,42 @@ | |||||
| <!--#include file="..\core\autoload_core.asp" --> | |||||
| <% | |||||
| ' Define starter application routes | |||||
| router.AddRoute "GET", "/home", "TodayController", "Index" | |||||
| router.AddRoute "GET", "/", "TodayController", "Index" | |||||
| router.AddRoute "GET", "", "TodayController", "Index" | |||||
| router.AddRoute "GET", "/404", "ErrorController", "NotFound" | |||||
| ' Today (follow-up queue) | |||||
| router.AddRoute "GET", "/today", "TodayController", "Index" | |||||
| ' Dashboard (counts) | |||||
| router.AddRoute "GET", "/dashboard", "DashboardController", "Index" | |||||
| ' Businesses | |||||
| router.AddRoute "GET", "/businesses", "BusinessesController", "Index" | |||||
| router.AddRoute "GET", "/businesses/:id", "BusinessesController", "Show" | |||||
| router.AddRoute "POST", "/businesses/:id/update", "BusinessesController", "Update" | |||||
| router.AddRoute "POST", "/businesses/:id/log", "BusinessesController", "Log" | |||||
| router.AddRoute "POST", "/businesses/:id/remove", "BusinessesController", "Remove" | |||||
| router.AddRoute "POST", "/businesses/:id/restore", "BusinessesController", "Restore" | |||||
| ' Industries | |||||
| router.AddRoute "GET", "/industries", "IndustriesController", "Index" | |||||
| router.AddRoute "POST", "/industries/create", "IndustriesController", "Create" | |||||
| router.AddRoute "POST", "/industries/:id/rename", "IndustriesController", "Rename" | |||||
| router.AddRoute "POST", "/industries/:id/merge", "IndustriesController", "Merge" | |||||
| router.AddRoute "POST", "/industries/:id/delete", "IndustriesController", "Delete" | |||||
| ' Export (CSV download) | |||||
| router.AddRoute "GET", "/export/businesses", "ExportController", "Businesses" | |||||
| ' Import | |||||
| router.AddRoute "GET", "/import", "ImportController", "Index" | |||||
| router.AddRoute "POST", "/import/upload", "ImportController", "Upload" | |||||
| router.AddRoute "POST", "/import/run", "ImportController", "Run" | |||||
| ' Dispatch the request (resolves route and executes controller action) | |||||
| MVC.DispatchRequest Request.ServerVariables("REQUEST_METHOD"), _ | |||||
| TrimQueryParams(Request.ServerVariables("HTTP_X_ORIGINAL_URL")) | |||||
| %> | |||||
| @@ -0,0 +1,70 @@ | |||||
| <?xml version="1.0" encoding="UTF-8"?> | |||||
| <configuration> | |||||
| <appSettings> | |||||
| <!-- | |||||
| Access connection string. | |||||
| IMPORTANT: Change Data Source to the real physical path | |||||
| to your webdata.accdb file. | |||||
| --> | |||||
| <add key="ConnectionString" | |||||
| value="Provider=Microsoft.ACE.OLEDB.16.0;Data Source=D:\Development\ASP CLASSIC\Prospecting\db\webdata.accdb;Persist Security Info=False;" /> | |||||
| <!-- Environment flag (Development / Staging / Production) --> | |||||
| <add key="Environment" value="Development" /> | |||||
| <!-- Flash message display duration in milliseconds --> | |||||
| <add key="FlashMessageTimeout" value="3000" /> | |||||
| <!-- 404 error page redirect countdown in seconds --> | |||||
| <add key="Error404RedirectSeconds" value="5" /> | |||||
| <!-- Cache expiration year for static content --> | |||||
| <add key="CacheExpirationYear" value="2030" /> | |||||
| <!-- Maximum characters to display in table cells before truncating --> | |||||
| <add key="TableCellMaxLength" value="90" /> | |||||
| <!-- Character threshold for textarea vs input field in forms --> | |||||
| <add key="FormTextareaThreshold" value="100" /> | |||||
| <!-- Enable error logging to file (true/false) --> | |||||
| <add key="EnableErrorLogging" value="false" /> | |||||
| <!-- Error log file path (if EnableErrorLogging is true) --> | |||||
| <add key="ErrorLogPath" value="D:\Development\ASP CLASSIC\Prospecting\logs\errors.log" /> | |||||
| <!-- Enable cache-busting for URLs and assets (true/false) --> | |||||
| <add key="EnableCacheBusting" value="false" /> | |||||
| <!-- Cache-bust parameter name (default: "v") --> | |||||
| <add key="CacheBustParamName" value="v" /> | |||||
| </appSettings> | |||||
| <system.webServer> | |||||
| <!-- Default document for the site root --> | |||||
| <defaultDocument> | |||||
| <files> | |||||
| <clear /> | |||||
| <add value="Default.asp" /> | |||||
| </files> | |||||
| </defaultDocument> | |||||
| <!-- URL Rewrite: send everything through Default.asp except static assets --> | |||||
| <rewrite> | |||||
| <rules> | |||||
| <rule name="Rewrite to Default.asp" stopProcessing="true"> | |||||
| <match url="^(?!Default\.asp$|css/|js/|images/|aspunit/|favicon\.ico$).*$" /> | |||||
| <conditions> | |||||
| <add input="{REQUEST_FILENAME}" matchType="IsFile" negate="true" /> | |||||
| <add input="{REQUEST_FILENAME}" matchType="IsDirectory" negate="true" /> | |||||
| </conditions> | |||||
| <action type="Rewrite" url="/Default.asp" /> | |||||
| </rule> | |||||
| </rules> | |||||
| </rewrite> | |||||
| </system.webServer> | |||||
| </configuration> | |||||
| @@ -0,0 +1,4 @@ | |||||
| @echo off | |||||
| setlocal | |||||
| set "ASPC_STARTER_ROOT=%~dp0" | |||||
| "C:\Program Files (x86)\IIS Express\iisexpress.exe" /config:"%~dp0applicationhost.config" | |||||
| @@ -0,0 +1,637 @@ | |||||
| '============================================================== | |||||
| ' 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 | |||||
| @@ -0,0 +1,69 @@ | |||||
| '======================================================================================================================= | |||||
| ' CREATE DATABASE (Standalone VBScript, ADOX) | |||||
| '======================================================================================================================= | |||||
| ' Creates a new, empty Access (.accdb) database using ADOX. | |||||
| ' | |||||
| ' Usage: | |||||
| ' cscript //nologo scripts\createDatabase.vbs [path] [/force] | |||||
| ' | |||||
| ' Defaults to db\webdata.accdb under the project root. Refuses to overwrite an existing file unless /force is given. | |||||
| ' Requires the Microsoft Access Database Engine (ACE OLEDB 12.0 or 16.0) matching the bitness of cscript.exe. | |||||
| ' | |||||
| Option Explicit | |||||
| Dim fso, scriptDir, projectRoot, dbPath, force, i, arg | |||||
| Dim providers, p, cat, created, lastErr | |||||
| Set fso = CreateObject("Scripting.FileSystemObject") | |||||
| scriptDir = fso.GetParentFolderName(WScript.ScriptFullName) | |||||
| projectRoot = fso.GetAbsolutePathName(scriptDir & "\..") | |||||
| dbPath = projectRoot & "\db\webdata.accdb" | |||||
| force = False | |||||
| For i = 0 To WScript.Arguments.Count - 1 | |||||
| arg = WScript.Arguments(i) | |||||
| If LCase(arg) = "/force" Then | |||||
| force = True | |||||
| Else | |||||
| dbPath = fso.GetAbsolutePathName(arg) | |||||
| End If | |||||
| Next | |||||
| If fso.FileExists(dbPath) Then | |||||
| If Not force Then | |||||
| WScript.Echo "Error: " & dbPath & " already exists. Use /force to overwrite." | |||||
| WScript.Quit 1 | |||||
| End If | |||||
| fso.DeleteFile dbPath, True | |||||
| End If | |||||
| If Not fso.FolderExists(fso.GetParentFolderName(dbPath)) Then | |||||
| fso.CreateFolder fso.GetParentFolderName(dbPath) | |||||
| End If | |||||
| providers = Array("Microsoft.ACE.OLEDB.16.0", "Microsoft.ACE.OLEDB.12.0") | |||||
| created = False | |||||
| lastErr = "" | |||||
| For Each p In providers | |||||
| On Error Resume Next | |||||
| Set cat = CreateObject("ADOX.Catalog") | |||||
| cat.Create "Provider=" & p & ";Data Source=" & dbPath & ";" | |||||
| If Err.Number = 0 Then | |||||
| created = True | |||||
| Else | |||||
| lastErr = p & ": " & Err.Description | |||||
| End If | |||||
| Err.Clear | |||||
| On Error GoTo 0 | |||||
| Set cat = Nothing | |||||
| If created Then | |||||
| WScript.Echo "Created " & dbPath & " using " & p | |||||
| Exit For | |||||
| End If | |||||
| Next | |||||
| If Not created Then | |||||
| WScript.Echo "Error: could not create database. " & lastErr | |||||
| WScript.Quit 1 | |||||
| End If | |||||
| @@ -0,0 +1,320 @@ | |||||
| <# | |||||
| .SYNOPSIS | |||||
| Validates, packages, and deploys this repository to its dedicated IIS site. | |||||
| .DESCRIPTION | |||||
| The controller packages the complete repository, computes SHA-256, transfers | |||||
| the package and host installer over OpenSSH, and invokes the installer. | |||||
| -LocalPreflightOnly validates source provenance, XML, package layout, and | |||||
| archive safety without connecting. -PreflightOnly additionally streams the | |||||
| installer to the host and runs its read-only IIS preflight without writing a | |||||
| remote installer or package. | |||||
| #> | |||||
| [CmdletBinding()] | |||||
| param( | |||||
| [ValidatePattern('^[A-Za-z0-9_. -]+$')] | |||||
| [string]$SiteName = 'AspClassicUnifiedFramework', | |||||
| [ValidatePattern('^[A-Za-z0-9_. -]+$')] | |||||
| [string]$AppPoolName = 'AspClassicUnifiedFramework', | |||||
| [string]$DeployRoot = 'D:\Deployments\AspClassicUnifiedFramework', | |||||
| [string]$BindingIpAddress = '100.97.39.23', | |||||
| [ValidateRange(1, 65535)] | |||||
| [int]$BindingPort = 8085, | |||||
| [AllowEmptyString()] | |||||
| [string]$HostHeader = '', | |||||
| [string]$InitialWebConfigPath = '', | |||||
| [string]$RemoteTarget = 'webserver-1', | |||||
| [ValidateRange(1, 65535)] | |||||
| [int]$RemotePort = 22, | |||||
| [string]$SourcePath = (Split-Path $PSScriptRoot -Parent), | |||||
| [string]$BaseUrl = '', | |||||
| [string]$ReleaseId = '', | |||||
| [string]$ExpectedBranch = 'master', | |||||
| [ValidateRange(2, 100)] | |||||
| [int]$KeepReleases = 5, | |||||
| [string]$SshExe = 'ssh', | |||||
| [string]$ScpExe = 'scp', | |||||
| [switch]$AllowAnyBranch, | |||||
| [switch]$AllowDirty, | |||||
| [switch]$RunMigrations, | |||||
| [switch]$SkipSmokeTest, | |||||
| [Alias('HostPreflightOnly', 'RemotePreflightOnly')] | |||||
| [switch]$PreflightOnly, | |||||
| [switch]$LocalPreflightOnly, | |||||
| [switch]$Rollback, | |||||
| [string]$RollbackTo = '', | |||||
| [switch]$DryRun, | |||||
| [switch]$KeepPackage | |||||
| ) | |||||
| Set-StrictMode -Version 2.0 | |||||
| $ErrorActionPreference = 'Stop' | |||||
| function Write-Step { param([string]$Message) Write-Host ('==> ' + $Message) } | |||||
| function Assert-Command { | |||||
| param([string]$Name) | |||||
| if (-not (Get-Command $Name -ErrorAction SilentlyContinue)) { | |||||
| throw "$Name was not found on PATH." | |||||
| } | |||||
| } | |||||
| function ConvertTo-SingleQuotedPowerShell { | |||||
| param([string]$Value) | |||||
| return "'" + $Value.Replace("'", "''") + "'" | |||||
| } | |||||
| function Add-RemoteArgument { | |||||
| param( | |||||
| [System.Collections.Generic.List[string]]$Arguments, | |||||
| [string]$Name, | |||||
| [string]$Value | |||||
| ) | |||||
| $Arguments.Add($Name) | |||||
| $Arguments.Add((ConvertTo-SingleQuotedPowerShell $Value)) | |||||
| } | |||||
| function Assert-SafeNameValue { | |||||
| param([string]$Name, [string]$Value) | |||||
| if ([string]::IsNullOrWhiteSpace($Value) -or $Value -notmatch '^[A-Za-z0-9_. -]+$') { | |||||
| throw "$Name contains unsupported characters." | |||||
| } | |||||
| if ($Value -match '(?i)schedulicious') { | |||||
| throw "$Name must not identify a Schedulicious resource." | |||||
| } | |||||
| } | |||||
| function Assert-SafeDeploymentValues { | |||||
| Assert-SafeNameValue -Name 'SiteName' -Value $SiteName | |||||
| Assert-SafeNameValue -Name 'AppPoolName' -Value $AppPoolName | |||||
| if ($DeployRoot -match '(?i)schedulicious') { | |||||
| throw 'DeployRoot must not reference Schedulicious.' | |||||
| } | |||||
| if ([string]::IsNullOrWhiteSpace($BindingIpAddress)) { | |||||
| throw 'BindingIpAddress must not be empty.' | |||||
| } | |||||
| $parsedAddress = $null | |||||
| if (-not [System.Net.IPAddress]::TryParse($BindingIpAddress, [ref]$parsedAddress)) { | |||||
| throw "BindingIpAddress is not a valid IP address: $BindingIpAddress" | |||||
| } | |||||
| if ($HostHeader -match '[:/\\]') { | |||||
| throw 'HostHeader must be empty or a DNS host name without a scheme, port, slash, or backslash.' | |||||
| } | |||||
| if ($HostHeader -match '(?i)schedulicious') { | |||||
| throw 'HostHeader must not reference Schedulicious.' | |||||
| } | |||||
| } | |||||
| function Copy-ReleaseSource { | |||||
| param([string]$From, [string]$To) | |||||
| $excludedNames = @('.git', '.deployment', 'releases') | |||||
| $packageRoots = @(Get-ChildItem -LiteralPath $From -Force | Where-Object { $excludedNames -notcontains $_.Name }) | |||||
| $unsafeSourceItem = $packageRoots | | |||||
| ForEach-Object { | |||||
| if (($_.Attributes -band [IO.FileAttributes]::ReparsePoint) -ne 0) { $_ } | |||||
| elseif ($_.PSIsContainer) { Get-ChildItem -LiteralPath $_.FullName -Recurse -Force } | |||||
| } | | |||||
| Where-Object { ($_.Attributes -band [IO.FileAttributes]::ReparsePoint) -ne 0 } | | |||||
| Select-Object -First 1 | |||||
| if ($null -ne $unsafeSourceItem) { | |||||
| throw "Source contains a reparse point/symbolic link, which is not package-safe: $($unsafeSourceItem.FullName)" | |||||
| } | |||||
| New-Item -ItemType Directory -Force -Path $To | Out-Null | |||||
| $packageRoots | ForEach-Object { | |||||
| if ($excludedNames -contains $_.Name) { return } | |||||
| if (($_.Attributes -band [IO.FileAttributes]::ReparsePoint) -ne 0) { | |||||
| throw "Source contains a reparse point/symbolic link, which is not package-safe: $($_.FullName)" | |||||
| } | |||||
| Copy-Item -LiteralPath $_.FullName -Destination $To -Recurse -Force | |||||
| } | |||||
| $unsafeEntry = Get-ChildItem -LiteralPath $To -Recurse -Force | | |||||
| Where-Object { ($_.Attributes -band [IO.FileAttributes]::ReparsePoint) -ne 0 } | | |||||
| Select-Object -First 1 | |||||
| if ($null -ne $unsafeEntry) { | |||||
| throw "Package staging contains a reparse point/symbolic link: $($unsafeEntry.FullName)" | |||||
| } | |||||
| } | |||||
| function Assert-ReleaseLayout { | |||||
| param([string]$Root) | |||||
| $required = @( | |||||
| 'public\Default.asp', | |||||
| 'public\web.config', | |||||
| 'core\autoload_core.asp', | |||||
| 'app\controllers\autoload_controllers.asp', | |||||
| 'scripts\install-iis-release.ps1' | |||||
| ) | |||||
| foreach ($relativePath in $required) { | |||||
| if (-not (Test-Path -LiteralPath (Join-Path $Root $relativePath) -PathType Leaf)) { | |||||
| throw "Package/source tree is incomplete; missing $relativePath" | |||||
| } | |||||
| } | |||||
| foreach ($xmlFile in Get-ChildItem -LiteralPath $Root -Recurse -Force -Filter 'web.config') { | |||||
| try { | |||||
| [xml](Get-Content -LiteralPath $xmlFile.FullName -Raw) | Out-Null | |||||
| } catch { | |||||
| throw "$($xmlFile.FullName) is not valid XML: $($_.Exception.Message)" | |||||
| } | |||||
| } | |||||
| } | |||||
| Assert-SafeDeploymentValues | |||||
| $SourcePath = [System.IO.Path]::GetFullPath($SourcePath) | |||||
| $installerPath = Join-Path $PSScriptRoot 'install-iis-release.ps1' | |||||
| Assert-ReleaseLayout -Root $SourcePath | |||||
| $directGitRoot = Test-Path -LiteralPath (Join-Path $SourcePath '.git') | |||||
| $commit = 'nogit' | |||||
| if ($directGitRoot) { | |||||
| Assert-Command 'git' | |||||
| $branch = (& git -C $SourcePath branch --show-current).Trim() | |||||
| if ($LASTEXITCODE -ne 0) { throw 'Could not determine the Git branch.' } | |||||
| if ((-not $AllowAnyBranch) -and $branch -ne $ExpectedBranch) { | |||||
| throw "Refusing to deploy branch '$branch'; expected '$ExpectedBranch'." | |||||
| } | |||||
| $dirty = & git -C $SourcePath status --porcelain | |||||
| if ($LASTEXITCODE -ne 0) { throw 'Could not inspect the Git worktree.' } | |||||
| if ((-not $AllowDirty) -and $null -ne $dirty -and @($dirty).Count -gt 0) { | |||||
| throw 'Refusing to deploy a dirty worktree. Use -AllowDirty only for a reviewed exception.' | |||||
| } | |||||
| $commit = (& git -C $SourcePath rev-parse --short=12 HEAD).Trim() | |||||
| if ($LASTEXITCODE -ne 0) { throw 'Could not determine the Git commit.' } | |||||
| Write-Host "Source branch: $branch" | |||||
| Write-Host "Source commit: $commit" | |||||
| } else { | |||||
| Write-Warning 'SourcePath is not a standalone Git checkout; branch and dirty-worktree checks cannot be enforced.' | |||||
| if (-not $AllowAnyBranch) { | |||||
| throw 'Use a standalone checkout, or pass -AllowAnyBranch for a reviewed non-Git source tree.' | |||||
| } | |||||
| } | |||||
| if ([string]::IsNullOrWhiteSpace($ReleaseId)) { | |||||
| $ReleaseId = (Get-Date -Format 'yyyyMMdd-HHmmss') + '-' + $commit | |||||
| } | |||||
| if ($ReleaseId -notmatch '^[A-Za-z0-9._-]+$') { throw 'ReleaseId contains unsupported characters.' } | |||||
| if ($Rollback -and [string]::IsNullOrWhiteSpace($RollbackTo)) { throw '-Rollback requires -RollbackTo.' } | |||||
| if ((-not $Rollback) -and -not [string]::IsNullOrWhiteSpace($RollbackTo)) { throw '-RollbackTo requires -Rollback.' } | |||||
| if ($RunMigrations -and $Rollback) { throw '-RunMigrations is not valid during rollback.' } | |||||
| if (($PreflightOnly -or $LocalPreflightOnly) -and $Rollback) { | |||||
| throw 'Preflight modes cannot be combined with -Rollback.' | |||||
| } | |||||
| if ($PreflightOnly -and $LocalPreflightOnly) { | |||||
| throw '-PreflightOnly and -LocalPreflightOnly are mutually exclusive.' | |||||
| } | |||||
| $workRoot = Join-Path ([System.IO.Path]::GetTempPath()) ('asp-iis-deploy-' + [Guid]::NewGuid().ToString('N')) | |||||
| $packageStage = Join-Path $workRoot 'package' | |||||
| $packageExtract = Join-Path $workRoot 'verify' | |||||
| $packagePath = Join-Path $workRoot ($ReleaseId + '.zip') | |||||
| $remoteDirectory = 'C:\Windows\Temp\asp-iis-deploy-' + $ReleaseId | |||||
| $remotePackage = $remoteDirectory + '\' + $ReleaseId + '.zip' | |||||
| $remoteInstaller = $remoteDirectory + '\install-iis-release.ps1' | |||||
| try { | |||||
| $sha256 = '' | |||||
| if (-not $Rollback) { | |||||
| Write-Step 'Staging the complete repository for packaging' | |||||
| Copy-ReleaseSource -From $SourcePath -To $packageStage | |||||
| Assert-ReleaseLayout -Root $packageStage | |||||
| Add-Type -AssemblyName System.IO.Compression.FileSystem | |||||
| [System.IO.Compression.ZipFile]::CreateFromDirectory($packageStage, $packagePath, [System.IO.Compression.CompressionLevel]::Optimal, $false) | |||||
| [System.IO.Compression.ZipFile]::ExtractToDirectory($packagePath, $packageExtract) | |||||
| Assert-ReleaseLayout -Root $packageExtract | |||||
| $sha256 = (Get-FileHash -LiteralPath $packagePath -Algorithm SHA256).Hash | |||||
| Write-Host "Package: $packagePath" | |||||
| Write-Host "SHA-256: $sha256" | |||||
| } | |||||
| if ($LocalPreflightOnly) { | |||||
| Write-Step 'Local/controller preflight passed; no network connection or host change was made' | |||||
| exit 0 | |||||
| } | |||||
| $remoteArguments = New-Object 'System.Collections.Generic.List[string]' | |||||
| $remoteArguments.Add('&') | |||||
| $remoteArguments.Add((ConvertTo-SingleQuotedPowerShell $remoteInstaller)) | |||||
| Add-RemoteArgument $remoteArguments '-SiteName' $SiteName | |||||
| Add-RemoteArgument $remoteArguments '-AppPoolName' $AppPoolName | |||||
| Add-RemoteArgument $remoteArguments '-DeployRoot' $DeployRoot | |||||
| Add-RemoteArgument $remoteArguments '-BindingIpAddress' $BindingIpAddress | |||||
| Add-RemoteArgument $remoteArguments '-BindingPort' $BindingPort.ToString() | |||||
| Add-RemoteArgument $remoteArguments '-HostHeader' $HostHeader | |||||
| Add-RemoteArgument $remoteArguments '-KeepReleases' $KeepReleases.ToString() | |||||
| if (-not [string]::IsNullOrWhiteSpace($InitialWebConfigPath)) { Add-RemoteArgument $remoteArguments '-InitialWebConfigPath' $InitialWebConfigPath } | |||||
| if (-not [string]::IsNullOrWhiteSpace($BaseUrl)) { Add-RemoteArgument $remoteArguments '-BaseUrl' $BaseUrl } | |||||
| if ($Rollback) { | |||||
| Add-RemoteArgument $remoteArguments '-RollbackTo' $RollbackTo | |||||
| } elseif ($PreflightOnly) { | |||||
| $remoteArguments.Add('-PreflightOnly') | |||||
| } else { | |||||
| Add-RemoteArgument $remoteArguments '-PackagePath' $remotePackage | |||||
| Add-RemoteArgument $remoteArguments '-ReleaseId' $ReleaseId | |||||
| Add-RemoteArgument $remoteArguments '-ExpectedSha256' $sha256 | |||||
| } | |||||
| if ($RunMigrations) { $remoteArguments.Add('-RunMigrations') } | |||||
| if ($SkipSmokeTest) { $remoteArguments.Add('-SkipSmokeTest') } | |||||
| $remoteScript = $remoteArguments -join ' ' | |||||
| $remoteEncodedCommand = [Convert]::ToBase64String([Text.Encoding]::Unicode.GetBytes($remoteScript)) | |||||
| $remoteCommand = 'powershell.exe -NoProfile -NonInteractive -ExecutionPolicy RemoteSigned -EncodedCommand ' + $remoteEncodedCommand | |||||
| if ($DryRun) { | |||||
| Write-Step 'Dry-run complete; no network connection was made' | |||||
| Write-Host "Would use dedicated site '$SiteName' and app pool '$AppPoolName'." | |||||
| Write-Host "Would use binding ${BindingIpAddress}:$BindingPort with host header '$HostHeader'." | |||||
| if ($PreflightOnly) { | |||||
| Write-Host 'Would stream the installer over SSH for a read-only host preflight; no remote file would be written.' | |||||
| } else { | |||||
| Write-Host "Would create remote directory: $remoteDirectory" | |||||
| Write-Host "Would copy installer: $installerPath" | |||||
| if (-not $Rollback) { Write-Host "Would copy package: $packagePath" } | |||||
| Write-Host ('Would execute host script: ' + $remoteScript) | |||||
| } | |||||
| exit 0 | |||||
| } | |||||
| Assert-Command $SshExe | |||||
| if ($PreflightOnly) { | |||||
| Write-Step 'Streaming the installer for read-only host preflight' | |||||
| $installerSource = Get-Content -LiteralPath $installerPath -Raw | |||||
| $argumentTail = @($remoteArguments | Select-Object -Skip 2) -join ' ' | |||||
| $stdinScript = "& {`r`n" + $installerSource + "`r`n} " + $argumentTail | |||||
| $stdinScript | & $SshExe -p $RemotePort $RemoteTarget 'powershell.exe -NoProfile -NonInteractive -ExecutionPolicy RemoteSigned -Command -' | |||||
| if ($LASTEXITCODE -ne 0) { throw "Remote preflight failed with exit code $LASTEXITCODE." } | |||||
| Write-Step 'Remote host preflight completed successfully without persistent host changes' | |||||
| exit 0 | |||||
| } | |||||
| Assert-Command $ScpExe | |||||
| Write-Step 'Creating remote temporary directory' | |||||
| $mkdirScript = "New-Item -ItemType Directory -Force -Path $(ConvertTo-SingleQuotedPowerShell $remoteDirectory) | Out-Null" | |||||
| $mkdirEncoded = [Convert]::ToBase64String([Text.Encoding]::Unicode.GetBytes($mkdirScript)) | |||||
| & $SshExe -p $RemotePort $RemoteTarget ('powershell.exe -NoProfile -NonInteractive -EncodedCommand ' + $mkdirEncoded) | |||||
| if ($LASTEXITCODE -ne 0) { throw 'Remote directory creation failed.' } | |||||
| Write-Step 'Copying the host installer' | |||||
| & $ScpExe -P $RemotePort $installerPath ($RemoteTarget + ':' + $remoteDirectory.Replace('\', '/') + '/install-iis-release.ps1') | |||||
| if ($LASTEXITCODE -ne 0) { throw 'Installer copy failed.' } | |||||
| if (-not $Rollback) { | |||||
| Write-Step 'Copying the release package' | |||||
| & $ScpExe -P $RemotePort $packagePath ($RemoteTarget + ':' + $remoteDirectory.Replace('\', '/') + '/' + $ReleaseId + '.zip') | |||||
| if ($LASTEXITCODE -ne 0) { throw 'Package copy failed.' } | |||||
| } | |||||
| Write-Step 'Invoking the host-side installer' | |||||
| & $SshExe -p $RemotePort $RemoteTarget $remoteCommand | |||||
| if ($LASTEXITCODE -ne 0) { throw "Remote installer failed with exit code $LASTEXITCODE." } | |||||
| Write-Step 'Remote operation completed successfully' | |||||
| } finally { | |||||
| if ($KeepPackage -and (Test-Path -LiteralPath $packagePath)) { | |||||
| $keptPath = Join-Path (Get-Location) ([System.IO.Path]::GetFileName($packagePath)) | |||||
| Copy-Item -LiteralPath $packagePath -Destination $keptPath -Force | |||||
| Write-Host "Package retained at $keptPath" | |||||
| } | |||||
| if (Test-Path -LiteralPath $workRoot) { Remove-Item -LiteralPath $workRoot -Recurse -Force } | |||||
| } | |||||
| @@ -0,0 +1,162 @@ | |||||
| '======================================================================================================================= | |||||
| ' MIGRATION GENERATOR | |||||
| '======================================================================================================================= | |||||
| ' Generates a new migration file with timestamp-based versioning. | |||||
| ' | |||||
| ' Usage: | |||||
| ' cscript //nologo scripts\generateMigration.vbs migration_name | |||||
| ' | |||||
| ' Example: | |||||
| ' cscript //nologo scripts\generateMigration.vbs create_users_table | |||||
| ' Creates: db/migrations/20260109153045_create_users_table.asp | |||||
| ' | |||||
| Option Explicit | |||||
| Dim fso, migrationName, timestamp, filename, filepath, content | |||||
| Set fso = CreateObject("Scripting.FileSystemObject") | |||||
| ' Check arguments | |||||
| If WScript.Arguments.Count < 1 Then | |||||
| WScript.Echo "Usage: cscript //nologo scripts\generateMigration.vbs migration_name" | |||||
| WScript.Echo "" | |||||
| WScript.Echo "Example:" | |||||
| WScript.Echo " cscript //nologo scripts\generateMigration.vbs create_users_table" | |||||
| WScript.Quit 1 | |||||
| End If | |||||
| migrationName = WScript.Arguments(0) | |||||
| ' Validate migration name (alphanumeric and underscore only) | |||||
| If Not IsValidMigrationName(migrationName) Then | |||||
| WScript.Echo "Error: Migration name must contain only letters, numbers, and underscores" | |||||
| WScript.Quit 1 | |||||
| End If | |||||
| ' Generate timestamp (YYYYMMDDHHMMSS) | |||||
| timestamp = GetTimestamp() | |||||
| ' Create filename | |||||
| filename = timestamp & "_" & migrationName & ".asp" | |||||
| ' Ensure migrations directory exists | |||||
| Dim migrationsDir | |||||
| migrationsDir = fso.GetParentFolderName(WScript.ScriptFullName) & "\..\db\migrations" | |||||
| migrationsDir = fso.GetAbsolutePathName(migrationsDir) | |||||
| If Not fso.FolderExists(migrationsDir) Then | |||||
| CreateDirectoryPath migrationsDir | |||||
| End If | |||||
| filepath = migrationsDir & "\" & filename | |||||
| ' Check if file already exists | |||||
| If fso.FileExists(filepath) Then | |||||
| WScript.Echo "Error: Migration file already exists: " & filename | |||||
| WScript.Quit 1 | |||||
| End If | |||||
| ' Generate migration content | |||||
| content = GenerateMigrationContent(migrationName) | |||||
| ' Write the file | |||||
| Dim file | |||||
| Set file = fso.CreateTextFile(filepath, True) | |||||
| file.Write content | |||||
| file.Close | |||||
| WScript.Echo "Migration created: " & filename | |||||
| WScript.Echo "Path: " & filepath | |||||
| WScript.Echo "" | |||||
| WScript.Echo "Edit the file to add your migration logic, then run:" | |||||
| WScript.Echo " cscript //nologo scripts\runMigrations.vbs" | |||||
| WScript.Quit 0 | |||||
| '======================================================================================================================= | |||||
| ' HELPER FUNCTIONS | |||||
| '======================================================================================================================= | |||||
| Function GetTimestamp() | |||||
| Dim dtNow, sYear, sMonth, sDay, sHour, sMinute, sSecond | |||||
| dtNow = Now() | |||||
| sYear = Year(dtNow) | |||||
| sMonth = Right("0" & Month(dtNow), 2) | |||||
| sDay = Right("0" & Day(dtNow), 2) | |||||
| sHour = Right("0" & Hour(dtNow), 2) | |||||
| sMinute = Right("0" & Minute(dtNow), 2) | |||||
| sSecond = Right("0" & Second(dtNow), 2) | |||||
| GetTimestamp = sYear & sMonth & sDay & sHour & sMinute & sSecond | |||||
| End Function | |||||
| Function IsValidMigrationName(name) | |||||
| Dim regex | |||||
| Set regex = New RegExp | |||||
| regex.Pattern = "^[a-zA-Z0-9_]+$" | |||||
| IsValidMigrationName = regex.Test(name) | |||||
| End Function | |||||
| Function GenerateMigrationContent(name) | |||||
| Dim template | |||||
| template = "<%"& vbCrLf | |||||
| template = template & "'======================================================================================================================="& vbCrLf | |||||
| template = template & "' MIGRATION: " & name & vbCrLf | |||||
| template = template & "'======================================================================================================================="& vbCrLf | |||||
| template = template & "' This migration was auto-generated. Add your migration logic below."& vbCrLf | |||||
| template = template & "'"& vbCrLf | |||||
| template = template & "' The migration object provides these helper methods:"& vbCrLf | |||||
| template = template & "' - migration.ExecuteSQL(sql) - Execute raw SQL"& vbCrLf | |||||
| template = template & "' - migration.CreateTable(name, columns) - Create a table"& vbCrLf | |||||
| template = template & "' - migration.DropTable(name) - Drop a table"& vbCrLf | |||||
| template = template & "' - migration.AddColumn(table, column, type) - Add a column"& vbCrLf | |||||
| template = template & "' - migration.DropColumn(table, column) - Drop a column"& vbCrLf | |||||
| template = template & "' - migration.CreateIndex(name, table, columns) - Create an index"& vbCrLf | |||||
| template = template & "' - migration.DropIndex(name, table) - Drop an index"& vbCrLf | |||||
| template = template & "'"& vbCrLf | |||||
| template = template & "' For complex operations, use migration.DB to access the database directly:"& vbCrLf | |||||
| template = template & "' migration.DB.Execute ""INSERT INTO users (name) VALUES (?)"", Array(""John"")"& vbCrLf | |||||
| template = template & "'"& vbCrLf | |||||
| template = template & ""& vbCrLf | |||||
| template = template & "'-----------------------------------------------------------------------------------------------------------------------"& vbCrLf | |||||
| template = template & "' UP - Apply the migration"& vbCrLf | |||||
| template = template & "'-----------------------------------------------------------------------------------------------------------------------"& vbCrLf | |||||
| template = template & "Sub Migration_Up(migration)"& vbCrLf | |||||
| template = template & " ' Example: Create a table"& vbCrLf | |||||
| template = template & " ' migration.CreateTable ""users"", ""id AUTOINCREMENT PRIMARY KEY, name VARCHAR(255) NOT NULL, email VARCHAR(255), created_at DATETIME"""& vbCrLf | |||||
| template = template & " "& vbCrLf | |||||
| template = template & " ' Example: Add an index"& vbCrLf | |||||
| template = template & " ' migration.CreateIndex ""idx_users_email"", ""users"", ""email"""& vbCrLf | |||||
| template = template & " "& vbCrLf | |||||
| template = template & " ' TODO: Add your migration logic here"& vbCrLf | |||||
| template = template & " "& vbCrLf | |||||
| template = template & "End Sub"& vbCrLf | |||||
| template = template & ""& vbCrLf | |||||
| template = template & "'-----------------------------------------------------------------------------------------------------------------------"& vbCrLf | |||||
| template = template & "' DOWN - Rollback the migration"& vbCrLf | |||||
| template = template & "'-----------------------------------------------------------------------------------------------------------------------"& vbCrLf | |||||
| template = template & "Sub Migration_Down(migration)"& vbCrLf | |||||
| template = template & " ' Example: Drop the table"& vbCrLf | |||||
| template = template & " ' migration.DropTable ""users"""& vbCrLf | |||||
| template = template & " "& vbCrLf | |||||
| template = template & " ' TODO: Add your rollback logic here (reverse the Up migration)"& vbCrLf | |||||
| template = template & " "& vbCrLf | |||||
| template = template & "End Sub"& vbCrLf | |||||
| template = template & "%>"& vbCrLf | |||||
| GenerateMigrationContent = template | |||||
| End Function | |||||
| Sub CreateDirectoryPath(path) | |||||
| Dim parentPath | |||||
| If Not fso.FolderExists(path) Then | |||||
| parentPath = fso.GetParentFolderName(path) | |||||
| If parentPath <> "" Then | |||||
| CreateDirectoryPath parentPath | |||||
| End If | |||||
| fso.CreateFolder path | |||||
| End If | |||||
| End Sub | |||||
Powered by TurnKey Linux.