| @@ -0,0 +1,7 @@ | |||||
| { | |||||
| "permissions": { | |||||
| "allow": [ | |||||
| "Bash($tmp *)" | |||||
| ] | |||||
| } | |||||
| } | |||||
| @@ -0,0 +1,6 @@ | |||||
| /_bmad | |||||
| /_bmad* | |||||
| /.agents | |||||
| /.github | |||||
| .env | |||||
| /public/web.config | |||||
| @@ -0,0 +1,213 @@ | |||||
| # 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 | |||||
| ## Keycloak Authentication | |||||
| The core Keycloak helper is loaded automatically from `core/lib.Keycloak.asp`. | |||||
| It uses Keycloak's OpenID Connect authorization-code flow to redirect users to | |||||
| Keycloak, exchange the callback code for tokens, and fetch user profile data | |||||
| from the `userinfo` endpoint. | |||||
| ### Configure `public/web.config` | |||||
| Update these `appSettings` before enabling login: | |||||
| ```xml | |||||
| <add key="KeycloakBaseUrl" value="https://keycloak.example.com" /> | |||||
| <add key="KeycloakRealm" value="your-realm" /> | |||||
| <add key="KeycloakClientId" value="your-client-id" /> | |||||
| <add key="KeycloakClientSecret" value="" /> | |||||
| <add key="KeycloakRedirectUri" value="http://localhost/auth/callback" /> | |||||
| <add key="KeycloakLogoutRedirectUri" value="http://localhost/" /> | |||||
| <add key="KeycloakScope" value="openid profile email" /> | |||||
| <add key="KeycloakPendingLoginCookieMinutes" value="15" /> | |||||
| <add key="KeycloakAllowedClockSkewSeconds" value="300" /> | |||||
| <add key="KeycloakHttpResolveTimeoutMs" value="5000" /> | |||||
| <add key="KeycloakHttpConnectTimeoutMs" value="5000" /> | |||||
| <add key="KeycloakHttpSendTimeoutMs" value="15000" /> | |||||
| <add key="KeycloakHttpReceiveTimeoutMs" value="15000" /> | |||||
| <add key="KeycloakEnableLogging" value="false" /> | |||||
| <add key="KeycloakLogPath" value="C:\YourApp\logs\keycloak.log" /> | |||||
| ``` | |||||
| - `KeycloakBaseUrl`: Base URL of the Keycloak server, without `/realms/...`. | |||||
| - `KeycloakRealm`: Realm that owns the application client. | |||||
| - `KeycloakClientId`: Client ID configured in Keycloak. | |||||
| - `KeycloakClientSecret`: Secret for confidential clients. Leave blank for public clients. | |||||
| - `KeycloakRedirectUri`: Absolute callback URL in this ASP app. | |||||
| - `KeycloakLogoutRedirectUri`: Absolute URL to return to after Keycloak logout. | |||||
| - `KeycloakScope`: OIDC scopes to request. The default is `openid profile email`. | |||||
| - `KeycloakPendingLoginCookieMinutes`: How long the temporary login state and nonce cookie should survive during the redirect round-trip. | |||||
| - `KeycloakAllowedClockSkewSeconds`: Grace period for `exp`, `nbf`, and `iat` validation when checking the ID token claims. | |||||
| - `KeycloakHttp*TimeoutMs`: Outbound HTTP timeouts for the token and userinfo requests. | |||||
| - `KeycloakEnableLogging` / `KeycloakLogPath`: Optional diagnostic logging for Keycloak request and token-validation failures. | |||||
| Keep `KeycloakClientSecret` out of source control and inject it per environment. Use HTTPS callback and logout URLs outside local development. | |||||
| ### Configure the Keycloak client | |||||
| In Keycloak, create or update a client for this app: | |||||
| - Client protocol: OpenID Connect. | |||||
| - Access type/client authentication: use a confidential client if you set `KeycloakClientSecret`; otherwise use a public client. | |||||
| - Valid redirect URIs: include the exact `KeycloakRedirectUri`, for example `http://localhost/auth/callback`. | |||||
| - Valid post logout redirect URIs: include the exact `KeycloakLogoutRedirectUri`. | |||||
| - Web origins: include the app origin, for example `http://localhost`, or configure according to your environment policy. | |||||
| ### Use the helper in controllers | |||||
| Add routes in `public/Default.asp` for login, callback, and logout actions. In | |||||
| those controller actions, call the helper functions: | |||||
| ```asp | |||||
| ' Login action | |||||
| Call KeycloakLogin() | |||||
| ' Callback action | |||||
| If KeycloakHandleCallback() Then | |||||
| Response.Redirect KeycloakConsumePostLoginRedirectPath("/") | |||||
| Else | |||||
| Response.Write H(KeycloakAuth().ErrorMessage) | |||||
| End If | |||||
| ' Logout action | |||||
| Call KeycloakLogout("") | |||||
| ``` | |||||
| After login, use the current user and token helpers anywhere after core autoload: | |||||
| ```asp | |||||
| If KeycloakIsLoggedIn() Then | |||||
| Dim user | |||||
| Set user = KeycloakCurrentUser() | |||||
| If Not user Is Nothing Then | |||||
| Response.Write H(user.Item("preferred_username")) | |||||
| End If | |||||
| End If | |||||
| Dim accessToken | |||||
| accessToken = KeycloakAccessToken() | |||||
| ``` | |||||
| To protect a controller action and return the user to the original page after sign-in: | |||||
| ```asp | |||||
| If Not KeycloakRequireLogin("") Then Exit Sub | |||||
| If Not KeycloakHasRealmRole("admin") Then | |||||
| Response.Status = "403 Forbidden" | |||||
| Response.Write "Forbidden" | |||||
| Exit Sub | |||||
| End If | |||||
| ``` | |||||
| Available helper functions: | |||||
| - `KeycloakLogin()`: Redirects to Keycloak and stores temporary login state for the redirect round-trip. | |||||
| - `KeycloakHandleCallback()`: Validates callback state and nonce, exchanges the code, stores tokens, and fetches user info. | |||||
| - `KeycloakIsLoggedIn()`: Returns True when an access token is in Session. | |||||
| - `KeycloakCurrentUser()`: Returns the cached userinfo dictionary, or ID token claims when userinfo is unavailable. | |||||
| - `KeycloakUserInfo()`: Calls Keycloak's `userinfo` endpoint with the current access token. | |||||
| - `KeycloakAccessToken()`, `KeycloakRefreshToken()`, `KeycloakIdToken()`: Return stored tokens. | |||||
| - `KeycloakTokenClaims(token)`: Decodes JWT payload claims into a dictionary. | |||||
| - `KeycloakRequireLogin(returnToPath)`: Redirects unauthenticated users to login and preserves a safe relative return path. | |||||
| - `KeycloakConsumePostLoginRedirectPath(fallbackPath)`: Returns the stored post-login destination, then clears it from Session. | |||||
| - `KeycloakHasRealmRole(roleName)`: Returns True when the stored ID token includes the named realm role. | |||||
| - `KeycloakHasClientRole(clientId, roleName)`: Returns True when the stored ID token includes the named client role. | |||||
| - `KeycloakLogoutUrl(postLogoutRedirectUri)`: Builds a Keycloak logout URL. | |||||
| - `KeycloakLogout(postLogoutRedirectUri)`: Clears Session values and redirects to Keycloak logout. | |||||
| ### Session values | |||||
| The helper stores tokens and user info in Session using the `Keycloak_` prefix. | |||||
| Use HTTPS in production so tokens are protected in transit, and configure IIS | |||||
| session settings according to your application's security requirements. | |||||
| ## 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) | |||||
| ## 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,147 @@ | |||||
| # 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. | |||||
| ## 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,72 @@ | |||||
| <% | |||||
| Class AuthController_Class | |||||
| Private m_useLayout | |||||
| Private m_title | |||||
| Private Sub Class_Initialize() | |||||
| m_useLayout = True | |||||
| m_title = "Authentication" | |||||
| 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 /auth/login | |||||
| ' Initiates the Keycloak authorization-code flow. Generates state/nonce, | |||||
| ' stores them in Session, then redirects the browser to Keycloak. | |||||
| Public Sub Login() | |||||
| Dim returnToPath | |||||
| returnToPath = Trim(CStr(Request.QueryString("returnTo"))) | |||||
| If Len(returnToPath) > 0 Then | |||||
| Call KeycloakSetPostLoginRedirectPath(returnToPath) | |||||
| End If | |||||
| Call KeycloakLogin() | |||||
| End Sub | |||||
| ' GET /auth/callback | |||||
| ' Keycloak redirects here after the user authenticates. Exchanges the | |||||
| ' authorization code for tokens, fetches user info, and redirects home. | |||||
| ' On failure the error view is rendered inline. | |||||
| Public Sub Callback() | |||||
| Dim success, redirectPath | |||||
| success = KeycloakHandleCallback() | |||||
| If success Then | |||||
| redirectPath = KeycloakConsumePostLoginRedirectPath("/") | |||||
| Response.Redirect redirectPath | |||||
| Else | |||||
| %> | |||||
| <!--#include file="../views/Auth/CallbackError.asp" --> | |||||
| <% | |||||
| End If | |||||
| End Sub | |||||
| ' GET /auth/logout | |||||
| ' Clears the local session and redirects to Keycloak's logout endpoint so | |||||
| ' the SSO session is also terminated. | |||||
| Public Sub Logout() | |||||
| Call KeycloakLogout("") | |||||
| End Sub | |||||
| End Class | |||||
| Dim AuthController_Class__Singleton | |||||
| Function AuthController() | |||||
| If IsEmpty(AuthController_Class__Singleton) Then | |||||
| Set AuthController_Class__Singleton = New AuthController_Class | |||||
| End If | |||||
| Set AuthController = AuthController_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,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,3 @@ | |||||
| <!--#include file="HomeController.asp" --> | |||||
| <!--#include file="ErrorController.asp" --> | |||||
| <!--#include file="AuthController.asp" --> | |||||
| @@ -0,0 +1,14 @@ | |||||
| <div class="container mt-5"> | |||||
| <div class="alert alert-danger" role="alert"> | |||||
| <h4 class="alert-heading">Sign-in Failed</h4> | |||||
| <p class="mb-0">There was a problem completing sign-in with the identity provider.</p> | |||||
| <% If Len(KeycloakAuth().ErrorMessage) > 0 Then %> | |||||
| <hr> | |||||
| <p class="mb-0"><%= Server.HTMLEncode(KeycloakAuth().ErrorMessage) %></p> | |||||
| <% End If %> | |||||
| </div> | |||||
| <p> | |||||
| <a href="/auth/login" class="btn btn-primary">Try Again</a> | |||||
| <a href="/" class="btn btn-outline-secondary ms-2">Go to Home</a> | |||||
| </p> | |||||
| </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,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,104 @@ | |||||
| <!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="/"> | |||||
| Classic ASP | |||||
| <span class="text-secondary small">Starter</span> | |||||
| </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="/home">Home</a> | |||||
| </li> | |||||
| </ul> | |||||
| <% | |||||
| If KeycloakIsLoggedIn() Then | |||||
| Dim currentUser, displayName | |||||
| Set currentUser = KeycloakCurrentUser() | |||||
| displayName = "" | |||||
| If Not currentUser Is Nothing Then | |||||
| If currentUser.Exists("preferred_username") Then displayName = CStr(currentUser.Item("preferred_username")) | |||||
| If Len(displayName) = 0 And currentUser.Exists("email") Then displayName = CStr(currentUser.Item("email")) | |||||
| End If | |||||
| If Len(displayName) = 0 Then displayName = "User" | |||||
| %> | |||||
| <ul class="navbar-nav mb-2 mb-lg-0"> | |||||
| <li class="nav-item dropdown"> | |||||
| <a class="nav-link dropdown-toggle" href="#" role="button" data-bs-toggle="dropdown" aria-expanded="false"> | |||||
| <i class="bi bi-person-circle me-1"></i><%= Server.HTMLEncode(displayName) %> | |||||
| </a> | |||||
| <ul class="dropdown-menu dropdown-menu-end"> | |||||
| <li><a class="dropdown-item" href="/auth/logout"><i class="bi bi-box-arrow-right me-1"></i>Sign Out</a></li> | |||||
| </ul> | |||||
| </li> | |||||
| </ul> | |||||
| <% Else %> | |||||
| <ul class="navbar-nav mb-2 mb-lg-0"> | |||||
| <li class="nav-item"> | |||||
| <a class="nav-link" href="/auth/login"><i class="bi bi-box-arrow-in-right me-1"></i>Sign In</a> | |||||
| </li> | |||||
| </ul> | |||||
| <% End If %> | |||||
| </div> | |||||
| </div> | |||||
| </nav> | |||||
| <!-- Main container for views --> | |||||
| <main class="routekit-main"> | |||||
| <div class="container"> | |||||
| <% Flash().ShowErrorsIfPresent : Flash().ShowSuccessIfPresent %> | |||||
| @@ -0,0 +1,26 @@ | |||||
| <!--#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.Keycloak.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,111 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' 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 "authcontroller" | |||||
| 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,77 @@ | |||||
| <% | |||||
| '======================================================================================================================= | |||||
| ' 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 | |||||
| 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,166 @@ | |||||
| <!--#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" | |||||
| '======================================================================================================================= | |||||
| ' 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 | |||||
| If hasParams Then | |||||
| paramsArray = SurroundStringInArray(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 | |||||
| ' Build the call string based on whether we have parameters | |||||
| If Not IsEmpty(paramsArray) And IsArray(paramsArray) And UBound(paramsArray) >= 0 Then | |||||
| callString = "Call " & controllerName & "." & actionName & "(" & Join(paramsArray, ",") & ")" | |||||
| 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,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,50 @@ | |||||
| # Deployment Configuration | |||||
| **Date:** 2026-03-11T11:59:39Z | |||||
| ## Hosting Model | |||||
| - Windows IIS | |||||
| - `public/` configured as the site root | |||||
| - `public/Default.asp` as the default document | |||||
| - URL Rewrite sends non-static requests through the ASP front controller | |||||
| ## Runtime Configuration | |||||
| Primary deployment configuration is stored in `public/web.config`. | |||||
| ### Important Settings | |||||
| - `ConnectionString` | |||||
| - `Environment` | |||||
| - `FlashMessageTimeout` | |||||
| - `Error404RedirectSeconds` | |||||
| - `CacheExpirationYear` | |||||
| - `EnableErrorLogging` | |||||
| - `ErrorLogPath` | |||||
| - `KeycloakBaseUrl` | |||||
| - `KeycloakRealm` | |||||
| - `KeycloakClientId` | |||||
| - `KeycloakClientSecret` | |||||
| - `KeycloakRedirectUri` | |||||
| - `KeycloakLogoutRedirectUri` | |||||
| - `KeycloakAllowedClockSkewSeconds` | |||||
| - `KeycloakHttpResolveTimeoutMs` | |||||
| - `KeycloakHttpConnectTimeoutMs` | |||||
| - `KeycloakHttpSendTimeoutMs` | |||||
| - `KeycloakHttpReceiveTimeoutMs` | |||||
| - `KeycloakEnableLogging` | |||||
| - `KeycloakLogPath` | |||||
| ## Deployment Notes | |||||
| - The Access DB path must be updated for the target machine. | |||||
| - `ErrorLogPath` should be writable by the IIS application identity if enabled. | |||||
| - Keep `KeycloakClientSecret` out of source control and inject it per environment. | |||||
| - In `Production`, the login flow now rejects non-HTTPS or localhost Keycloak base, callback, and logout URLs. | |||||
| - Static assets are expected under `public/` paths excluded from rewrite rules. | |||||
| ## Observed Gaps | |||||
| - No container, CI/CD, or infrastructure-as-code deployment config was detected. | |||||
| - Deployment is currently documented as a manual IIS-based process. | |||||
| @@ -0,0 +1,39 @@ | |||||
| # MVC-Starter - Deployment Guide | |||||
| **Date:** 2026-03-11T11:59:39Z | |||||
| ## Deployment Model | |||||
| Single-site Windows IIS deployment with `public/` as the web root. | |||||
| ## Deployment Steps | |||||
| 1. Copy the repository to the target Windows host. | |||||
| 2. Configure the IIS site to point to `public/`. | |||||
| 3. Ensure Classic ASP is enabled. | |||||
| 4. Ensure URL Rewrite is installed. | |||||
| 5. Update `public/web.config` for the target environment. | |||||
| 6. Ensure the Access DB file path is valid and accessible. | |||||
| ## Key Runtime Config | |||||
| - `ConnectionString` | |||||
| - `Environment` | |||||
| - `EnableErrorLogging` | |||||
| - `ErrorLogPath` | |||||
| - cache and UI timing settings | |||||
| - Keycloak OIDC settings, including timeout and clock-skew controls | |||||
| ## Deployment Risks | |||||
| - Incorrect `ConnectionString` path for `.accdb` | |||||
| - Missing IIS URL Rewrite module | |||||
| - Missing Classic ASP support | |||||
| - File permission issues for logs or database access | |||||
| - Production Keycloak URLs left on localhost or plain HTTP | |||||
| ## What Was Not Found | |||||
| - No Docker, Kubernetes, or container deployment setup | |||||
| - No CI/CD pipeline config | |||||
| - No infrastructure-as-code deployment definition | |||||
| @@ -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,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,19 @@ | |||||
| <!--#include file="..\core\autoload_core.asp" --> | |||||
| <% | |||||
| ' Home routes | |||||
| router.AddRoute "GET", "/home", "HomeController", "Index" | |||||
| router.AddRoute "GET", "/", "HomeController", "Index" | |||||
| router.AddRoute "GET", "", "HomeController", "Index" | |||||
| ' Auth routes (Keycloak OpenID Connect) | |||||
| router.AddRoute "GET", "/auth/login", "AuthController", "Login" | |||||
| router.AddRoute "GET", "/auth/callback", "AuthController", "Callback" | |||||
| router.AddRoute "GET", "/auth/logout", "AuthController", "Logout" | |||||
| router.AddRoute "GET", "/404", "ErrorController", "NotFound" | |||||
| ' 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,7 @@ | |||||
| @echo off | |||||
| setlocal | |||||
| set "ASPC_STARTER_ROOT=%~dp0" | |||||
| powershell -NoProfile -ExecutionPolicy Bypass -Command "$root = Resolve-Path '%~dp0'; $envPath = Join-Path $root '.env'; $webConfigPath = Join-Path $root 'public\web.config'; if (Test-Path $envPath) { $line = Get-Content $envPath | Where-Object { $_ -match '^\s*KeycloakClientSecret\s*=' } | Select-Object -First 1; if ($line) { $secret = ($line -split '=', 2)[1].Trim(); if ($secret.Length -ge 2 -and (($secret[0] -eq [char]34 -and $secret[-1] -eq [char]34) -or ($secret[0] -eq [char]39 -and $secret[-1] -eq [char]39))) { $secret = $secret.Substring(1, $secret.Length - 2) }; [xml]$xml = Get-Content $webConfigPath; $node = $xml.configuration.appSettings.add | Where-Object { $_.key -eq 'KeycloakClientSecret' } | Select-Object -First 1; if ($node) { $node.value = $secret } else { $newNode = $xml.CreateElement('add'); $newNode.SetAttribute('key', 'KeycloakClientSecret'); $newNode.SetAttribute('value', $secret); $xml.configuration.appSettings.AppendChild($newNode) | Out-Null }; $xml.Save($webConfigPath); Write-Host 'Injected KeycloakClientSecret from .env into public\web.config.' } else { Write-Host 'KeycloakClientSecret not found in .env. Using existing web.config value.' } } else { Write-Host '.env not found. Using existing web.config value.' }" | |||||
| "C:\Program Files\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,324 @@ | |||||
| <# | |||||
| Deploy asp-territory to an existing IIS site, locally or over SSH. | |||||
| Remote mode: | |||||
| - Copies this script to the remote Windows host with scp | |||||
| - Executes it remotely via ssh in -RunRemoteCore mode | |||||
| - Preserves the remote site's current DB path unless -DbPath is passed | |||||
| - Can run standard migrations and an optional legacy migration script | |||||
| Local / remote core behavior: | |||||
| - Infers IIS site/app pool/work dir from the existing site when possible | |||||
| - Stops the site/app pool while deploying | |||||
| - Clones/pulls and hard-resets to origin/<Branch> | |||||
| - Points IIS at <WorkDir>\public | |||||
| - Reapplies the effective DB path in public\web.config | |||||
| - Grants IIS AppPool rights to the DB folder | |||||
| - Runs migrations | |||||
| - Restarts the site/app pool and smoke tests key routes | |||||
| #> | |||||
| param( | |||||
| [string]$Repo = 'git@onefortheroadgit.sytes.net:dcovington/asp-classic-unified-framework.git', | |||||
| [string]$Branch = 'main', | |||||
| [string]$SiteName = 'ttasp', | |||||
| [string]$AppPool = '', | |||||
| [string]$WorkDir = '', | |||||
| [string]$PublicDir = '', | |||||
| [string]$BaseUrl = '', | |||||
| [string]$DbPath = '', | |||||
| [switch]$RunMigrations = $true, | |||||
| [switch]$SkipLegacyIsBusinessMigration, | |||||
| [string]$LegacyMigrationScript = 'scripts\migrate_isbusiness_to_households.vbs', | |||||
| [switch]$UseRemoteSsh, | |||||
| [string]$RemoteTarget = '', | |||||
| [int]$RemotePort = 22, | |||||
| [string]$SshExe = 'ssh', | |||||
| [string]$ScpExe = 'scp', | |||||
| [switch]$RunRemoteCore | |||||
| ) | |||||
| $ErrorActionPreference = 'Stop' | |||||
| function Ensure-Dir { | |||||
| param([string]$Path) | |||||
| if([string]::IsNullOrWhiteSpace($Path)){ return } | |||||
| if(!(Test-Path $Path)){ | |||||
| New-Item -ItemType Directory -Force -Path $Path | Out-Null | |||||
| } | |||||
| } | |||||
| function Ensure-Command { | |||||
| param([string]$Name) | |||||
| if(!(Get-Command $Name -ErrorAction SilentlyContinue)){ | |||||
| throw "$Name not found on PATH" | |||||
| } | |||||
| } | |||||
| function Get-DefaultRemoteTargetFromInfo { | |||||
| $infoPath = Join-Path $PSScriptRoot 'depolyinfo.txt' | |||||
| if(!(Test-Path $infoPath)){ return '' } | |||||
| $sshLine = Get-Content $infoPath | Where-Object { $_ -match '^\s*ssh\s+' } | Select-Object -First 1 | |||||
| if([string]::IsNullOrWhiteSpace($sshLine)){ return '' } | |||||
| return ($sshLine -replace '^\s*ssh\s+', '').Trim() | |||||
| } | |||||
| function ConvertTo-PowerShellLiteral { | |||||
| param([AllowNull()][string]$Value) | |||||
| if($null -eq $Value){ return "''" } | |||||
| return "'" + ($Value -replace "'", "''") + "'" | |||||
| } | |||||
| function ConvertTo-CmdDoubleQuoted { | |||||
| param([AllowNull()][string]$Value) | |||||
| if($null -eq $Value){ return '""' } | |||||
| return '"' + ($Value -replace '"', '""') + '"' | |||||
| } | |||||
| function Get-DataSourceFromConfig { | |||||
| param([string]$ConfigPath) | |||||
| if(!(Test-Path $ConfigPath)){ return '' } | |||||
| $raw = Get-Content $ConfigPath -Raw | |||||
| $match = [regex]::Match($raw, 'Data Source=([^;]+);', [System.Text.RegularExpressions.RegexOptions]::IgnoreCase) | |||||
| if($match.Success){ | |||||
| return $match.Groups[1].Value.Trim() | |||||
| } | |||||
| return '' | |||||
| } | |||||
| function Set-DataSourceInConfig { | |||||
| param( | |||||
| [string]$ConfigPath, | |||||
| [string]$EffectiveDbPath | |||||
| ) | |||||
| if(!(Test-Path $ConfigPath)){ return } | |||||
| $raw = Get-Content $ConfigPath -Raw | |||||
| $updated = [regex]::Replace( | |||||
| $raw, | |||||
| 'Data Source=[^;]*;', | |||||
| ('Data Source=' + $EffectiveDbPath + ';'), | |||||
| [System.Text.RegularExpressions.RegexOptions]::IgnoreCase | |||||
| ) | |||||
| if($updated -ne $raw){ | |||||
| Set-Content -Path $ConfigPath -Value $updated -Encoding UTF8 | |||||
| Write-Host "Updated ConnectionString Data Source to $EffectiveDbPath" | |||||
| } | |||||
| } | |||||
| function Get-BaseUrlFromSite { | |||||
| param($Site) | |||||
| $httpBind = $Site.Bindings.Collection | Where-Object { $_.protocol -eq 'http' } | Select-Object -First 1 | |||||
| if($httpBind){ | |||||
| $parts = $httpBind.bindingInformation.Split(':') | |||||
| $port = $parts[1] | |||||
| if([string]::IsNullOrWhiteSpace($port)){ $port = '80' } | |||||
| return ('http://127.0.0.1:' + $port) | |||||
| } | |||||
| return 'http://127.0.0.1' | |||||
| } | |||||
| function Invoke-DeployCore { | |||||
| Ensure-Command git | |||||
| Import-Module WebAdministration | |||||
| $site = Get-Website -Name $SiteName | |||||
| if(!$site){ throw "IIS site not found: $SiteName" } | |||||
| if([string]::IsNullOrWhiteSpace($AppPool)){ | |||||
| $AppPool = $site.applicationPool | |||||
| } | |||||
| if([string]::IsNullOrWhiteSpace($PublicDir)){ | |||||
| $PublicDir = $site.physicalPath | |||||
| } | |||||
| if([string]::IsNullOrWhiteSpace($WorkDir)){ | |||||
| $pd = [Environment]::ExpandEnvironmentVariables($PublicDir) | |||||
| $pd = $pd.Trim().Trim('"') | |||||
| $pd = $pd.TrimEnd('\','/') | |||||
| if((Split-Path $pd -Leaf).ToLower() -eq 'public'){ | |||||
| $WorkDir = Split-Path $pd -Parent | |||||
| } else { | |||||
| $WorkDir = $pd | |||||
| } | |||||
| } | |||||
| if([string]::IsNullOrWhiteSpace($BaseUrl)){ | |||||
| $BaseUrl = Get-BaseUrlFromSite -Site $site | |||||
| } | |||||
| $currentPublicDir = $PublicDir | |||||
| $currentConfigPath = Join-Path $currentPublicDir 'web.config' | |||||
| $effectiveDbPath = $DbPath | |||||
| if([string]::IsNullOrWhiteSpace($effectiveDbPath)){ | |||||
| $effectiveDbPath = Get-DataSourceFromConfig -ConfigPath $currentConfigPath | |||||
| } | |||||
| if([string]::IsNullOrWhiteSpace($effectiveDbPath)){ | |||||
| throw 'No database path was provided and no existing Data Source could be read from the current web.config' | |||||
| } | |||||
| Write-Host "Stopping IIS site $SiteName and app pool $AppPool" | |||||
| try { Stop-Website -Name $SiteName } catch { } | |||||
| try { Stop-WebAppPool -Name $AppPool } catch { } | |||||
| Ensure-Dir (Split-Path $WorkDir -Parent) | |||||
| if((Test-Path $WorkDir) -and !(Test-Path (Join-Path $WorkDir '.git'))){ | |||||
| $bak = ($WorkDir.TrimEnd('\') + '_pre_git_' + (Get-Date -Format 'yyyyMMdd_HHmmss')) | |||||
| Write-Host "Existing non-git folder detected. Moving to $bak" | |||||
| Move-Item -Force $WorkDir $bak | |||||
| } | |||||
| if(!(Test-Path $WorkDir)){ | |||||
| Write-Host "Cloning $Repo -> $WorkDir" | |||||
| git clone $Repo $WorkDir | |||||
| } | |||||
| Push-Location $WorkDir | |||||
| try { | |||||
| Write-Host "Updating to origin/$Branch" | |||||
| git fetch origin | |||||
| git checkout $Branch | |||||
| & git reset --hard ("origin/" + $Branch) | |||||
| } finally { | |||||
| Pop-Location | |||||
| } | |||||
| if((Split-Path $WorkDir -Leaf).ToLower() -eq 'public'){ | |||||
| $WorkDir = Split-Path $WorkDir -Parent | |||||
| } | |||||
| $PublicDir = Join-Path $WorkDir 'public' | |||||
| $cfg = Join-Path $PublicDir 'web.config' | |||||
| Set-ItemProperty ('IIS:\Sites\' + $SiteName) -Name physicalPath -Value $PublicDir | |||||
| Set-ItemProperty ('IIS:\Sites\' + $SiteName) -Name applicationPool -Value $AppPool | |||||
| Set-ItemProperty ('IIS:\AppPools\' + $AppPool) -Name processModel.identityType -Value NetworkService | |||||
| Set-DataSourceInConfig -ConfigPath $cfg -EffectiveDbPath $effectiveDbPath | |||||
| $dbFolder = Split-Path $effectiveDbPath -Parent | |||||
| if(!(Test-Path $dbFolder)){ | |||||
| Ensure-Dir $dbFolder | |||||
| } | |||||
| icacls $dbFolder /grant ("IIS AppPool\" + $AppPool + ":(OI)(CI)(M)") /T | Out-Null | |||||
| Push-Location $WorkDir | |||||
| try { | |||||
| if($RunMigrations){ | |||||
| Write-Host 'Running standard migrations' | |||||
| cscript //nologo scripts\runMigrations.vbs up | |||||
| } | |||||
| if(-not $SkipLegacyIsBusinessMigration){ | |||||
| $legacyPath = Join-Path $WorkDir $LegacyMigrationScript | |||||
| if(!(Test-Path $legacyPath)){ | |||||
| throw "Legacy migration script not found: $legacyPath" | |||||
| } | |||||
| Write-Host 'Running legacy IsBusiness migration' | |||||
| cscript //nologo $legacyPath $effectiveDbPath | |||||
| } | |||||
| } finally { | |||||
| Pop-Location | |||||
| } | |||||
| if((Get-WebAppPoolState -Name $AppPool).Value -eq 'Started'){ | |||||
| Restart-WebAppPool -Name $AppPool | |||||
| } else { | |||||
| Start-WebAppPool -Name $AppPool | |||||
| } | |||||
| Start-Website $SiteName | |||||
| Start-Sleep -Seconds 1 | |||||
| $paths = @('/','/territories','/households','/householder-names') | |||||
| foreach($path in $paths){ | |||||
| $url = $BaseUrl + $path | |||||
| $response = Invoke-WebRequest -UseBasicParsing -Uri $url -TimeoutSec 30 | |||||
| Write-Host ("OK " + $path + ' -> ' + $response.StatusCode) | |||||
| } | |||||
| Write-Host 'Deploy complete.' | |||||
| } | |||||
| if($UseRemoteSsh -and !$RunRemoteCore -and [string]::IsNullOrWhiteSpace($RemoteTarget)){ | |||||
| $RemoteTarget = Get-DefaultRemoteTargetFromInfo | |||||
| } | |||||
| if($UseRemoteSsh -and !$RunRemoteCore -and -not [string]::IsNullOrWhiteSpace($RemoteTarget)){ | |||||
| Ensure-Command $SshExe | |||||
| Ensure-Command $ScpExe | |||||
| $remoteScriptPath = 'C:\Windows\Temp\deploy-test-territory-git.ps1' | |||||
| $scpDestination = "${RemoteTarget}:C:/Windows/Temp/deploy-test-territory-git.ps1" | |||||
| Write-Host "Copying deploy script to $RemoteTarget" | |||||
| & $ScpExe -P $RemotePort $PSCommandPath $scpDestination | |||||
| if($LASTEXITCODE -ne 0){ throw 'scp failed' } | |||||
| $remoteCommand = New-Object System.Collections.Generic.List[string] | |||||
| @( | |||||
| 'powershell', | |||||
| '-NoProfile', | |||||
| '-ExecutionPolicy', 'Bypass', | |||||
| '-File', (ConvertTo-CmdDoubleQuoted $remoteScriptPath), | |||||
| '-RunRemoteCore', | |||||
| '-Repo', (ConvertTo-CmdDoubleQuoted $Repo), | |||||
| '-Branch', (ConvertTo-CmdDoubleQuoted $Branch), | |||||
| '-SiteName', (ConvertTo-CmdDoubleQuoted $SiteName) | |||||
| ) | ForEach-Object { [void]$remoteCommand.Add($_) } | |||||
| if(-not [string]::IsNullOrWhiteSpace($AppPool)){ | |||||
| [void]$remoteCommand.Add('-AppPool') | |||||
| [void]$remoteCommand.Add((ConvertTo-CmdDoubleQuoted $AppPool)) | |||||
| } | |||||
| if(-not [string]::IsNullOrWhiteSpace($WorkDir)){ | |||||
| [void]$remoteCommand.Add('-WorkDir') | |||||
| [void]$remoteCommand.Add((ConvertTo-CmdDoubleQuoted $WorkDir)) | |||||
| } | |||||
| if(-not [string]::IsNullOrWhiteSpace($PublicDir)){ | |||||
| [void]$remoteCommand.Add('-PublicDir') | |||||
| [void]$remoteCommand.Add((ConvertTo-CmdDoubleQuoted $PublicDir)) | |||||
| } | |||||
| if(-not [string]::IsNullOrWhiteSpace($BaseUrl)){ | |||||
| [void]$remoteCommand.Add('-BaseUrl') | |||||
| [void]$remoteCommand.Add((ConvertTo-CmdDoubleQuoted $BaseUrl)) | |||||
| } | |||||
| if(-not [string]::IsNullOrWhiteSpace($DbPath)){ | |||||
| [void]$remoteCommand.Add('-DbPath') | |||||
| [void]$remoteCommand.Add((ConvertTo-CmdDoubleQuoted $DbPath)) | |||||
| } | |||||
| if(-not [string]::IsNullOrWhiteSpace($LegacyMigrationScript)){ | |||||
| [void]$remoteCommand.Add('-LegacyMigrationScript') | |||||
| [void]$remoteCommand.Add((ConvertTo-CmdDoubleQuoted $LegacyMigrationScript)) | |||||
| } | |||||
| if($RunMigrations){ $remoteCommand += '-RunMigrations' } | |||||
| if($SkipLegacyIsBusinessMigration){ $remoteCommand += '-SkipLegacyIsBusinessMigration' } | |||||
| Write-Host "Executing remote deploy on $RemoteTarget" | |||||
| & $SshExe -p $RemotePort $RemoteTarget ($remoteCommand -join ' ') | |||||
| if($LASTEXITCODE -ne 0){ throw 'remote deploy failed' } | |||||
| exit 0 | |||||
| } | |||||
| Invoke-DeployCore | |||||
| @@ -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 | |||||
| @@ -0,0 +1,90 @@ | |||||
| ' migrate_isbusiness_to_households.vbs | |||||
| ' Moves IsBusiness from HouseholderNames to Households. | |||||
| ' | |||||
| ' Usage: | |||||
| ' cscript //nologo scripts\migrate_isbusiness_to_households.vbs "C:\path\to\myAccessFile.accdb" | |||||
| ' | |||||
| ' What it does: | |||||
| ' 1) Adds Households.IsBusiness (SMALLINT) if missing | |||||
| ' 2) Copies data: sets Households.IsBusiness=1 if any related HouseholderNames.IsBusiness<>0 | |||||
| ' 3) Sets NULLs to 0 | |||||
| ' 4) Drops HouseholderNames.IsBusiness if present | |||||
| ' | |||||
| Option Explicit | |||||
| Dim dbPath | |||||
| If WScript.Arguments.Count < 1 Then | |||||
| WScript.Echo "ERROR: missing db path." | |||||
| WScript.Echo "Usage: cscript //nologo scripts\migrate_isbusiness_to_households.vbs ""C:\path\to\db.accdb""" | |||||
| WScript.Quit 1 | |||||
| End If | |||||
| dbPath = WScript.Arguments(0) | |||||
| Dim conn | |||||
| Set conn = CreateObject("ADODB.Connection") | |||||
| conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath & ";Persist Security Info=False;" | |||||
| On Error Resume Next | |||||
| If Not ColumnExists(conn, "Households", "IsBusiness") Then | |||||
| Exec conn, "ALTER TABLE [Households] ADD COLUMN [IsBusiness] SMALLINT" | |||||
| If Err.Number <> 0 Then | |||||
| WScript.Echo "ERROR adding Households.IsBusiness: " & Err.Description | |||||
| WScript.Quit 1 | |||||
| End If | |||||
| WScript.Echo "Added Households.IsBusiness" | |||||
| Else | |||||
| WScript.Echo "Households.IsBusiness already exists" | |||||
| End If | |||||
| ' Copy data (only if the old column exists) | |||||
| If ColumnExists(conn, "HouseholderNames", "IsBusiness") Then | |||||
| ' Normalize all existing households first so the column is never left NULL. | |||||
| Exec conn, "UPDATE [Households] SET [IsBusiness]=0" | |||||
| If Err.Number <> 0 Then | |||||
| WScript.Echo "ERROR initializing Households.IsBusiness: " & Err.Description | |||||
| WScript.Quit 1 | |||||
| End If | |||||
| ' Promote households to business when any related name was previously marked as a business. | |||||
| Exec conn, "UPDATE [Households] SET [IsBusiness]=1 WHERE [Id] IN (SELECT [HouseholdId] FROM [HouseholderNames] WHERE [IsBusiness]<>0)" | |||||
| If Err.Number <> 0 Then | |||||
| WScript.Echo "ERROR copying IsBusiness to Households: " & Err.Description | |||||
| WScript.Quit 1 | |||||
| End If | |||||
| WScript.Echo "Copied IsBusiness values to Households" | |||||
| Exec conn, "ALTER TABLE [HouseholderNames] DROP COLUMN [IsBusiness]" | |||||
| If Err.Number <> 0 Then | |||||
| WScript.Echo "ERROR dropping HouseholderNames.IsBusiness: " & Err.Description | |||||
| WScript.Quit 1 | |||||
| End If | |||||
| WScript.Echo "Dropped HouseholderNames.IsBusiness" | |||||
| Else | |||||
| WScript.Echo "HouseholderNames.IsBusiness does not exist; nothing to drop" | |||||
| End If | |||||
| conn.Close | |||||
| Set conn = Nothing | |||||
| WScript.Echo "Done." | |||||
| ' --- helpers --- | |||||
| Sub Exec(c, sql) | |||||
| Err.Clear | |||||
| c.Execute sql | |||||
| End Sub | |||||
| Function ColumnExists(c, tableName, colName) | |||||
| Dim rs | |||||
| ColumnExists = False | |||||
| Err.Clear | |||||
| Set rs = c.OpenSchema(4, Array(Empty, Empty, tableName, colName)) ' adSchemaColumns=4 | |||||
| If Err.Number <> 0 Then | |||||
| Err.Clear | |||||
| Exit Function | |||||
| End If | |||||
| If Not rs.EOF Then ColumnExists = True | |||||
| rs.Close | |||||
| Set rs = Nothing | |||||
| End Function | |||||
| @@ -0,0 +1,614 @@ | |||||
| '======================================================================================================================= | |||||
| ' MIGRATION RUNNER (Standalone VBScript) | |||||
| '======================================================================================================================= | |||||
| ' Runs database migrations directly via VBScript without requiring IIS/ASP. | |||||
| ' | |||||
| ' Usage: | |||||
| ' cscript //nologo scripts\runMigrations.vbs [command] | |||||
| ' | |||||
| ' Commands: | |||||
| ' up - Apply all pending migrations (default) | |||||
| ' down - Rollback the last migration | |||||
| ' status - Show migration status | |||||
| ' apply <file> - Apply a specific migration file | |||||
| ' rollback <file> - Rollback a specific migration file | |||||
| ' | |||||
| ' Examples: | |||||
| ' cscript //nologo scripts\runMigrations.vbs | |||||
| ' cscript //nologo scripts\runMigrations.vbs up | |||||
| ' cscript //nologo scripts\runMigrations.vbs down | |||||
| ' cscript //nologo scripts\runMigrations.vbs status | |||||
| ' | |||||
| Option Explicit | |||||
| Dim fso, scriptDir, projectRoot, webConfigPath, migrationsPath | |||||
| Dim connectionString, command, argument | |||||
| Set fso = CreateObject("Scripting.FileSystemObject") | |||||
| ' Get paths | |||||
| scriptDir = fso.GetParentFolderName(WScript.ScriptFullName) | |||||
| projectRoot = fso.GetAbsolutePathName(scriptDir & "\..") | |||||
| webConfigPath = projectRoot & "\public\web.config" | |||||
| migrationsPath = projectRoot & "\db\migrations" | |||||
| ' Parse arguments | |||||
| command = "up" ' default command | |||||
| If WScript.Arguments.Count > 0 Then | |||||
| command = LCase(WScript.Arguments(0)) | |||||
| End If | |||||
| If WScript.Arguments.Count > 1 Then | |||||
| argument = WScript.Arguments(1) | |||||
| End If | |||||
| ' Validate command | |||||
| Select Case command | |||||
| Case "up", "down", "status", "apply", "rollback" | |||||
| ' Valid command | |||||
| Case Else | |||||
| ShowUsage | |||||
| WScript.Quit 1 | |||||
| End Select | |||||
| ' Load connection string from web.config | |||||
| connectionString = GetConnectionString(webConfigPath) | |||||
| If connectionString = "" Then | |||||
| WScript.Echo "Error: Could not read connection string from web.config" | |||||
| WScript.Quit 1 | |||||
| End If | |||||
| ' Execute the command | |||||
| On Error Resume Next | |||||
| Select Case command | |||||
| Case "up" | |||||
| ApplyAllPending | |||||
| Case "down" | |||||
| RollbackLast | |||||
| Case "status" | |||||
| ShowStatus | |||||
| Case "apply" | |||||
| If argument = "" Then | |||||
| WScript.Echo "Error: No migration file specified" | |||||
| WScript.Echo "Usage: cscript //nologo scripts\runMigrations.vbs apply <filename>" | |||||
| WScript.Quit 1 | |||||
| End If | |||||
| ApplyMigration argument | |||||
| Case "rollback" | |||||
| If argument = "" Then | |||||
| WScript.Echo "Error: No migration file specified" | |||||
| WScript.Echo "Usage: cscript //nologo scripts\runMigrations.vbs rollback <filename>" | |||||
| WScript.Quit 1 | |||||
| End If | |||||
| RollbackMigration argument | |||||
| End Select | |||||
| If Err.Number <> 0 Then | |||||
| WScript.Echo "" | |||||
| WScript.Echo "ERROR: " & Err.Description | |||||
| WScript.Echo "Number: " & Err.Number | |||||
| WScript.Echo "Source: " & Err.Source | |||||
| WScript.Quit 1 | |||||
| End If | |||||
| WScript.Quit 0 | |||||
| '======================================================================================================================= | |||||
| ' MIGRATION FUNCTIONS | |||||
| '======================================================================================================================= | |||||
| Sub ApplyAllPending() | |||||
| WScript.Echo "==============================================================" | |||||
| WScript.Echo "APPLYING PENDING MIGRATIONS" | |||||
| WScript.Echo "==============================================================" | |||||
| WScript.Echo "" | |||||
| EnsureSchemaMigrationsTable | |||||
| Dim pending, version, versions(), i, j, temp | |||||
| Set pending = GetPendingMigrations() | |||||
| If pending.Count = 0 Then | |||||
| WScript.Echo "No pending migrations." | |||||
| WScript.Echo "" | |||||
| WScript.Echo "==============================================================" | |||||
| WScript.Echo "DONE" | |||||
| WScript.Echo "==============================================================" | |||||
| Exit Sub | |||||
| End If | |||||
| ' Sort versions | |||||
| ReDim versions(pending.Count - 1) | |||||
| i = 0 | |||||
| For Each version In pending.Keys | |||||
| versions(i) = version | |||||
| i = i + 1 | |||||
| Next | |||||
| ' Simple bubble sort (string comparison works for YYYYMMDDHHMMSS format) | |||||
| For i = 0 To UBound(versions) - 1 | |||||
| For j = i + 1 To UBound(versions) | |||||
| If versions(i) > 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 | |||||
| WScript.Echo "" | |||||
| WScript.Echo "==============================================================" | |||||
| WScript.Echo "DONE" | |||||
| WScript.Echo "==============================================================" | |||||
| End Sub | |||||
| Sub RollbackLast() | |||||
| WScript.Echo "==============================================================" | |||||
| WScript.Echo "ROLLING BACK LAST MIGRATION" | |||||
| WScript.Echo "==============================================================" | |||||
| WScript.Echo "" | |||||
| EnsureSchemaMigrationsTable | |||||
| Dim applied, available, version, lastVersion, filename | |||||
| Set applied = GetAppliedMigrations() | |||||
| If applied.Count = 0 Then | |||||
| WScript.Echo "No migrations to rollback." | |||||
| WScript.Echo "" | |||||
| WScript.Echo "==============================================================" | |||||
| WScript.Echo "DONE" | |||||
| WScript.Echo "==============================================================" | |||||
| Exit Sub | |||||
| End If | |||||
| ' Find the last version (string comparison works for YYYYMMDDHHMMSS format) | |||||
| lastVersion = "" | |||||
| For Each version In applied.Keys | |||||
| If lastVersion = "" Or version > lastVersion Then | |||||
| lastVersion = version | |||||
| End If | |||||
| Next | |||||
| ' Find the filename | |||||
| Set available = GetAvailableMigrations() | |||||
| If available.Exists(lastVersion) Then | |||||
| filename = available(lastVersion) | |||||
| RollbackMigration filename | |||||
| Else | |||||
| WScript.Echo "Error: Migration file not found for version: " & lastVersion | |||||
| WScript.Quit 1 | |||||
| End If | |||||
| WScript.Echo "" | |||||
| WScript.Echo "==============================================================" | |||||
| WScript.Echo "DONE" | |||||
| WScript.Echo "==============================================================" | |||||
| End Sub | |||||
| Sub ShowStatus() | |||||
| WScript.Echo "==============================================================" | |||||
| WScript.Echo "MIGRATION STATUS" | |||||
| WScript.Echo "==============================================================" | |||||
| WScript.Echo "" | |||||
| EnsureSchemaMigrationsTable | |||||
| Dim applied, pending, available, version | |||||
| Set applied = GetAppliedMigrations() | |||||
| Set pending = GetPendingMigrations() | |||||
| Set available = GetAvailableMigrations() | |||||
| WScript.Echo "Applied migrations: " & applied.Count | |||||
| If applied.Count > 0 Then | |||||
| For Each version In applied.Keys | |||||
| If available.Exists(version) Then | |||||
| WScript.Echo " [X] " & available(version) | |||||
| Else | |||||
| WScript.Echo " [X] " & version & " (file not found)" | |||||
| End If | |||||
| Next | |||||
| End If | |||||
| WScript.Echo "" | |||||
| WScript.Echo "Pending migrations: " & pending.Count | |||||
| If pending.Count > 0 Then | |||||
| For Each version In pending.Keys | |||||
| WScript.Echo " [ ] " & pending(version) | |||||
| Next | |||||
| End If | |||||
| WScript.Echo "" | |||||
| WScript.Echo "==============================================================" | |||||
| End Sub | |||||
| 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 | |||||
| WScript.Echo "Migration " & version & " already applied. Skipping." | |||||
| Exit Sub | |||||
| End If | |||||
| WScript.Echo "Applying migration: " & filename & "..." | |||||
| ' Execute the migration | |||||
| ' NOTE: Access/Jet does NOT support DDL (CREATE TABLE, etc.) inside transactions | |||||
| ' So we run without transaction wrapper and rely on error checking instead | |||||
| Dim conn, migrationSuccess | |||||
| Set conn = GetConnection() | |||||
| On Error Resume Next | |||||
| migrationSuccess = ExecuteMigrationFile(filename, "Up", conn) | |||||
| If Err.Number <> 0 Then | |||||
| WScript.Echo "ERROR: Migration failed - " & Err.Description | |||||
| WScript.Echo "Error Number: " & Err.Number | |||||
| conn.Close | |||||
| Err.Raise vbObjectError + 2, "Migrator", "Migration failed: " & Err.Description | |||||
| End If | |||||
| On Error GoTo 0 | |||||
| ' Check if migration had SQL errors | |||||
| If Not migrationSuccess Then | |||||
| WScript.Echo "" | |||||
| WScript.Echo "ERROR: Migration failed due to SQL errors (see above)." | |||||
| WScript.Echo "Migration NOT recorded. Please fix the migration and try again." | |||||
| conn.Close | |||||
| WScript.Quit 1 | |||||
| End If | |||||
| ' Record the migration | |||||
| On Error Resume Next | |||||
| Dim cmd | |||||
| Set cmd = CreateObject("ADODB.Command") | |||||
| Set cmd.ActiveConnection = conn | |||||
| cmd.CommandText = "INSERT INTO schema_migrations (version, applied_at) VALUES (?, ?)" | |||||
| cmd.Execute , Array(version, Now()) | |||||
| If Err.Number <> 0 Then | |||||
| WScript.Echo "ERROR: Failed to record migration - " & Err.Description | |||||
| conn.Close | |||||
| Err.Raise vbObjectError + 3, "Migrator", "Failed to record migration: " & Err.Description | |||||
| End If | |||||
| On Error GoTo 0 | |||||
| conn.Close | |||||
| WScript.Echo "Migration " & version & " applied successfully." | |||||
| End Sub | |||||
| 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 | |||||
| WScript.Echo "Migration " & version & " not applied. Skipping." | |||||
| Exit Sub | |||||
| End If | |||||
| WScript.Echo "Rolling back migration: " & filename & "..." | |||||
| ' Execute the migration | |||||
| ' NOTE: Access/Jet does NOT support DDL (DROP TABLE, etc.) inside transactions | |||||
| Dim conn, rollbackSuccess | |||||
| Set conn = GetConnection() | |||||
| On Error Resume Next | |||||
| rollbackSuccess = ExecuteMigrationFile(filename, "Down", conn) | |||||
| If Err.Number <> 0 Then | |||||
| WScript.Echo "ERROR: Rollback failed - " & Err.Description | |||||
| WScript.Echo "Error Number: " & Err.Number | |||||
| conn.Close | |||||
| Err.Raise vbObjectError + 4, "Migrator", "Rollback failed: " & Err.Description | |||||
| End If | |||||
| On Error GoTo 0 | |||||
| ' Check if rollback had SQL errors | |||||
| If Not rollbackSuccess Then | |||||
| WScript.Echo "" | |||||
| WScript.Echo "ERROR: Rollback failed due to SQL errors (see above)." | |||||
| WScript.Echo "Migration record NOT removed. Please fix the issue manually." | |||||
| conn.Close | |||||
| WScript.Quit 1 | |||||
| End If | |||||
| ' Remove migration record | |||||
| On Error Resume Next | |||||
| Dim cmd | |||||
| Set cmd = CreateObject("ADODB.Command") | |||||
| Set cmd.ActiveConnection = conn | |||||
| cmd.CommandText = "DELETE FROM schema_migrations WHERE version = ?" | |||||
| cmd.Execute , Array(version) | |||||
| If Err.Number <> 0 Then | |||||
| WScript.Echo "ERROR: Failed to remove migration record - " & Err.Description | |||||
| conn.Close | |||||
| Err.Raise vbObjectError + 5, "Migrator", "Failed to remove migration record: " & Err.Description | |||||
| End If | |||||
| On Error GoTo 0 | |||||
| conn.Close | |||||
| WScript.Echo "Migration " & version & " rolled back successfully." | |||||
| End Sub | |||||
| '======================================================================================================================= | |||||
| ' HELPER FUNCTIONS | |||||
| '======================================================================================================================= | |||||
| Sub ShowUsage() | |||||
| WScript.Echo "Usage: cscript //nologo scripts\runMigrations.vbs [command]" | |||||
| WScript.Echo "" | |||||
| WScript.Echo "Commands:" | |||||
| WScript.Echo " up - Apply all pending migrations (default)" | |||||
| WScript.Echo " down - Rollback the last migration" | |||||
| WScript.Echo " status - Show migration status" | |||||
| WScript.Echo " apply <file> - Apply a specific migration file" | |||||
| WScript.Echo " rollback <file> - Rollback a specific migration file" | |||||
| WScript.Echo "" | |||||
| WScript.Echo "Examples:" | |||||
| WScript.Echo " cscript //nologo scripts\runMigrations.vbs" | |||||
| WScript.Echo " cscript //nologo scripts\runMigrations.vbs up" | |||||
| WScript.Echo " cscript //nologo scripts\runMigrations.vbs down" | |||||
| WScript.Echo " cscript //nologo scripts\runMigrations.vbs status" | |||||
| End Sub | |||||
| Function GetConnectionString(configPath) | |||||
| If Not fso.FileExists(configPath) Then | |||||
| GetConnectionString = "" | |||||
| Exit Function | |||||
| End If | |||||
| Dim xmlDoc, node | |||||
| Set xmlDoc = CreateObject("Microsoft.XMLDOM") | |||||
| xmlDoc.async = False | |||||
| xmlDoc.load configPath | |||||
| Set node = xmlDoc.selectSingleNode("//appSettings/add[@key='ConnectionString']/@value") | |||||
| If node Is Nothing Then | |||||
| GetConnectionString = "" | |||||
| Else | |||||
| GetConnectionString = node.text | |||||
| End If | |||||
| End Function | |||||
| Function GetConnection() | |||||
| Dim conn | |||||
| Set conn = CreateObject("ADODB.Connection") | |||||
| conn.Open connectionString | |||||
| Set GetConnection = conn | |||||
| End Function | |||||
| Sub EnsureSchemaMigrationsTable() | |||||
| Dim conn, rs | |||||
| Set conn = GetConnection() | |||||
| On Error Resume Next | |||||
| Set rs = conn.Execute("SELECT TOP 1 version FROM schema_migrations") | |||||
| If Err.Number <> 0 Then | |||||
| ' Table doesn't exist, create it | |||||
| Err.Clear | |||||
| On Error GoTo 0 | |||||
| conn.Execute "CREATE TABLE schema_migrations (" & _ | |||||
| "version VARCHAR(14) PRIMARY KEY, " & _ | |||||
| "applied_at DATETIME NOT NULL)" | |||||
| Else | |||||
| If Not rs Is Nothing Then | |||||
| If Not rs.EOF Then rs.Close | |||||
| End If | |||||
| End If | |||||
| conn.Close | |||||
| On Error GoTo 0 | |||||
| End Sub | |||||
| Function GetAppliedMigrations() | |||||
| Dim conn, rs, versions, version | |||||
| Set conn = GetConnection() | |||||
| Set versions = CreateObject("Scripting.Dictionary") | |||||
| Set rs = conn.Execute("SELECT version FROM schema_migrations ORDER BY version") | |||||
| Do While Not rs.EOF | |||||
| version = Trim(rs("version")) | |||||
| versions.Add version, True | |||||
| rs.MoveNext | |||||
| Loop | |||||
| rs.Close | |||||
| conn.Close | |||||
| Set GetAppliedMigrations = versions | |||||
| End Function | |||||
| Function GetAvailableMigrations() | |||||
| Dim folder, files, file, migrations, version | |||||
| Set migrations = CreateObject("Scripting.Dictionary") | |||||
| If Not fso.FolderExists(migrationsPath) Then | |||||
| Set GetAvailableMigrations = migrations | |||||
| Exit Function | |||||
| End If | |||||
| Set folder = fso.GetFolder(migrationsPath) | |||||
| Set files = folder.Files | |||||
| For Each file In files | |||||
| If LCase(fso.GetExtensionName(file.Name)) = "asp" Then | |||||
| version = GetVersionFromFilename(file.Name) | |||||
| If version <> "" Then | |||||
| migrations.Add version, file.Name | |||||
| End If | |||||
| End If | |||||
| Next | |||||
| Set GetAvailableMigrations = migrations | |||||
| End Function | |||||
| Function GetPendingMigrations() | |||||
| Dim applied, available, pending, version | |||||
| Set applied = GetAppliedMigrations() | |||||
| Set available = GetAvailableMigrations() | |||||
| Set pending = 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 | |||||
| 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 | |||||
| ' Global variable to hold migration context for error checking | |||||
| Dim g_migrationContext | |||||
| Function ExecuteMigrationFile(filename, direction, conn) | |||||
| Dim migrationPath, fileContent, migration | |||||
| migrationPath = migrationsPath & "\" & filename | |||||
| If Not fso.FileExists(migrationPath) Then | |||||
| Err.Raise vbObjectError + 6, "Migrator", "Migration file not found: " & migrationPath | |||||
| End If | |||||
| ' Create migration context | |||||
| Set migration = New MigrationContext | |||||
| Set migration.Connection = conn | |||||
| Set g_migrationContext = migration ' Store globally for error checking | |||||
| ' Read and execute the migration file | |||||
| Dim stream | |||||
| Set stream = fso.OpenTextFile(migrationPath, 1) | |||||
| fileContent = stream.ReadAll | |||||
| stream.Close | |||||
| ' Remove ASP tags | |||||
| fileContent = Replace(fileContent, "<%", "") | |||||
| fileContent = Replace(fileContent, "%>", "") | |||||
| ' Execute the migration code | |||||
| ExecuteGlobal fileContent | |||||
| ' Call the appropriate method | |||||
| If direction = "Up" Then | |||||
| Migration_Up migration | |||||
| ElseIf direction = "Down" Then | |||||
| Migration_Down migration | |||||
| End If | |||||
| ' Return True if successful, False if error | |||||
| ExecuteMigrationFile = Not migration.HasError | |||||
| End Function | |||||
| '======================================================================================================================= | |||||
| ' MIGRATION CONTEXT CLASS | |||||
| '======================================================================================================================= | |||||
| Class MigrationContext | |||||
| Public Connection | |||||
| Public HasError | |||||
| Public LastErrorMessage | |||||
| Public LastErrorNumber | |||||
| Private Sub Class_Initialize() | |||||
| HasError = False | |||||
| LastErrorMessage = "" | |||||
| LastErrorNumber = 0 | |||||
| End Sub | |||||
| Public Sub ExecuteSQL(sql) | |||||
| If HasError Then Exit Sub ' Skip if previous error occurred | |||||
| On Error Resume Next | |||||
| Connection.Execute sql | |||||
| If Err.Number <> 0 Then | |||||
| HasError = True | |||||
| LastErrorNumber = Err.Number | |||||
| LastErrorMessage = "SQL Error: " & Err.Description & " (Error " & Err.Number & ")" & vbCrLf & "SQL: " & sql | |||||
| WScript.Echo " ERROR executing SQL: " & Err.Description | |||||
| WScript.Echo " Error Number: " & Err.Number | |||||
| WScript.Echo " SQL: " & sql | |||||
| Err.Clear | |||||
| End If | |||||
| On Error GoTo 0 | |||||
| End Sub | |||||
| Public Sub CreateTable(tableName, columns) | |||||
| If HasError Then Exit Sub | |||||
| WScript.Echo " Creating table: " & tableName | |||||
| ExecuteSQL "CREATE TABLE " & tableName & " (" & columns & ")" | |||||
| End Sub | |||||
| Public Sub DropTable(tableName) | |||||
| If HasError Then Exit Sub | |||||
| WScript.Echo " Dropping table: " & tableName | |||||
| ExecuteSQL "DROP TABLE " & tableName | |||||
| End Sub | |||||
| Public Sub AddColumn(tableName, columnName, columnType) | |||||
| If HasError Then Exit Sub | |||||
| WScript.Echo " Adding column: " & tableName & "." & columnName | |||||
| ExecuteSQL "ALTER TABLE " & tableName & " ADD COLUMN " & columnName & " " & columnType | |||||
| End Sub | |||||
| Public Sub DropColumn(tableName, columnName) | |||||
| If HasError Then Exit Sub | |||||
| WScript.Echo " Dropping column: " & tableName & "." & columnName | |||||
| ExecuteSQL "ALTER TABLE " & tableName & " DROP COLUMN " & columnName | |||||
| End Sub | |||||
| Public Sub CreateIndex(indexName, tableName, columns) | |||||
| If HasError Then Exit Sub | |||||
| WScript.Echo " Creating index: " & indexName & " on " & tableName | |||||
| ExecuteSQL "CREATE INDEX " & indexName & " ON " & tableName & " (" & columns & ")" | |||||
| End Sub | |||||
| Public Sub DropIndex(indexName, tableName) | |||||
| If HasError Then Exit Sub | |||||
| WScript.Echo " Dropping index: " & indexName & " on " & tableName | |||||
| ExecuteSQL "DROP INDEX " & indexName & " ON " & tableName | |||||
| End Sub | |||||
| Public Function DB() | |||||
| Set DB = Me | |||||
| End Function | |||||
| End Class | |||||
| @@ -0,0 +1,190 @@ | |||||
| <% | |||||
| Class PlainRunnerTheme | |||||
| Public Sub Render(ByRef objRunner) | |||||
| %> | |||||
| <!DOCTYPE html> | |||||
| <html> | |||||
| <head> | |||||
| <meta charset="utf-8"> | |||||
| <title>MVC-Starter Test Runner</title> | |||||
| <style type="text/css"> | |||||
| body { | |||||
| font-family: Arial, sans-serif; | |||||
| margin: 24px; | |||||
| color: #1f2933; | |||||
| background: #f7fafc; | |||||
| } | |||||
| h1 { | |||||
| margin-bottom: 8px; | |||||
| } | |||||
| .summary { | |||||
| margin-bottom: 16px; | |||||
| padding: 12px 16px; | |||||
| background: #ffffff; | |||||
| border: 1px solid #d9e2ec; | |||||
| } | |||||
| .page { | |||||
| margin-bottom: 16px; | |||||
| padding: 12px 16px; | |||||
| border: 1px solid #bcccdc; | |||||
| background: #ffffff; | |||||
| } | |||||
| .page.pass { | |||||
| border-left: 6px solid #2f855a; | |||||
| } | |||||
| .page.fail { | |||||
| border-left: 6px solid #c53030; | |||||
| } | |||||
| .module { | |||||
| margin-top: 12px; | |||||
| padding-top: 8px; | |||||
| border-top: 1px solid #e2e8f0; | |||||
| } | |||||
| .test { | |||||
| margin: 6px 0; | |||||
| } | |||||
| .pass-text { | |||||
| color: #2f855a; | |||||
| } | |||||
| .fail-text { | |||||
| color: #c53030; | |||||
| } | |||||
| code { | |||||
| background: #edf2f7; | |||||
| padding: 2px 4px; | |||||
| } | |||||
| </style> | |||||
| </head> | |||||
| <body> | |||||
| <h1>MVC-Starter Test Runner</h1> | |||||
| <p>Dev-only aspunit runner for the separate <code>tests/</code> IIS application.</p> | |||||
| <div id="summary" class="summary">Running tests...</div> | |||||
| <div id="results"></div> | |||||
| <script type="text/javascript"> | |||||
| (function() { | |||||
| var pages = [<%= GetPagesAsJSArray(objRunner.Pages) %>]; | |||||
| var summaryEl = document.getElementById("summary"); | |||||
| var resultsEl = document.getElementById("results"); | |||||
| var totals = { pages: 0, passedPages: 0, tests: 0, passedTests: 0 }; | |||||
| function escapeHtml(value) { | |||||
| return String(value) | |||||
| .replace(/&/g, "&") | |||||
| .replace(/</g, "<") | |||||
| .replace(/>/g, ">") | |||||
| .replace(/"/g, """) | |||||
| .replace(/'/g, "'"); | |||||
| } | |||||
| function renderModule(module) { | |||||
| var testsHtml = module.tests.map(function(test) { | |||||
| return '<div class="test ' + (test.passed ? 'pass-text' : 'fail-text') + '">' + | |||||
| '<strong>' + escapeHtml(test.name) + ':</strong> ' + | |||||
| escapeHtml(test.description || '') + | |||||
| '</div>'; | |||||
| }).join(""); | |||||
| return '<div class="module">' + | |||||
| '<div><strong>' + escapeHtml(module.name) + '</strong> (' + module.passCount + '/' + module.testCount + ')</div>' + | |||||
| testsHtml + | |||||
| '</div>'; | |||||
| } | |||||
| function renderPage(page, data, error) { | |||||
| var wrapper = document.createElement("div"); | |||||
| wrapper.className = "page " + (error || !data.passed ? "fail" : "pass"); | |||||
| if (error) { | |||||
| wrapper.innerHTML = | |||||
| '<div><strong>' + escapeHtml(page) + '</strong></div>' + | |||||
| '<div class="fail-text">' + escapeHtml(error) + '</div>'; | |||||
| resultsEl.appendChild(wrapper); | |||||
| return; | |||||
| } | |||||
| wrapper.innerHTML = | |||||
| '<div><strong>' + escapeHtml(page) + '</strong> - ' + | |||||
| (data.passed ? '<span class="pass-text">PASS</span>' : '<span class="fail-text">FAIL</span>') + | |||||
| ' (' + data.passCount + '/' + data.testCount + ')</div>' + | |||||
| data.modules.map(renderModule).join(""); | |||||
| resultsEl.appendChild(wrapper); | |||||
| } | |||||
| function updateSummary(done) { | |||||
| summaryEl.innerHTML = | |||||
| '<strong>Pages:</strong> ' + totals.passedPages + '/' + totals.pages + | |||||
| ' <strong>Tests:</strong> ' + totals.passedTests + '/' + totals.tests + | |||||
| (done ? '' : ' <em>Running...</em>'); | |||||
| } | |||||
| function next(index) { | |||||
| if (index >= pages.length) { | |||||
| updateSummary(true); | |||||
| return; | |||||
| } | |||||
| var page = pages[index]; | |||||
| fetch(page + '?task=test', { credentials: 'same-origin' }) | |||||
| .then(function(response) { | |||||
| if (!response.ok) { | |||||
| throw new Error('HTTP ' + response.status + ' while loading ' + page); | |||||
| } | |||||
| return response.json(); | |||||
| }) | |||||
| .then(function(data) { | |||||
| totals.pages += 1; | |||||
| totals.tests += data.testCount; | |||||
| totals.passedTests += data.passCount; | |||||
| if (data.passed) { | |||||
| totals.passedPages += 1; | |||||
| } | |||||
| renderPage(page, data, null); | |||||
| updateSummary(false); | |||||
| next(index + 1); | |||||
| }) | |||||
| .catch(function(error) { | |||||
| totals.pages += 1; | |||||
| renderPage(page, null, error.message); | |||||
| updateSummary(false); | |||||
| next(index + 1); | |||||
| }); | |||||
| } | |||||
| updateSummary(false); | |||||
| next(0); | |||||
| })(); | |||||
| </script> | |||||
| </body> | |||||
| </html> | |||||
| <% | |||||
| End Sub | |||||
| Private Function GetPagesAsJSArray(ByRef pages) | |||||
| Dim strReturn, i | |||||
| strReturn = "" | |||||
| For i = 0 To (pages.Count - 1) | |||||
| strReturn = strReturn & """" & Replace(pages.Item(i), """", "\""") & """" | |||||
| If i < (pages.Count - 1) Then | |||||
| strReturn = strReturn & ", " | |||||
| End If | |||||
| Next | |||||
| GetPagesAsJSArray = strReturn | |||||
| End Function | |||||
| End Class | |||||
| %> | |||||
| @@ -0,0 +1,21 @@ | |||||
| The MIT License | |||||
| Copyright (c) 2013 R. Peter Clark, Inc. http://www.rpeterclark.com | |||||
| Permission is hereby granted, free of charge, to any person obtaining a copy | |||||
| of this software and associated documentation files (the "Software"), to deal | |||||
| in the Software without restriction, including without limitation the rights | |||||
| to use, copy, modify, merge, publish, distribute, sublicense, and/or sell | |||||
| copies of the Software, and to permit persons to whom the Software is | |||||
| furnished to do so, subject to the following conditions: | |||||
| The above copyright notice and this permission notice shall be included in | |||||
| all copies or substantial portions of the Software. | |||||
| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR | |||||
| IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, | |||||
| FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE | |||||
| AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER | |||||
| LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, | |||||
| OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN | |||||
| THE SOFTWARE. | |||||
| @@ -0,0 +1,12 @@ | |||||
| <!-- #include file="classes/ASPUnitLibrary.asp" --> | |||||
| <!-- #include file="classes/ASPUnitTester.asp" --> | |||||
| <!-- #include file="classes/ASPUnitRunner.asp" --> | |||||
| <!-- #include file="classes/ASPUnitUIModern.asp" --> | |||||
| <!-- #include file="classes/ASPUnitJSONResponder.asp" --> | |||||
| <% | |||||
| Dim ASPUnit | |||||
| Set ASPUnit = New ASPUnitLibrary | |||||
| ASPUnit.Task = Request.QueryString("task") | |||||
| %> | |||||
| @@ -0,0 +1,123 @@ | |||||
| <% | |||||
| Class ASPUnitJSONResponder | |||||
| Private _ | |||||
| m_Serializer | |||||
| Private Sub Class_Initialize() | |||||
| Set m_Serializer = New ASPUnitScenarioSerializer | |||||
| End Sub | |||||
| Private Sub Class_Terminate() | |||||
| Set m_Serializer = Nothing | |||||
| End Sub | |||||
| Public Property Set Serializer(objValue) | |||||
| Set m_Serializer = objValue | |||||
| End Property | |||||
| Public Sub Respond(objModules) | |||||
| Response.ContentType = "application/json" | |||||
| Response.Write m_Serializer.ToJSON(objModules) | |||||
| End Sub | |||||
| End Class | |||||
| ' Private Classes | |||||
| Class ASPUnitScenarioSerializer | |||||
| Function ToJSON(objScenario) | |||||
| Dim objStream, _ | |||||
| objModule, _ | |||||
| objTest, _ | |||||
| i, j, _ | |||||
| strReturn | |||||
| Set objStream = Server.CreateObject("ADODB.Stream") | |||||
| objStream.Type = 2 ' adTypeText | |||||
| objStream.Mode = 3 ' adModeReadWrite | |||||
| objStream.Open | |||||
| Call objStream.WriteText("{") | |||||
| Call objStream.WriteText(JSONNumberPair("testCount", objScenario.TestCount) & ",") | |||||
| Call objStream.WriteText(JSONNumberPair("passCount", objScenario.PassCount) & ",") | |||||
| Call objStream.WriteText(JSONBooleanPair("passed", objScenario.Passed) & ",") | |||||
| Call objStream.WriteText(JSONString("modules") & ":[") | |||||
| For i = 0 To (objScenario.Modules.Count - 1) | |||||
| Set objModule = objScenario.Modules.Item(i) | |||||
| Call objStream.WriteText("{") | |||||
| Call objStream.WriteText(JSONStringPair("name", objModule.Name) & ",") | |||||
| Call objStream.WriteText(JSONNumberPair("testCount", objModule.TestCount) & ",") | |||||
| Call objStream.WriteText(JSONNumberPair("passCount", objModule.PassCount) & ",") | |||||
| Call objStream.WriteText(JSONNumberPair("failCount", (objModule.FailCount)) & ",") | |||||
| Call objStream.WriteText(JSONBooleanPair("passed", objModule.Passed) & ",") | |||||
| Call objStream.WriteText(JSONNumberPair("duration", objModule.Duration) & ",") | |||||
| Call objStream.WriteText(JSONString("tests") & ":[") | |||||
| For j = 0 To (objModule.Tests.Count - 1) | |||||
| Set objTest = objModule.Tests.Item(j) | |||||
| Call objStream.WriteText("{") | |||||
| Call objStream.WriteText(JSONStringPair("name", objTest.Name) & ",") | |||||
| Call objStream.WriteText(JSONBooleanPair("passed", objTest.Passed) & ",") | |||||
| Call objStream.WriteText(JSONStringPair("description", objTest.Description)) | |||||
| Call objStream.WriteText("}") | |||||
| If j < (objModule.Tests.Count - 1) Then | |||||
| Call objStream.WriteText(",") | |||||
| End If | |||||
| Set objTest = Nothing | |||||
| Next | |||||
| Call objStream.WriteText("]") | |||||
| Call objStream.WriteText("}") | |||||
| If i < (objScenario.Modules.Count - 1) Then | |||||
| Call objStream.WriteText(",") | |||||
| End If | |||||
| Set objModule = Nothing | |||||
| Next | |||||
| Call objStream.WriteText("]") | |||||
| Call objStream.WriteText("}") | |||||
| objStream.Position = 0 | |||||
| strReturn = objStream.ReadText() | |||||
| objStream.Close | |||||
| Set objStream = Nothing | |||||
| ToJSON = strReturn | |||||
| End Function | |||||
| Private Function JSONString(strValue) | |||||
| JSONString = """" & JSONStringEscape(strValue) & """" | |||||
| End Function | |||||
| Private Function JSONStringPair(strName, strValue) | |||||
| JSONStringPair = JSONString(strName) & ":" & JSONString(strValue) | |||||
| End Function | |||||
| Private Function JSONNumberPair(strName, varValue) | |||||
| JSONNumberPair = JSONString(strName) & ":" & varValue | |||||
| End Function | |||||
| Private Function JSONBooleanPair(strName, blnValue) | |||||
| JSONBooleanPair = JSONString(strName) & ":" & LCase(blnValue) | |||||
| End Function | |||||
| Private Function JSONStringEscape(strValue) | |||||
| Dim strReturn | |||||
| strReturn = strValue | |||||
| strReturn = Replace(strReturn, "\", "\\") | |||||
| strReturn = Replace(strReturn, """", "\""") | |||||
| strReturn = Replace(strReturn, vbLf, "\n") | |||||
| strReturn = Replace(strReturn, vbCr, "\n") | |||||
| strReturn = Replace(strReturn, vbCrLf, "\n") | |||||
| strReturn = Replace(strReturn, vbTab, "\t") | |||||
| JSONStringEscape = strReturn | |||||
| End Function | |||||
| End Class | |||||
| %> | |||||
| @@ -0,0 +1,104 @@ | |||||
| <% | |||||
| Class ASPUnitLibrary | |||||
| Private _ | |||||
| m_Runner, _ | |||||
| m_Tester, _ | |||||
| m_Task | |||||
| Public _ | |||||
| Version | |||||
| Private Sub Class_Initialize() | |||||
| Version = "0.1.0" | |||||
| Set m_Runner = New ASPUnitRunner | |||||
| Set m_Tester = New ASPUnitTester | |||||
| End Sub | |||||
| Private Sub Class_Terminate() | |||||
| Set m_Runner = Nothing | |||||
| Set m_Tester = Nothing | |||||
| End Sub | |||||
| Public Property Set Runner(ByRef objValue) | |||||
| Set m_Runner = objValue | |||||
| End Property | |||||
| Public Property Set Tester(ByRef objValue) | |||||
| Set m_Tester = objValue | |||||
| End Property | |||||
| Public Property Let Task(strTask) | |||||
| m_Task = strTask | |||||
| End Property | |||||
| Public Sub Run() | |||||
| Select Case UCase(m_Task) | |||||
| Case "TEST" | |||||
| Call m_Tester.Run() | |||||
| Case Else | |||||
| Call m_Runner.Run() | |||||
| End Select | |||||
| End Sub | |||||
| ' Test Service Facade | |||||
| Public Property Set Responder(ByRef objValue) | |||||
| Set m_Tester.Responder = objValue | |||||
| End Property | |||||
| Public Function CreateModule(strName, arrTests, objLifecycle) | |||||
| Set CreateModule = m_Tester.CreateModule(strName, arrTests, objLifecycle) | |||||
| End Function | |||||
| Public Function CreateTest(strName) | |||||
| Set CreateTest = m_Tester.CreateTest(strName) | |||||
| End Function | |||||
| Public Function CreateLifecycle(strSetup, strTeardown) | |||||
| Set CreateLifecycle = m_Tester.CreateLifecycle(strSetup, strTeardown) | |||||
| End Function | |||||
| Public Sub AddModule(objModule) | |||||
| Call m_Tester.AddModule(objModule) | |||||
| End Sub | |||||
| Public Sub AddModules(arrModules) | |||||
| Call m_Tester.AddModules(arrModules) | |||||
| End Sub | |||||
| Public Function Ok(blnResult, strDescription) | |||||
| Call m_Tester.Ok(blnResult, strDescription) | |||||
| End Function | |||||
| Public Function Equal(varActual, varExpected, strDescription) | |||||
| Call m_Tester.Equal(varActual, varExpected, strDescription) | |||||
| End Function | |||||
| Public Function NotEqual(varActual, varExpected, strDescription) | |||||
| Call m_Tester.NotEqual(varActual, varExpected, strDescription) | |||||
| End Function | |||||
| Public Function Same(varActual, varExpected, strDescription) | |||||
| Call m_Tester.Same(varActual, varExpected, strDescription) | |||||
| End Function | |||||
| Public Function NotSame(varActual, varExpected, strDescription) | |||||
| Call m_Tester.NotSame(varActual, varExpected, strDescription) | |||||
| End Function | |||||
| ' UI Service Facade | |||||
| Public Property Set Theme(ByRef objValue) | |||||
| Set m_Runner.Theme = objValue | |||||
| End Property | |||||
| Public Sub AddPage(strPage) | |||||
| Call m_Runner.AddPage(strPage) | |||||
| End Sub | |||||
| Public Sub AddPages(arrPages) | |||||
| Call m_Runner.AddPages(arrPages) | |||||
| End Sub | |||||
| End Class | |||||
| %> | |||||
| @@ -0,0 +1,174 @@ | |||||
| <% | |||||
| Class ASPUnitRunner | |||||
| Private _ | |||||
| m_Theme, _ | |||||
| m_Pages | |||||
| Private Sub Class_Initialize() | |||||
| Set m_Theme = New ASPUnitUIModern | |||||
| Set m_Pages = Server.CreateObject("System.Collections.ArrayList") | |||||
| End Sub | |||||
| Private Sub Class_Terminate() | |||||
| Set m_Pages = Nothing | |||||
| Set m_Theme = Nothing | |||||
| End Sub | |||||
| Public Property Set Theme(ByRef objValue) | |||||
| Set m_Theme = objValue | |||||
| End Property | |||||
| Public Property Get Pages | |||||
| Set Pages = m_Pages | |||||
| End Property | |||||
| ' Public methods to specify test pages | |||||
| Public Sub AddPage(strPage) | |||||
| Call m_Pages.Add(strPage) | |||||
| End Sub | |||||
| Public Sub AddPages(arrPages) | |||||
| Dim i | |||||
| For i = 0 To UBound(arrPages) | |||||
| Call AddPage(arrPages(i)) | |||||
| Next | |||||
| End Sub | |||||
| ' Method to run UI | |||||
| Public Sub Run() | |||||
| If m_Pages.Count = 0 Then | |||||
| Call AddCurrentPage() | |||||
| End If | |||||
| Call m_Theme.Render(Me) | |||||
| End Sub | |||||
| Private Sub AddCurrentPage() | |||||
| Call AddPage(Request.ServerVariables("URL")) | |||||
| End Sub | |||||
| Public Sub RenderJSLib() %> | |||||
| <script> | |||||
| var ASPUnit = function() { | |||||
| 'use strict'; | |||||
| var config = { | |||||
| pages: [], | |||||
| callbacks: { | |||||
| onStart: [], | |||||
| onStop: [], | |||||
| onPageStart: [], | |||||
| onPageSuccess: [], | |||||
| onPageFail: [], | |||||
| onPageFinish: [], | |||||
| onFinish: [], | |||||
| } | |||||
| } | |||||
| var getPageTimeout = null, | |||||
| getPageXHR = null; | |||||
| var status = { | |||||
| pageIndex: 0, | |||||
| pageCount: 0, | |||||
| testCount: 0, | |||||
| passCount: 0 | |||||
| }; | |||||
| function registerCallback(key, callback) { | |||||
| config.callbacks[key].push(callback); | |||||
| } | |||||
| function callback(key, args) { | |||||
| var callbacks = config.callbacks[key]; | |||||
| for (var i = 0, len = callbacks.length; i < len; i++) { | |||||
| callbacks[i].call({}, args); | |||||
| } | |||||
| } | |||||
| function getPage(page) { | |||||
| callback('onPageStart', {page: page}); | |||||
| getPageXHR = $.getJSON(page + '?task=test') | |||||
| .done(function(data) { | |||||
| status.pageDoneCount++; | |||||
| status.testCount += data.testCount; | |||||
| status.passCount += data.passCount; | |||||
| callback('onPageSuccess', $.extend({page: page}, data)); | |||||
| }) | |||||
| .fail(function(jqXHR, textStatus, errorThrown) { | |||||
| callback('onPageFail', { | |||||
| page: page, | |||||
| error: errorThrown, | |||||
| description: (jqXHR.status != 404) ? jqXHR.responseText : '' | |||||
| }); | |||||
| }) | |||||
| .always(function() { | |||||
| callback('onPageFinish', { | |||||
| page: page, | |||||
| status: status | |||||
| }); | |||||
| if (status.pageIndex < (config.pages.length - 1)) { | |||||
| getPageTimeout = setTimeout(function() { | |||||
| getPage(config.pages[++status.pageIndex]); | |||||
| }, 100); | |||||
| } else { | |||||
| callback('onFinish'); | |||||
| } | |||||
| }); | |||||
| } | |||||
| return { | |||||
| load: function(pages) { | |||||
| config.pages = pages; | |||||
| status.pageCount = config.pages.length; | |||||
| this.start(); | |||||
| }, | |||||
| start: function() { | |||||
| callback('onStart'); | |||||
| getPage(config.pages[status.pageIndex]); | |||||
| }, | |||||
| stop: function() { | |||||
| getPageXHR.abort(); | |||||
| clearTimeout(getPageTimeout); | |||||
| callback('onStop'); | |||||
| }, | |||||
| onStart: function(callback) { registerCallback('onStart', callback); }, | |||||
| onPageStart: function(callback) { registerCallback('onPageStart', callback); }, | |||||
| onPageSuccess: function(callback) { registerCallback('onPageSuccess', callback); }, | |||||
| onPageFail: function(callback) { registerCallback('onPageFail', callback); }, | |||||
| onPageFinish: function(callback) { registerCallback('onPageFinish', callback); }, | |||||
| onFinish: function(callback) { registerCallback('onFinish', callback); } | |||||
| }; | |||||
| }(); | |||||
| </script> <% | |||||
| End Sub | |||||
| Public Sub RenderJSInit() %> | |||||
| <script>$(function(){ASPUnit.load([<%= GetPagesAsJSString() %>])});</script> <% | |||||
| End Sub | |||||
| Private Function GetPagesAsJSString() | |||||
| Dim strReturn, _ | |||||
| i | |||||
| strReturn = "" | |||||
| For i = 0 To (m_Pages.Count - 1) | |||||
| strReturn = strReturn & "'" & m_Pages.Item(i) & "'" | |||||
| If i < (m_Pages.Count - 1) Then | |||||
| strReturn = strReturn & ", " | |||||
| End If | |||||
| Next | |||||
| GetPagesAsJSString = strReturn | |||||
| End Function | |||||
| End Class | |||||
| %> | |||||
| @@ -0,0 +1,258 @@ | |||||
| <% | |||||
| Class ASPUnitTester | |||||
| Private _ | |||||
| m_Responder, _ | |||||
| m_Scenario | |||||
| Private _ | |||||
| m_CurrentModule, _ | |||||
| m_CurrentTest | |||||
| Private Sub Class_Initialize() | |||||
| Set m_Responder = New ASPUnitJSONResponder | |||||
| Set m_Scenario = New ASPUnitScenario | |||||
| End Sub | |||||
| Private Sub Class_Terminate() | |||||
| Set m_Scenario = Nothing | |||||
| Set m_Responder = Nothing | |||||
| End Sub | |||||
| Public Property Set Responder(ByRef objValue) | |||||
| Set m_Responder = objValue | |||||
| End Property | |||||
| Public Property Get Modules() | |||||
| Set Modules = m_Scenario.Modules | |||||
| End Property | |||||
| ' Factory methods for private classes | |||||
| Public Function CreateModule(strName, arrTests, objLifecycle) | |||||
| Dim objReturn, _ | |||||
| i | |||||
| Set objReturn = New ASPUnitModule | |||||
| objReturn.Name = strName | |||||
| For i = 0 To UBound(arrTests) | |||||
| objReturn.Tests.Add(arrTests(i)) | |||||
| Next | |||||
| Set objReturn.Lifecycle = objLifecycle | |||||
| Set CreateModule = objReturn | |||||
| End Function | |||||
| Public Function CreateTest(strName) | |||||
| Dim objReturn | |||||
| Set objReturn = New ASPUnitTest | |||||
| objReturn.Name = strName | |||||
| Set CreateTest = objReturn | |||||
| End Function | |||||
| Public Function CreateLifecycle(strSetup, strTeardown) | |||||
| Dim objReturn | |||||
| Set objReturn = New ASPUnitTestLifecycle | |||||
| objReturn.Setup = strSetup | |||||
| objReturn.Teardown = strTeardown | |||||
| Set CreateLifecycle = objReturn | |||||
| End Function | |||||
| ' Public methods to add modules | |||||
| Public Sub AddModule(objModule) | |||||
| Call m_Scenario.Modules.Add(objModule) | |||||
| End Sub | |||||
| Public Sub AddModules(arrModules) | |||||
| Dim i | |||||
| For i = 0 To UBound(arrModules) | |||||
| Call AddModule(arrModules(i)) | |||||
| Next | |||||
| End Sub | |||||
| ' Assertion Methods | |||||
| Private Function Assert(blnResult, strDescription) | |||||
| If IsObject(m_CurrentTest) Then | |||||
| m_CurrentTest.Passed = blnResult | |||||
| m_CurrentTest.Description = strDescription | |||||
| End If | |||||
| Assert = blnResult | |||||
| End Function | |||||
| Public Function Ok(blnResult, strDescription) | |||||
| Ok = Assert(blnResult, strDescription) | |||||
| End Function | |||||
| Public Function Equal(varActual, varExpected, strDescription) | |||||
| Equal = Assert((varActual = varExpected), strDescription) | |||||
| End Function | |||||
| Public Function NotEqual(varActual, varExpected, strDescription) | |||||
| NotEqual = Assert(Not (varActual = varExpected), strDescription) | |||||
| End Function | |||||
| Public Function Same(varActual, varExpected, strDescription) | |||||
| Same = Assert((varActual Is varExpected), strDescription) | |||||
| End Function | |||||
| Public Function NotSame(varActual, varExpected, strDescription) | |||||
| NotSame = Assert(Not (varActual Is varExpected), strDescription) | |||||
| End Function | |||||
| ' Methods to run module tests | |||||
| Public Sub Run() | |||||
| Dim objModule, _ | |||||
| i | |||||
| For i = 0 To (m_Scenario.Modules.Count - 1) | |||||
| Set objModule = m_Scenario.Modules.Item(i) | |||||
| Call RunModule(objModule) | |||||
| m_Scenario.TestCount = m_Scenario.TestCount + objModule.TestCount | |||||
| m_Scenario.PassCount = m_Scenario.PassCount + objModule.PassCount | |||||
| m_Scenario.FailCount = m_Scenario.FailCount + objModule.FailCount | |||||
| Set objModule = Nothing | |||||
| Next | |||||
| m_Responder.Respond(m_Scenario) | |||||
| End Sub | |||||
| Private Sub RunModule(ByRef objModule) | |||||
| Dim intTimeStart, _ | |||||
| intTimeEnd, _ | |||||
| objTest, _ | |||||
| i | |||||
| Set m_CurrentModule = objModule | |||||
| intTimeStart = Timer | |||||
| For i = 0 To (objModule.Tests.Count - 1) | |||||
| Set objTest = objModule.Tests.Item(i) | |||||
| Call RunTestModuleSetup(objModule) | |||||
| Call RunModuleTest(objTest) | |||||
| Call RunTestModuleTeardown(objModule) | |||||
| If objTest.Passed Then | |||||
| objModule.PassCount = objModule.PassCount + 1 | |||||
| End If | |||||
| Set objTest = Nothing | |||||
| Next | |||||
| intTimeEnd = Timer | |||||
| objModule.Duration = Round((intTimeEnd - intTimestart), 3) | |||||
| Set m_CurrentModule = Nothing | |||||
| End Sub | |||||
| Private Sub RunModuleTest(ByRef objTest) | |||||
| Set m_CurrentTest = objTest | |||||
| On Error Resume Next | |||||
| Call GetRef(objTest.Name)() | |||||
| If Err.Number <> 0 Then | |||||
| Call Assert(False, Err.Description) | |||||
| End If | |||||
| Err.Clear() | |||||
| On Error Goto 0 | |||||
| Set m_CurrentTest = Nothing | |||||
| End Sub | |||||
| Private Sub RunTestModuleSetup(ByRef objModule) | |||||
| If Not objModule.Lifecycle Is Nothing Then | |||||
| If Not objModule.Lifecycle.Setup = Empty Then | |||||
| Call GetRef(objModule.Lifecycle.Setup)() | |||||
| End If | |||||
| End If | |||||
| End Sub | |||||
| Private Sub RunTestModuleTeardown(ByRef objModule) | |||||
| If Not objModule.Lifecycle Is Nothing Then | |||||
| If Not objModule.Lifecycle.Teardown = Empty Then | |||||
| Call GetRef(objModule.Lifecycle.Teardown)() | |||||
| End If | |||||
| End If | |||||
| End Sub | |||||
| End Class | |||||
| ' Private Classses | |||||
| Class ASPUnitScenario | |||||
| Public _ | |||||
| Modules, _ | |||||
| TestCount, _ | |||||
| PassCount, _ | |||||
| FailCount | |||||
| Private Sub Class_Initialize() | |||||
| Set Modules = Server.CreateObject("System.Collections.ArrayList") | |||||
| PassCount = 0 | |||||
| TestCount = 0 | |||||
| FailCount = 0 | |||||
| End Sub | |||||
| Private Sub Class_Terminate() | |||||
| Set Modules = Nothing | |||||
| End Sub | |||||
| Public Property Get Passed | |||||
| Passed = (PassCount = TestCount) | |||||
| End Property | |||||
| End Class | |||||
| Class ASPUnitModule | |||||
| Public _ | |||||
| Name, _ | |||||
| Tests, _ | |||||
| Lifecycle, _ | |||||
| Duration, _ | |||||
| PassCount | |||||
| Private Sub Class_Initialize() | |||||
| Set Tests = Server.CreateObject("System.Collections.ArrayList") | |||||
| PassCount = 0 | |||||
| End Sub | |||||
| Private Sub Class_Terminate() | |||||
| Set Tests = Nothing | |||||
| End Sub | |||||
| Public Property Get TestCount | |||||
| TestCount = Tests.Count() | |||||
| End Property | |||||
| Public Property Get FailCount | |||||
| FailCount = (TestCount - PassCount) | |||||
| End Property | |||||
| Public Property Get Passed | |||||
| Passed = (PassCount = TestCount) | |||||
| End Property | |||||
| End Class | |||||
| Class ASPUnitTest | |||||
| Public _ | |||||
| Name, _ | |||||
| Passed, _ | |||||
| Description | |||||
| End Class | |||||
| Class ASPUnitTestLifecycle | |||||
| Public _ | |||||
| Setup, _ | |||||
| Teardown | |||||
| End Class | |||||
| %> | |||||
| @@ -0,0 +1,395 @@ | |||||
| <% | |||||
| Class ASPUnitUIModern | |||||
| Public Sub Render(ByRef objRunner) %> | |||||
| <html> | |||||
| <head> | |||||
| <title>ASPUnit</title> | |||||
| <link href="//cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.0.0/css/bootstrap.min.css" rel="stylesheet"> | |||||
| <link href="//cdnjs.cloudflare.com/ajax/libs/font-awesome/3.2.1/css/font-awesome.min.css" rel="stylesheet"> | |||||
| <link href='//fonts.googleapis.com/css?family=Open+Sans:400,600,700' rel='stylesheet' type='text/css'> | |||||
| <style type="text/css"> | |||||
| body { | |||||
| background-color: #ECF0F1; | |||||
| padding-top: 280px; | |||||
| font-family: 'Open Sans', sans-serif; | |||||
| -webkit-font-smoothing: antialiased; | |||||
| } | |||||
| h1, h2, h3, h4, h5, h6 { | |||||
| font-family: 'Open Sans', sans-serif; | |||||
| } | |||||
| a { | |||||
| color: #95a5a6; | |||||
| transition: all 0.25s; | |||||
| } | |||||
| a:hover { | |||||
| color: #fff; | |||||
| text-decoration: none; | |||||
| } | |||||
| .project-name { | |||||
| color: #fff !important; | |||||
| } | |||||
| #footer .project-name { | |||||
| margin-top: 0; | |||||
| margin-bottom: 0; | |||||
| } | |||||
| #container { | |||||
| position: relative; | |||||
| height: auto; | |||||
| min-height: 100%; | |||||
| } | |||||
| #header { | |||||
| color: #ecf0f1; | |||||
| background-color: #13202c; | |||||
| transition: all 0.5s; | |||||
| position: fixed; | |||||
| left: 0; | |||||
| right: 0; | |||||
| top: 0; | |||||
| z-index: 1000; | |||||
| text-shadow: 0px 2px 1px #000; | |||||
| } | |||||
| #header a { | |||||
| color: #ecf0f1; | |||||
| } | |||||
| #header a:active { | |||||
| position: relative; | |||||
| top: 1px; | |||||
| text-shadow: 0px 1px 1px #000; | |||||
| } | |||||
| #header.affix { | |||||
| padding-top: 0; | |||||
| padding-bottom: 0.2em; | |||||
| } | |||||
| #main { | |||||
| padding-bottom: 12em; | |||||
| } | |||||
| #footer { | |||||
| position: absolute; | |||||
| bottom: 0; | |||||
| width: 100%; | |||||
| padding-top: 2em; | |||||
| padding-bottom: 2em; | |||||
| margin-top: 4em; | |||||
| color: #95a5a6; | |||||
| background-color: #13202c; | |||||
| } | |||||
| .progress-loading { | |||||
| box-shadow: 0 2px 6px RGBA(0,0,0,0.25); | |||||
| border-bottom: 2px #444 solid; | |||||
| border-radius: 0 0 2px 2px; | |||||
| } | |||||
| .pages-overview { | |||||
| position: relative; | |||||
| } | |||||
| .pages-status { | |||||
| display: inline-block; | |||||
| } | |||||
| .pages-options { | |||||
| display: inline-block; | |||||
| position: absolute; | |||||
| right: 0; | |||||
| } | |||||
| .page-report .page-overview { | |||||
| color: #7F8C8D; | |||||
| } | |||||
| .page-report .page-overview small { | |||||
| color: #95A5A6; | |||||
| } | |||||
| .page-module { | |||||
| margin-bottom: 1em; | |||||
| box-shadow: 0 2px 6px RGBA(0,0,0,0.25); | |||||
| } | |||||
| .page-module .page-module-header { | |||||
| color: #fff; | |||||
| padding: 1em 2em; | |||||
| } | |||||
| .page-module-pass .page-module-header { | |||||
| background-color: #2ECC71; | |||||
| border: 1px #27AE60 solid; | |||||
| } | |||||
| .page-module-fail .page-module-header { | |||||
| background-color: #E74C3C; | |||||
| border: 1px #C0392B solid; | |||||
| } | |||||
| .page-module-name { | |||||
| font-weight: bold; | |||||
| margin: 0; | |||||
| } | |||||
| .page-module-tests { | |||||
| border-left: 1px #95A5A6 solid; | |||||
| border-right: 1px #95A5A6 solid; | |||||
| border-bottom: 3px #95A5A6 solid; | |||||
| border-radius: 0 0 3px 3px; | |||||
| } | |||||
| .page-module-test { | |||||
| padding: 0.8em 2em; | |||||
| background-color: #fff; | |||||
| margin-bottom: 1px; | |||||
| position: relative; | |||||
| } | |||||
| .page-module-test-icon { | |||||
| position: absolute; | |||||
| top: 0.5em; | |||||
| left: -11px; | |||||
| color: #fff; | |||||
| width: 22px; | |||||
| height: 22px; | |||||
| padding: 3px 4px; | |||||
| border-radius: 11px; | |||||
| } | |||||
| .page-module-test-icon-pass { | |||||
| box-shadow: 0 3px 0 #27AE60, 0 6px 3px RGBA(0,0,0,0.25); | |||||
| background-color: #2ECC71; | |||||
| } | |||||
| .page-module-test-icon-fail { | |||||
| box-shadow: 0 3px 0 #C0392B, 0 6px 3px RGBA(0,0,0,0.25); | |||||
| background-color: #E74C3C; | |||||
| } | |||||
| .page-module-test-name { | |||||
| font-weight: bold; | |||||
| } | |||||
| .page-module-test-fail .page-module-test-name, .page-module-test-fail .page-module-test-description { | |||||
| color: #C0392B; | |||||
| } | |||||
| @media (max-width: 768px) { | |||||
| body { | |||||
| padding-top: 260px; | |||||
| } | |||||
| #main { | |||||
| padding-bottom: 15em; | |||||
| } | |||||
| .pages-options { | |||||
| display: inline-block; | |||||
| position: relative; | |||||
| } | |||||
| } | |||||
| </style> | |||||
| </head> | |||||
| <body> | |||||
| <div id="container"> | |||||
| <div id="header" class="jumbotron" data-spy="affix" data-offset-top="10"> | |||||
| <div class="container"> | |||||
| <h1 class="project-name"><strong>ASP</strong>Unit</h1> | |||||
| <div class="pages-overview"> | |||||
| <div class="pages-status"></div> | |||||
| <div class="pages-options"> | |||||
| <div class="pages-option-passed-tests"> | |||||
| <a href="#" class="action-hide-passed"><i class="glyphicon glyphicon-remove-sign"></i> Hide Passed Tests</a> | |||||
| </div> | |||||
| </div> | |||||
| <div class="progress progress-striped progress-loading"> | |||||
| <div class="progress-bar progress-bar-success" role="progressbar"></div> | |||||
| <div class="progress-bar progress-bar-danger" role="progressbar"></div> | |||||
| </div> | |||||
| <div class="alert alert-danger progress-error" style="display: none;"></div> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| <div id="main"> | |||||
| <div class="page-reports"></div> | |||||
| </div> | |||||
| <div id="footer"> | |||||
| <div class="container"> | |||||
| <div class="row"> | |||||
| <div class="col-md-12"> | |||||
| <h3 class="project-name"><strong>ASP</strong>Unit</h3> | |||||
| </div> | |||||
| </div> | |||||
| <div class="row"> | |||||
| <div class="col-md-4"> | |||||
| Classic ASP Unit Testing Library<br /> | |||||
| </div> | |||||
| <div class="col-md-4"> | |||||
| <ul class="list-unstyled"> | |||||
| <li><a href="https://github.com/rpeterclark/aspunit/"><i class="icon-github"></i> GitHub Project</a></li> | |||||
| <li><a href="https://github.com/rpeterclark/aspunit/wiki/"><i class="icon-book"></i> Documentation</a></li> | |||||
| <li><a href="https://github.com/rpeterclark/aspunit/issues/"><i class="icon-bug"></i> Issues</a></li> | |||||
| </ul> | |||||
| </div> | |||||
| <div class="col-md-4"> | |||||
| MIT Licensed | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| <script id="page-status-template" type="text/x-handlebars-template"> | |||||
| {{pageNumber}} of {{pageCount}} pages tested, {{passCount}} of {{testCount}} tests passed | |||||
| </script> | |||||
| <script id="page-report-template" type="text/x-handlebars-template"> | |||||
| <div class="page-report container"> | |||||
| <div class="page-overview"> | |||||
| <h3>{{page}} <small>{{passCount}} of {{testCount}} tests passed</small></h3> | |||||
| </div> | |||||
| {{#each modules}} | |||||
| <div class="page-module page-module-{{#if passed}}pass{{else}}fail{{/if}}"> | |||||
| <div class="page-module-header"> | |||||
| <h4 class="page-module-name">{{name}}</h4> | |||||
| {{passCount}} of {{testCount}} tests passed, {{failCount}} failed, completed in {{duration}} milliseconds | |||||
| </div> | |||||
| <div class="page-module-tests"> | |||||
| {{#each tests}} | |||||
| <div class="page-module-test page-module-test-{{#if passed}}pass{{else}}fail{{/if}}"> | |||||
| {{#if passed}} | |||||
| <i class="page-module-test-icon page-module-test-icon-pass glyphicon glyphicon-ok"></i> | |||||
| {{else}} | |||||
| <i class="page-module-test-icon page-module-test-icon-fail glyphicon glyphicon-remove"></i> | |||||
| {{/if}} | |||||
| <span class="page-module-test-name">{{name}}:</span> | |||||
| <span class="page-module-test-description">{{description}}</span> | |||||
| </div> | |||||
| {{/each}} | |||||
| </div> | |||||
| </div> | |||||
| {{/each}} | |||||
| </div> | |||||
| </script> | |||||
| <script id="page-error-template" type="text/x-handlebars-template"> | |||||
| <div class="page-report container"> | |||||
| <div class="page-module page-module-fail"> | |||||
| <div class="page-module-header"> | |||||
| <h4 class="page-module-name">{{page}}</h4> | |||||
| </div> | |||||
| <div class="page-module-tests"> | |||||
| <div class="page-module-test page-module-test-fail"> | |||||
| <i class="page-module-test-icon page-module-test-icon-fail glyphicon glyphicon-remove"></i> | |||||
| <span class="page-module-test-name">{{error}}{{#if description}}:{{/if}}</span> | |||||
| <span class="page-module-test-description">{{description}}</span> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| </div> | |||||
| </script> | |||||
| <script src="//cdnjs.cloudflare.com/ajax/libs/jquery/2.0.3/jquery.min.js"></script> | |||||
| <script src="//cdnjs.cloudflare.com/ajax/libs/jqueryui/1.10.3/jquery-ui.min.js"></script> | |||||
| <script src="//cdnjs.cloudflare.com/ajax/libs/handlebars.js/1.0.0/handlebars.min.js"></script> | |||||
| <script src="//cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.0.0/js/bootstrap.min.js"></script> | |||||
| <%= objRunner.RenderJSLib() %> | |||||
| <script> | |||||
| $(function() { | |||||
| var successCount = 0; | |||||
| var pageReportsContainer = $('.page-reports'); | |||||
| var pageReportTemplate = Handlebars.compile($('#page-report-template').html()); | |||||
| var pageErrorTemplate = Handlebars.compile($('#page-error-template').html()); | |||||
| var pageStatusContainer = $('.pages-status'); | |||||
| var pageStatusTemplate = Handlebars.compile($('#page-status-template').html()); | |||||
| var pageReportsProgress = $('.progress-loading'); | |||||
| var progressError = $('.progress-error'); | |||||
| ASPUnit.onStart(function() { | |||||
| pageReportsProgress.addClass('active'); | |||||
| }); | |||||
| ASPUnit.onPageSuccess(function(details) { | |||||
| successCount++; | |||||
| $(pageReportTemplate(details)).appendTo(pageReportsContainer).hide().fadeIn(); | |||||
| }); | |||||
| ASPUnit.onPageFail(function(details) { | |||||
| $(pageErrorTemplate(details)).appendTo(pageReportsContainer); | |||||
| }); | |||||
| ASPUnit.onPageFinish(function(details) { | |||||
| var status = $.extend(details.status, {pageNumber: (details.status.pageIndex + 1)}); | |||||
| pageStatusContainer.html(pageStatusTemplate(status)); | |||||
| var progressPct = (status.pageNumber / status.pageCount); | |||||
| var passPct = (status.passCount / status.testCount) * (successCount / status.pageNumber); | |||||
| var failPct = (1 - passPct); | |||||
| pageReportsProgress.find('.progress-bar-success').css({"width": ((passPct * 100) * progressPct) + "%"}) | |||||
| pageReportsProgress.find('.progress-bar-danger').css({"width": ((failPct * 100) * progressPct) + "%"}) | |||||
| }); | |||||
| ASPUnit.onFinish(function() { | |||||
| pageReportsProgress.removeClass('active'); | |||||
| }); | |||||
| $(document).on('click', '.action-hide-passed', function(e) { | |||||
| e.preventDefault(); | |||||
| var $el = $(e.target); | |||||
| if ($el.hasClass('active')) { | |||||
| $el.removeClass('active').html('<i class="glyphicon glyphicon-remove-sign"></i> Hide Passed Tests</a>'); | |||||
| showPassedTests(); | |||||
| } else { | |||||
| $el.addClass('active').html('<i class="glyphicon glyphicon-ok-sign"></i> Show Passed Tests</a>'); | |||||
| hidePassedTests(); | |||||
| } | |||||
| }); | |||||
| function hidePassedTests() { | |||||
| $('.page-report').each(function() { | |||||
| if ($(this).find('.page-module-test-fail').length > 0) { | |||||
| $(this).find('.page-module-pass').addClass('hidden'); | |||||
| $(this).find('.page-module-test-pass').addClass('hidden'); | |||||
| } else { | |||||
| $(this).addClass('hidden'); | |||||
| } | |||||
| }); | |||||
| } | |||||
| function showPassedTests() { | |||||
| $('.hidden').removeClass('hidden'); | |||||
| } | |||||
| }); | |||||
| </script> | |||||
| <%= objRunner.RenderJSInit() %> | |||||
| </body> | |||||
| </html> <% | |||||
| End Sub | |||||
| End Class | |||||
| %> | |||||
| @@ -0,0 +1,52 @@ | |||||
| <!-- #include file="../core/helpers.asp" --> | |||||
| <!-- #include file="../core/lib.ControllerRegistry.asp" --> | |||||
| <% | |||||
| Dim router | |||||
| Function ResolveProjectPath(relativePath) | |||||
| Dim fso, currentFolder, testsRoot, projectRoot | |||||
| Set fso = Server.CreateObject("Scripting.FileSystemObject") | |||||
| currentFolder = Server.MapPath(".") | |||||
| If LCase(fso.GetFileName(currentFolder)) = "tests" Then | |||||
| testsRoot = currentFolder | |||||
| Else | |||||
| testsRoot = fso.GetParentFolderName(currentFolder) | |||||
| End If | |||||
| projectRoot = fso.GetParentFolderName(testsRoot) | |||||
| ResolveProjectPath = fso.BuildPath(projectRoot, relativePath) | |||||
| Set fso = Nothing | |||||
| End Function | |||||
| Sub ResetTestRuntime() | |||||
| On Error Resume Next | |||||
| ControllerRegistry_Class__Singleton = Empty | |||||
| Set router = Nothing | |||||
| On Error GoTo 0 | |||||
| End Sub | |||||
| Sub EnsureTestRouter() | |||||
| If (Not IsObject(router)) Then | |||||
| Set router = GetObject("script:" & ResolveProjectPath("core\\router.wsc")) | |||||
| ElseIf router Is Nothing Then | |||||
| Set router = GetObject("script:" & ResolveProjectPath("core\\router.wsc")) | |||||
| End If | |||||
| End Sub | |||||
| Sub RegisterDefaultRoutes() | |||||
| Call EnsureTestRouter() | |||||
| Call router.AddRoute("GET", "/home", "homeController", "Index") | |||||
| Call router.AddRoute("GET", "/", "homeController", "Index") | |||||
| Call router.AddRoute("GET", "", "homeController", "Index") | |||||
| Call router.AddRoute("GET", "/auth/login", "AuthController", "Login") | |||||
| Call router.AddRoute("GET", "/auth/callback", "AuthController", "Callback") | |||||
| Call router.AddRoute("GET", "/auth/logout", "AuthController", "Logout") | |||||
| Call router.AddRoute("GET", "/404", "ErrorController", "NotFound") | |||||
| End Sub | |||||
| Call ResetTestRuntime() | |||||
| %> | |||||
| @@ -0,0 +1,47 @@ | |||||
| <!-- #include file="../aspunit/Lib/ASPUnit.asp" --> | |||||
| <!-- #include file="../bootstrap.asp" --> | |||||
| <!-- #include file="../../core/lib.json.asp" --> | |||||
| <!-- #include file="../../core/lib.Keycloak.asp" --> | |||||
| <!-- #include file="../../app/controllers/AuthController.asp" --> | |||||
| <% | |||||
| Call ASPUnit.AddModule( _ | |||||
| ASPUnit.CreateModule( _ | |||||
| "Auth Controller Component Tests", _ | |||||
| Array( _ | |||||
| ASPUnit.CreateTest("AuthControllerDefaultsToUsingLayout"), _ | |||||
| ASPUnit.CreateTest("AuthControllerDefaultTitleIsAuthentication") _ | |||||
| ), _ | |||||
| ASPUnit.CreateLifeCycle("SetupAuthController", "TeardownAuthController") _ | |||||
| ) _ | |||||
| ) | |||||
| Call ASPUnit.Run() | |||||
| Sub SetupAuthController() | |||||
| Call ResetTestRuntime() | |||||
| On Error Resume Next | |||||
| AuthController_Class__Singleton = Empty | |||||
| KeycloakAuth_Class__Singleton = Empty | |||||
| On Error GoTo 0 | |||||
| Call ExecuteGlobal("Dim objAuthController") | |||||
| Set objAuthController = AuthController() | |||||
| End Sub | |||||
| Sub TeardownAuthController() | |||||
| Set objAuthController = Nothing | |||||
| On Error Resume Next | |||||
| AuthController_Class__Singleton = Empty | |||||
| KeycloakAuth_Class__Singleton = Empty | |||||
| On Error GoTo 0 | |||||
| Call ResetTestRuntime() | |||||
| End Sub | |||||
| Function AuthControllerDefaultsToUsingLayout() | |||||
| Call ASPUnit.Ok(objAuthController.useLayout, "AuthController should default to layout-enabled rendering") | |||||
| End Function | |||||
| Function AuthControllerDefaultTitleIsAuthentication() | |||||
| Call ASPUnit.Equal(objAuthController.Title, "Authentication", "AuthController should expose 'Authentication' as its default title") | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,43 @@ | |||||
| <!-- #include file="../aspunit/Lib/ASPUnit.asp" --> | |||||
| <!-- #include file="../bootstrap.asp" --> | |||||
| <!-- #include file="../../app/controllers/HomeController.asp" --> | |||||
| <% | |||||
| Call ASPUnit.AddModule( _ | |||||
| ASPUnit.CreateModule( _ | |||||
| "Home Controller Component Tests", _ | |||||
| Array( _ | |||||
| ASPUnit.CreateTest("HomeControllerDefaultsToUsingLayout"), _ | |||||
| ASPUnit.CreateTest("HomeControllerDefaultTitleIsHome") _ | |||||
| ), _ | |||||
| ASPUnit.CreateLifeCycle("SetupHomeController", "TeardownHomeController") _ | |||||
| ) _ | |||||
| ) | |||||
| Call ASPUnit.Run() | |||||
| Sub SetupHomeController() | |||||
| Call ResetTestRuntime() | |||||
| On Error Resume Next | |||||
| HomeController_Class__Singleton = Empty | |||||
| On Error GoTo 0 | |||||
| Call ExecuteGlobal("Dim objHomeController") | |||||
| Set objHomeController = HomeController() | |||||
| End Sub | |||||
| Sub TeardownHomeController() | |||||
| Set objHomeController = Nothing | |||||
| On Error Resume Next | |||||
| HomeController_Class__Singleton = Empty | |||||
| On Error GoTo 0 | |||||
| Call ResetTestRuntime() | |||||
| End Sub | |||||
| Function HomeControllerDefaultsToUsingLayout() | |||||
| Call ASPUnit.Ok(objHomeController.useLayout, "HomeController should default to layout-enabled rendering") | |||||
| End Function | |||||
| Function HomeControllerDefaultTitleIsHome() | |||||
| Call ASPUnit.Equal(objHomeController.Title, "Home", "HomeController should expose the expected default title") | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,20 @@ | |||||
| <?xml version="1.0" encoding="UTF-8"?> | |||||
| <configuration> | |||||
| <appSettings> | |||||
| <add key="Environment" value="Development" /> | |||||
| <add key="Error404RedirectSeconds" value="5" /> | |||||
| <add key="CacheExpirationYear" value="2030" /> | |||||
| <add key="EnableCacheBusting" value="false" /> | |||||
| <add key="CacheBustParamName" value="v" /> | |||||
| <add key="ProductionAppBaseUrl" value="http://localhost:8081/" /> | |||||
| </appSettings> | |||||
| <system.webServer> | |||||
| <defaultDocument> | |||||
| <files> | |||||
| <clear /> | |||||
| <add value="run-all.asp" /> | |||||
| </files> | |||||
| </defaultDocument> | |||||
| </system.webServer> | |||||
| </configuration> | |||||
| @@ -0,0 +1,54 @@ | |||||
| <!-- #include file="../aspunit/Lib/ASPUnit.asp" --> | |||||
| <!-- #include file="../bootstrap.asp" --> | |||||
| <% | |||||
| Call ASPUnit.AddModule( _ | |||||
| ASPUnit.CreateModule( _ | |||||
| "Auth Route Integration Tests", _ | |||||
| Array( _ | |||||
| ASPUnit.CreateTest("AuthLoginRouteResolvesToAuthControllerLogin"), _ | |||||
| ASPUnit.CreateTest("AuthCallbackRouteResolvesToAuthControllerCallback"), _ | |||||
| ASPUnit.CreateTest("AuthLogoutRouteResolvesToAuthControllerLogout") _ | |||||
| ), _ | |||||
| ASPUnit.CreateLifeCycle("SetupAuthRoutes", "TeardownAuthRoutes") _ | |||||
| ) _ | |||||
| ) | |||||
| Call ASPUnit.Run() | |||||
| Sub SetupAuthRoutes() | |||||
| Call ResetTestRuntime() | |||||
| Call RegisterDefaultRoutes() | |||||
| End Sub | |||||
| Sub TeardownAuthRoutes() | |||||
| Call ResetTestRuntime() | |||||
| End Sub | |||||
| Function AuthLoginRouteResolvesToAuthControllerLogin() | |||||
| Dim routeArray | |||||
| routeArray = router.Resolve("GET", "/auth/login") | |||||
| Call ASPUnit.Ok( _ | |||||
| (LCase(routeArray(0)) = "authcontroller" And LCase(routeArray(1)) = "login"), _ | |||||
| "GET /auth/login should resolve to AuthController.Login" _ | |||||
| ) | |||||
| End Function | |||||
| Function AuthCallbackRouteResolvesToAuthControllerCallback() | |||||
| Dim routeArray | |||||
| routeArray = router.Resolve("GET", "/auth/callback") | |||||
| Call ASPUnit.Ok( _ | |||||
| (LCase(routeArray(0)) = "authcontroller" And LCase(routeArray(1)) = "callback"), _ | |||||
| "GET /auth/callback should resolve to AuthController.Callback" _ | |||||
| ) | |||||
| End Function | |||||
| Function AuthLogoutRouteResolvesToAuthControllerLogout() | |||||
| Dim routeArray | |||||
| routeArray = router.Resolve("GET", "/auth/logout") | |||||
| Call ASPUnit.Ok( _ | |||||
| (LCase(routeArray(0)) = "authcontroller" And LCase(routeArray(1)) = "logout"), _ | |||||
| "GET /auth/logout should resolve to AuthController.Logout" _ | |||||
| ) | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,41 @@ | |||||
| <!-- #include file="../aspunit/Lib/ASPUnit.asp" --> | |||||
| <!-- #include file="../bootstrap.asp" --> | |||||
| <% | |||||
| Call ASPUnit.AddModule( _ | |||||
| ASPUnit.CreateModule( _ | |||||
| "Config Integration Tests", _ | |||||
| Array( _ | |||||
| ASPUnit.CreateTest("NestedTestPageReadsMirroredConfigValue"), _ | |||||
| ASPUnit.CreateTest("MissingConfigKeyReturnsNothingSentinel"), _ | |||||
| ASPUnit.CreateTest("ProductionAppBaseUrlSupportsBlankOrConfiguredValue") _ | |||||
| ), _ | |||||
| ASPUnit.CreateLifeCycle("SetupConfigIntegration", "TeardownConfigIntegration") _ | |||||
| ) _ | |||||
| ) | |||||
| Call ASPUnit.Run() | |||||
| Sub SetupConfigIntegration() | |||||
| Call ResetTestRuntime() | |||||
| End Sub | |||||
| Sub TeardownConfigIntegration() | |||||
| Call ResetTestRuntime() | |||||
| End Sub | |||||
| Function NestedTestPageReadsMirroredConfigValue() | |||||
| Call ASPUnit.Equal(GetAppSetting("Error404RedirectSeconds"), "5", "Nested integration pages should read mirrored config values from their local web.config") | |||||
| End Function | |||||
| Function MissingConfigKeyReturnsNothingSentinel() | |||||
| Call ASPUnit.Equal(GetAppSetting("DefinitelyMissingSetting"), "nothing", "Missing config keys should return the existing nothing sentinel") | |||||
| End Function | |||||
| Function ProductionAppBaseUrlSupportsBlankOrConfiguredValue() | |||||
| Dim configuredUrl | |||||
| configuredUrl = GetAppSetting("ProductionAppBaseUrl") | |||||
| Call ASPUnit.Ok((configuredUrl = "" Or configuredUrl = "nothing" Or InStr(configuredUrl, "http://") = 1 Or InStr(configuredUrl, "https://") = 1), "ProductionAppBaseUrl should be either blank for host fallback or an explicit absolute URL") | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,80 @@ | |||||
| <!-- #include file="../aspunit/Lib/ASPUnit.asp" --> | |||||
| <!-- #include file="../bootstrap.asp" --> | |||||
| <!-- #include file="../../core/mvc.asp" --> | |||||
| <% | |||||
| Class TestDispatchController_Class | |||||
| Private m_useLayout | |||||
| Private Sub Class_Initialize() | |||||
| m_useLayout = False | |||||
| End Sub | |||||
| Public Property Get useLayout | |||||
| useLayout = m_useLayout | |||||
| End Property | |||||
| Public Property Let useLayout(value) | |||||
| m_useLayout = value | |||||
| End Property | |||||
| Public Sub Smoke() | |||||
| dispatchActionRan = True | |||||
| End Sub | |||||
| End Class | |||||
| Dim TestDispatchController_Class__Singleton | |||||
| Function TestDispatchController() | |||||
| If IsEmpty(TestDispatchController_Class__Singleton) Then | |||||
| Set TestDispatchController_Class__Singleton = New TestDispatchController_Class | |||||
| End If | |||||
| Set TestDispatchController = TestDispatchController_Class__Singleton | |||||
| End Function | |||||
| Call ASPUnit.AddModule( _ | |||||
| ASPUnit.CreateModule( _ | |||||
| "MVC Dispatch Smoke Tests", _ | |||||
| Array( _ | |||||
| ASPUnit.CreateTest("RootRouteResolvesToHomeController"), _ | |||||
| ASPUnit.CreateTest("KnownRouteDispatchCompletesWithoutLookupFailure") _ | |||||
| ), _ | |||||
| ASPUnit.CreateLifeCycle("SetupMvcDispatch", "TeardownMvcDispatch") _ | |||||
| ) _ | |||||
| ) | |||||
| Call ASPUnit.Run() | |||||
| Sub SetupMvcDispatch() | |||||
| Call ResetTestRuntime() | |||||
| On Error Resume Next | |||||
| MVC_Dispatcher_Class__Singleton = Empty | |||||
| TestDispatchController_Class__Singleton = Empty | |||||
| On Error GoTo 0 | |||||
| Call ExecuteGlobal("Dim dispatchActionRan") | |||||
| dispatchActionRan = False | |||||
| Call RegisterDefaultRoutes() | |||||
| Call ControllerRegistry().RegisterController("testdispatchcontroller") | |||||
| Call router.AddRoute("GET", "/dispatch-smoke", "testdispatchcontroller", "Smoke") | |||||
| End Sub | |||||
| Sub TeardownMvcDispatch() | |||||
| On Error Resume Next | |||||
| MVC_Dispatcher_Class__Singleton = Empty | |||||
| TestDispatchController_Class__Singleton = Empty | |||||
| Response.Status = "200 OK" | |||||
| On Error GoTo 0 | |||||
| Call ResetTestRuntime() | |||||
| End Sub | |||||
| Function RootRouteResolvesToHomeController() | |||||
| Dim routeArray | |||||
| routeArray = router.Resolve("GET", "/") | |||||
| Call ASPUnit.Ok((LCase(routeArray(0)) = "homecontroller" And LCase(routeArray(1)) = "index"), "Root route should resolve to HomeController.Index") | |||||
| End Function | |||||
| Function KnownRouteDispatchCompletesWithoutLookupFailure() | |||||
| Call MVC().DispatchRequest("GET", "/dispatch-smoke") | |||||
| Call ASPUnit.Ok(dispatchActionRan, "Dispatch should reach a registered controller action without whitelist or lookup failures") | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,52 @@ | |||||
| <!-- #include file="../aspunit/Lib/ASPUnit.asp" --> | |||||
| <!-- #include file="../bootstrap.asp" --> | |||||
| <!-- #include file="../support/HttpCaptureHelpers.asp" --> | |||||
| <% | |||||
| Call ASPUnit.AddModule( _ | |||||
| ASPUnit.CreateModule( _ | |||||
| "Rendered Output Capture Tests", _ | |||||
| Array( _ | |||||
| ASPUnit.CreateTest("HomePageReturnsWelcomeMarkup"), _ | |||||
| ASPUnit.CreateTest("NotFoundPageReturns404Markup") _ | |||||
| ), _ | |||||
| ASPUnit.CreateLifeCycle("SetupRenderedOutput", "TeardownRenderedOutput") _ | |||||
| ) _ | |||||
| ) | |||||
| Call ASPUnit.Run() | |||||
| Sub SetupRenderedOutput() | |||||
| Call ResetTestRuntime() | |||||
| End Sub | |||||
| Sub TeardownRenderedOutput() | |||||
| Call ResetTestRuntime() | |||||
| End Sub | |||||
| Function HomePageReturnsWelcomeMarkup() | |||||
| Dim responseData | |||||
| Dim bodyContains, message | |||||
| Set responseData = FetchPage("/") | |||||
| bodyContains = (InStr(responseData.Item("body"), "Welcome to RouteKit Classic ASP") > 0) | |||||
| message = "Home page request should return welcome markup. URL=" & responseData.Item("url") & "; Status=" & responseData.Item("status") & "; Snippet=" & Left(CStr(responseData.Item("body")), 160) | |||||
| Call ASPUnit.Ok((responseData.Item("status") = 200 And bodyContains), message) | |||||
| Set responseData = Nothing | |||||
| End Function | |||||
| Function NotFoundPageReturns404Markup() | |||||
| Dim responseData | |||||
| Dim bodyContains, message | |||||
| Set responseData = FetchPage("/404") | |||||
| bodyContains = (InStr(responseData.Item("body"), "404 - Page Not Found") > 0) | |||||
| message = "404 request should return not-found markup. URL=" & responseData.Item("url") & "; Status=" & responseData.Item("status") & "; Snippet=" & Left(CStr(responseData.Item("body")), 160) | |||||
| Call ASPUnit.Ok((responseData.Item("status") = 404 And bodyContains), message) | |||||
| Set responseData = Nothing | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,51 @@ | |||||
| <!-- #include file="../aspunit/Lib/ASPUnit.asp" --> | |||||
| <!-- #include file="../bootstrap.asp" --> | |||||
| <!-- #include file="../../core/lib.Routes.asp" --> | |||||
| <% | |||||
| Call ASPUnit.AddModule( _ | |||||
| ASPUnit.CreateModule( _ | |||||
| "Route Helper Integration Tests", _ | |||||
| Array( _ | |||||
| ASPUnit.CreateTest("RouteHelperReadsCacheBustingSettingFromConfig"), _ | |||||
| ASPUnit.CreateTest("UrlToBuildsLowercaseControllerActionPath"), _ | |||||
| ASPUnit.CreateTest("AssetUrlCanOverrideCacheBustingPerCall") _ | |||||
| ), _ | |||||
| ASPUnit.CreateLifeCycle("SetupRouteHelper", "TeardownRouteHelper") _ | |||||
| ) _ | |||||
| ) | |||||
| Call ASPUnit.Run() | |||||
| Sub SetupRouteHelper() | |||||
| Call ResetTestRuntime() | |||||
| On Error Resume Next | |||||
| Set Route_Helper__Singleton = Nothing | |||||
| On Error GoTo 0 | |||||
| End Sub | |||||
| Sub TeardownRouteHelper() | |||||
| On Error Resume Next | |||||
| Set Route_Helper__Singleton = Nothing | |||||
| On Error GoTo 0 | |||||
| Call ResetTestRuntime() | |||||
| End Sub | |||||
| Function RouteHelperReadsCacheBustingSettingFromConfig() | |||||
| Call ASPUnit.Ok((Not Routes().CacheBustingEnabled), "Routes helper should read disabled cache-busting from tests/web.config") | |||||
| End Function | |||||
| Function UrlToBuildsLowercaseControllerActionPath() | |||||
| Dim url | |||||
| url = Routes().UrlTo("HomeController", "Index", Array("id", "7")) | |||||
| Call ASPUnit.Ok((InStr(LCase(url), "/homecontroller/index?id=7") > 0), "UrlTo should build a lowercase controller/action path with query parameters") | |||||
| End Function | |||||
| Function AssetUrlCanOverrideCacheBustingPerCall() | |||||
| Dim url | |||||
| url = Routes().AssetUrl("css/site.css", True) | |||||
| Call ASPUnit.Ok((InStr(url, "css/site.css?v=") > 0), "AssetUrl should append the configured cache-bust parameter when override is true") | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,69 @@ | |||||
| <!-- #include file="../aspunit/Lib/ASPUnit.asp" --> | |||||
| <!-- #include file="../bootstrap.asp" --> | |||||
| <!-- #include file="../support/HttpCaptureHelpers.asp" --> | |||||
| <% | |||||
| Call ASPUnit.AddModule( _ | |||||
| ASPUnit.CreateModule( _ | |||||
| "Shared Layout Render Tests", _ | |||||
| Array( _ | |||||
| ASPUnit.CreateTest("HomePageIncludesSharedHeaderAssets"), _ | |||||
| ASPUnit.CreateTest("HomePageUsesControllerTitleInLayout"), _ | |||||
| ASPUnit.CreateTest("NotFoundPageStillIncludesSharedLayoutChrome") _ | |||||
| ), _ | |||||
| ASPUnit.CreateLifeCycle("SetupSharedLayout", "TeardownSharedLayout") _ | |||||
| ) _ | |||||
| ) | |||||
| Call ASPUnit.Run() | |||||
| Sub SetupSharedLayout() | |||||
| Call ResetTestRuntime() | |||||
| End Sub | |||||
| Sub TeardownSharedLayout() | |||||
| Call ResetTestRuntime() | |||||
| End Sub | |||||
| Function HomePageIncludesSharedHeaderAssets() | |||||
| Dim responseData | |||||
| Dim body | |||||
| Set responseData = FetchPage("/") | |||||
| body = responseData.Item("body") | |||||
| Call ASPUnit.Ok((responseData.Item("status") = 200 And _ | |||||
| InStr(body, "navbar-brand rk-navbar-brand") > 0 And _ | |||||
| InStr(body, "/css/site.css") > 0 And _ | |||||
| InStr(body, "bootstrap.bundle.min.js") > 0), _ | |||||
| "Home page should include shared header and footer assets from the layout") | |||||
| Set responseData = Nothing | |||||
| End Function | |||||
| Function HomePageUsesControllerTitleInLayout() | |||||
| Dim responseData | |||||
| Set responseData = FetchPage("/") | |||||
| Call ASPUnit.Ok((InStr(LCase(responseData.Item("body")), "<title>home</title>") > 0), _ | |||||
| "Home page layout should render the controller title in the <title> tag") | |||||
| Set responseData = Nothing | |||||
| End Function | |||||
| Function NotFoundPageStillIncludesSharedLayoutChrome() | |||||
| Dim responseData | |||||
| Dim body | |||||
| Set responseData = FetchPage("/404") | |||||
| body = responseData.Item("body") | |||||
| Call ASPUnit.Ok((responseData.Item("status") = 404 And _ | |||||
| InStr(body, "404 - Page Not Found") > 0 And _ | |||||
| InStr(body, "navbar-brand rk-navbar-brand") > 0 And _ | |||||
| InStr(body, "bootstrap.bundle.min.js") > 0), _ | |||||
| "404 page should still render inside the shared layout chrome") | |||||
| Set responseData = Nothing | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,20 @@ | |||||
| <?xml version="1.0" encoding="UTF-8"?> | |||||
| <configuration> | |||||
| <appSettings> | |||||
| <add key="Environment" value="Development" /> | |||||
| <add key="Error404RedirectSeconds" value="5" /> | |||||
| <add key="CacheExpirationYear" value="2030" /> | |||||
| <add key="EnableCacheBusting" value="false" /> | |||||
| <add key="CacheBustParamName" value="v" /> | |||||
| <add key="ProductionAppBaseUrl" value="http://localhost:8081/" /> | |||||
| </appSettings> | |||||
| <system.webServer> | |||||
| <defaultDocument> | |||||
| <files> | |||||
| <clear /> | |||||
| <add value="run-all.asp" /> | |||||
| </files> | |||||
| </defaultDocument> | |||||
| </system.webServer> | |||||
| </configuration> | |||||
| @@ -0,0 +1,9 @@ | |||||
| <!-- #include file="aspunit/Lib/ASPUnit.asp" --> | |||||
| <!-- #include file="PlainRunnerTheme.asp" --> | |||||
| <!-- #include file="test-manifest.asp" --> | |||||
| <% | |||||
| Set ASPUnit.Theme = New PlainRunnerTheme | |||||
| Call RegisterTestPages() | |||||
| Call ASPUnit.Run() | |||||
| %> | |||||
| @@ -0,0 +1,21 @@ | |||||
| @echo off | |||||
| setlocal | |||||
| set "SCRIPT_DIR=%~dp0" | |||||
| set "RUNNER_URL=%~1" | |||||
| if "%RUNNER_URL%"=="" set "RUNNER_URL=http://localhost/tests-dev/run-all.asp" | |||||
| echo Syncing mirrored test web.config files... | |||||
| cscript //nologo "%SCRIPT_DIR%sync-webconfigs.vbs" | |||||
| if errorlevel 1 ( | |||||
| echo Failed to sync mirrored test web.config files. | |||||
| exit /b 1 | |||||
| ) | |||||
| echo Opening test runner: %RUNNER_URL% | |||||
| start "" "%RUNNER_URL%" | |||||
| echo. | |||||
| echo If your tests app is served from a different URL, pass it as the first argument: | |||||
| echo tests\run-tests.cmd http://localhost:8085/run-all.asp | |||||
| @@ -0,0 +1,48 @@ | |||||
| <% | |||||
| Function BuildRequestOrigin() | |||||
| Dim protocol | |||||
| protocol = "http://" | |||||
| If LCase(Request.ServerVariables("HTTPS")) = "on" Then | |||||
| protocol = "https://" | |||||
| End If | |||||
| BuildRequestOrigin = protocol & Request.ServerVariables("HTTP_HOST") | |||||
| End Function | |||||
| Function GetProductionBaseUrl() | |||||
| Dim configuredUrl | |||||
| configuredUrl = GetAppSetting("ProductionAppBaseUrl") | |||||
| If configuredUrl = "nothing" Or Len(Trim(configuredUrl)) = 0 Then | |||||
| GetProductionBaseUrl = BuildRequestOrigin() & "/" | |||||
| Else | |||||
| If Right(configuredUrl, 1) <> "/" Then | |||||
| configuredUrl = configuredUrl & "/" | |||||
| End If | |||||
| GetProductionBaseUrl = configuredUrl | |||||
| End If | |||||
| End Function | |||||
| Function FetchPage(path) | |||||
| Dim http, result, targetUrl | |||||
| targetUrl = GetProductionBaseUrl() | |||||
| If Left(path, 1) = "/" Then | |||||
| path = Mid(path, 2) | |||||
| End If | |||||
| targetUrl = targetUrl & path | |||||
| Set http = Server.CreateObject("MSXML2.ServerXMLHTTP.6.0") | |||||
| http.Open "GET", targetUrl, False | |||||
| http.Send | |||||
| Set result = Server.CreateObject("Scripting.Dictionary") | |||||
| result.Add "url", targetUrl | |||||
| result.Add "status", http.Status | |||||
| result.Add "body", http.responseText | |||||
| Set FetchPage = result | |||||
| Set http = Nothing | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,25 @@ | |||||
| Option Explicit | |||||
| Dim fso | |||||
| Set fso = CreateObject("Scripting.FileSystemObject") | |||||
| Dim testsRoot | |||||
| testsRoot = fso.GetParentFolderName(WScript.ScriptFullName) | |||||
| Dim sourceFile | |||||
| sourceFile = fso.BuildPath(testsRoot, "web.config") | |||||
| If Not fso.FileExists(sourceFile) Then | |||||
| WScript.Echo "Source config not found: " & sourceFile | |||||
| WScript.Quit 1 | |||||
| End If | |||||
| Call CopyConfig(sourceFile, fso.BuildPath(fso.BuildPath(testsRoot, "unit"), "web.config")) | |||||
| Call CopyConfig(sourceFile, fso.BuildPath(fso.BuildPath(testsRoot, "component"), "web.config")) | |||||
| Call CopyConfig(sourceFile, fso.BuildPath(fso.BuildPath(testsRoot, "integration"), "web.config")) | |||||
| WScript.Echo "Mirrored test web.config files updated." | |||||
| Sub CopyConfig(sourcePath, targetPath) | |||||
| Call fso.CopyFile(sourcePath, targetPath, True) | |||||
| End Sub | |||||
| @@ -0,0 +1,20 @@ | |||||
| <% | |||||
| Sub RegisterTestPages() | |||||
| Call ASPUnit.AddPages(Array( _ | |||||
| "unit/TestHelpers.asp", _ | |||||
| "unit/TestKeycloakAuth.asp", _ | |||||
| "unit/TestKeycloakCallbackBehavior.asp", _ | |||||
| "unit/TestControllerRegistry.asp", _ | |||||
| "component/TestHomeController.asp", _ | |||||
| "component/TestAuthController.asp", _ | |||||
| "integration/TestMvcDispatch.asp", _ | |||||
| "integration/TestRoutes.asp", _ | |||||
| "integration/TestAuthRoutes.asp", _ | |||||
| "integration/TestConfigSettings.asp", _ | |||||
| "integration/TestRenderedOutput.asp", _ | |||||
| "integration/TestSharedLayout.asp" _ | |||||
| )) | |||||
| End Sub | |||||
| %> | |||||
| @@ -0,0 +1,48 @@ | |||||
| <!-- #include file="../aspunit/Lib/ASPUnit.asp" --> | |||||
| <!-- #include file="../bootstrap.asp" --> | |||||
| <% | |||||
| Call ASPUnit.AddModule( _ | |||||
| ASPUnit.CreateModule( _ | |||||
| "Controller Registry Tests", _ | |||||
| Array( _ | |||||
| ASPUnit.CreateTest("RegisteredHomeControllerIsValid"), _ | |||||
| ASPUnit.CreateTest("RegisteredErrorControllerIsValid"), _ | |||||
| ASPUnit.CreateTest("InvalidControllerFormatIsRejected"), _ | |||||
| ASPUnit.CreateTest("InvalidActionFormatIsRejected"), _ | |||||
| ASPUnit.CreateTest("UnknownControllerIsRejected") _ | |||||
| ), _ | |||||
| ASPUnit.CreateLifeCycle("SetupControllerRegistry", "TeardownControllerRegistry") _ | |||||
| ) _ | |||||
| ) | |||||
| Call ASPUnit.Run() | |||||
| Sub SetupControllerRegistry() | |||||
| Call ResetTestRuntime() | |||||
| End Sub | |||||
| Sub TeardownControllerRegistry() | |||||
| Call ResetTestRuntime() | |||||
| End Sub | |||||
| Function RegisteredHomeControllerIsValid() | |||||
| Call ASPUnit.Ok(ControllerRegistry().IsValidController("homecontroller"), "HomeController should be present in the whitelist") | |||||
| End Function | |||||
| Function RegisteredErrorControllerIsValid() | |||||
| Call ASPUnit.Ok(ControllerRegistry().IsValidController("errorcontroller"), "ErrorController should be present in the whitelist") | |||||
| End Function | |||||
| Function InvalidControllerFormatIsRejected() | |||||
| Call ASPUnit.Ok((Not ControllerRegistry().IsValidControllerFormat("home-controller")), "Controller names with dashes should be rejected") | |||||
| End Function | |||||
| Function InvalidActionFormatIsRejected() | |||||
| Call ASPUnit.Ok((Not ControllerRegistry().IsValidActionFormat("show-item")), "Action names with dashes should be rejected") | |||||
| End Function | |||||
| Function UnknownControllerIsRejected() | |||||
| Call ASPUnit.Ok((Not ControllerRegistry().IsValidController("missingcontroller")), "Unknown controllers should not pass whitelist checks") | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,65 @@ | |||||
| <!-- #include file="../aspunit/Lib/ASPUnit.asp" --> | |||||
| <!-- #include file="../bootstrap.asp" --> | |||||
| <% | |||||
| Call ASPUnit.AddModule( _ | |||||
| ASPUnit.CreateModule( _ | |||||
| "Helper Function Tests", _ | |||||
| Array( _ | |||||
| ASPUnit.CreateTest("TrimQueryParamsStripsQuestionString"), _ | |||||
| ASPUnit.CreateTest("TrimQueryParamsStripsAmpersandSuffix"), _ | |||||
| ASPUnit.CreateTest("TrimQueryParamsLeavesPathWithoutDelimiters"), _ | |||||
| ASPUnit.CreateTest("SurroundStringInArrayWrapsStringValues"), _ | |||||
| ASPUnit.CreateTest("SurroundStringInArrayLeavesNumericValuesUntouched"), _ | |||||
| ASPUnit.CreateTest("SurroundStringInArrayLeavesArraysWithoutStringsUntouched") _ | |||||
| ), _ | |||||
| ASPUnit.CreateLifeCycle("SetupHelpers", "TeardownHelpers") _ | |||||
| ) _ | |||||
| ) | |||||
| Call ASPUnit.Run() | |||||
| Sub SetupHelpers() | |||||
| Call ResetTestRuntime() | |||||
| End Sub | |||||
| Sub TeardownHelpers() | |||||
| Call ResetTestRuntime() | |||||
| End Sub | |||||
| Function TrimQueryParamsStripsQuestionString() | |||||
| Call ASPUnit.Equal(TrimQueryParams("/home?id=7"), "/home", "TrimQueryParams should remove query string values after ?") | |||||
| End Function | |||||
| Function TrimQueryParamsStripsAmpersandSuffix() | |||||
| Call ASPUnit.Equal(TrimQueryParams("/home&debug=true"), "/home", "TrimQueryParams should remove suffix values after &") | |||||
| End Function | |||||
| Function TrimQueryParamsLeavesPathWithoutDelimiters() | |||||
| Call ASPUnit.Equal(TrimQueryParams("/home"), "/home", "TrimQueryParams should leave clean paths unchanged") | |||||
| End Function | |||||
| Function SurroundStringInArrayWrapsStringValues() | |||||
| Dim arr | |||||
| arr = Array("alpha", 2) | |||||
| arr = SurroundStringInArray(arr) | |||||
| Call ASPUnit.Equal(arr(0), """alpha""", "SurroundStringInArray should wrap string items in double quotes") | |||||
| End Function | |||||
| Function SurroundStringInArrayLeavesNumericValuesUntouched() | |||||
| Dim arr | |||||
| arr = Array("alpha", 2) | |||||
| arr = SurroundStringInArray(arr) | |||||
| Call ASPUnit.Equal(arr(1), 2, "SurroundStringInArray should leave non-string items unchanged") | |||||
| End Function | |||||
| Function SurroundStringInArrayLeavesArraysWithoutStringsUntouched() | |||||
| Dim arr | |||||
| arr = Array(1, 2) | |||||
| arr = SurroundStringInArray(arr) | |||||
| Call ASPUnit.Ok((arr(0) = 1 And arr(1) = 2), "SurroundStringInArray should leave arrays without string members unchanged") | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,288 @@ | |||||
| <!-- #include file="../aspunit/Lib/ASPUnit.asp" --> | |||||
| <!-- #include file="../bootstrap.asp" --> | |||||
| <!-- #include file="../../core/lib.json.asp" --> | |||||
| <!-- #include file="../../core/lib.Keycloak.asp" --> | |||||
| <% | |||||
| Call ASPUnit.AddModule( _ | |||||
| ASPUnit.CreateModule( _ | |||||
| "Keycloak Auth Tests", _ | |||||
| Array( _ | |||||
| ASPUnit.CreateTest("KeycloakEndpointsUseRealmBaseUrl"), _ | |||||
| ASPUnit.CreateTest("KeycloakBuildLoginUrlIncludesOidcParameters"), _ | |||||
| ASPUnit.CreateTest("KeycloakBuildLogoutUrlIncludesClientAndRedirect"), _ | |||||
| ASPUnit.CreateTest("KeycloakTokenClaimsDecodeJwtPayload"), _ | |||||
| ASPUnit.CreateTest("KeycloakAuthDefaultsHttpTimeoutsAndClockSkew"), _ | |||||
| ASPUnit.CreateTest("KeycloakOperationalConfigurationAllowsProductionSafeHttpsUrls"), _ | |||||
| ASPUnit.CreateTest("KeycloakOperationalConfigurationRejectsProductionHttpRedirectUri"), _ | |||||
| ASPUnit.CreateTest("KeycloakOperationalConfigurationAllowsLocalHttpDuringDevelopment"), _ | |||||
| ASPUnit.CreateTest("KeycloakSetPostLoginRedirectPathStoresRelativePath"), _ | |||||
| ASPUnit.CreateTest("KeycloakSetPostLoginRedirectPathRejectsAbsoluteUrl"), _ | |||||
| ASPUnit.CreateTest("KeycloakConsumePostLoginRedirectPathReturnsStoredValueAndClearsIt"), _ | |||||
| ASPUnit.CreateTest("KeycloakHasRealmRoleReadsIdTokenClaims"), _ | |||||
| ASPUnit.CreateTest("KeycloakHasClientRoleReadsIdTokenClaims"), _ | |||||
| ASPUnit.CreateTest("KeycloakValidateIdTokenAcceptsExpectedClaims"), _ | |||||
| ASPUnit.CreateTest("KeycloakValidateIdTokenRejectsNonceMismatch"), _ | |||||
| ASPUnit.CreateTest("KeycloakValidateIdTokenRejectsExpiredTokens"), _ | |||||
| ASPUnit.CreateTest("KeycloakValidateIdTokenAcceptsMultipleAudiencesWhenAzpMatches") _ | |||||
| ), _ | |||||
| ASPUnit.CreateLifeCycle("SetupKeycloakAuth", "TeardownKeycloakAuth") _ | |||||
| ) _ | |||||
| ) | |||||
| Call ASPUnit.Run() | |||||
| Sub SetupKeycloakAuth() | |||||
| Call ResetTestRuntime() | |||||
| KeycloakAuth_Class__Singleton = Empty | |||||
| Session.Contents.Remove "Keycloak_IdToken" | |||||
| Session.Contents.Remove "Keycloak_PostLoginRedirectPath" | |||||
| End Sub | |||||
| Sub TeardownKeycloakAuth() | |||||
| Session.Contents.Remove "Keycloak_IdToken" | |||||
| Session.Contents.Remove "Keycloak_PostLoginRedirectPath" | |||||
| KeycloakAuth_Class__Singleton = Empty | |||||
| Call ResetTestRuntime() | |||||
| End Sub | |||||
| Function NewTestKeycloakAuth() | |||||
| Dim auth | |||||
| Set auth = New KeycloakAuth_Class | |||||
| Call auth.Configure("https://login.example.test/", "survey", "classic-app", "secret", "https://app.example.test/auth/callback") | |||||
| auth.LogoutRedirectUri = "https://app.example.test/" | |||||
| Set NewTestKeycloakAuth = auth | |||||
| End Function | |||||
| Function KeycloakEndpointsUseRealmBaseUrl() | |||||
| Dim auth | |||||
| Set auth = NewTestKeycloakAuth() | |||||
| Call ASPUnit.Equal(auth.RealmBaseUrl(), "https://login.example.test/realms/survey", "RealmBaseUrl should trim a trailing Keycloak base URL slash") | |||||
| Call ASPUnit.Equal(auth.AuthorizationEndpoint(), "https://login.example.test/realms/survey/protocol/openid-connect/auth", "AuthorizationEndpoint should use the realm OIDC auth endpoint") | |||||
| Call ASPUnit.Equal(auth.TokenEndpoint(), "https://login.example.test/realms/survey/protocol/openid-connect/token", "TokenEndpoint should use the realm OIDC token endpoint") | |||||
| Call ASPUnit.Equal(auth.UserInfoEndpoint(), "https://login.example.test/realms/survey/protocol/openid-connect/userinfo", "UserInfoEndpoint should use the realm OIDC userinfo endpoint") | |||||
| End Function | |||||
| Function KeycloakBuildLoginUrlIncludesOidcParameters() | |||||
| Dim auth, loginUrl, expectedUrl | |||||
| Set auth = NewTestKeycloakAuth() | |||||
| loginUrl = auth.BuildLoginUrl("state-123", "nonce-456") | |||||
| expectedUrl = "https://login.example.test/realms/survey/protocol/openid-connect/auth?client_id=classic%2Dapp&response_type=code&scope=openid+profile+email&redirect_uri=https%3A%2F%2Fapp%2Eexample%2Etest%2Fauth%2Fcallback&state=state%2D123&nonce=nonce%2D456" | |||||
| Call ASPUnit.Equal(loginUrl, expectedUrl, "BuildLoginUrl should include the encoded OIDC authorization-code parameters") | |||||
| End Function | |||||
| Function KeycloakBuildLogoutUrlIncludesClientAndRedirect() | |||||
| Dim auth, logoutUrl, expectedUrl | |||||
| Set auth = NewTestKeycloakAuth() | |||||
| logoutUrl = auth.BuildLogoutUrl("") | |||||
| expectedUrl = "https://login.example.test/realms/survey/protocol/openid-connect/logout?client_id=classic%2Dapp&post_logout_redirect_uri=https%3A%2F%2Fapp%2Eexample%2Etest%2F" | |||||
| Call ASPUnit.Equal(logoutUrl, expectedUrl, "BuildLogoutUrl should include the encoded client id and post-logout redirect URI") | |||||
| End Function | |||||
| Function KeycloakTokenClaimsDecodeJwtPayload() | |||||
| Dim auth, token, claims | |||||
| Set auth = NewTestKeycloakAuth() | |||||
| token = "e30.eyJzdWIiOiJ1c2VyLTEyMyIsInByZWZlcnJlZF91c2VybmFtZSI6ImRhbmEiLCJlbWFpbCI6ImRhbmFAZXhhbXBsZS50ZXN0In0.signature" | |||||
| Set claims = auth.GetTokenClaims(token) | |||||
| Call ASPUnit.Ok(Not claims Is Nothing, "GetTokenClaims should return a dictionary for a valid JWT") | |||||
| Call ASPUnit.Equal(claims.Item("sub"), "user-123", "GetTokenClaims should decode the sub claim") | |||||
| Call ASPUnit.Equal(claims.Item("preferred_username"), "dana", "GetTokenClaims should decode the preferred username") | |||||
| Call ASPUnit.Equal(claims.Item("email"), "dana@example.test", "GetTokenClaims should decode the email") | |||||
| End Function | |||||
| Function KeycloakAuthDefaultsHttpTimeoutsAndClockSkew() | |||||
| Dim auth | |||||
| Set auth = NewTestKeycloakAuth() | |||||
| Call ASPUnit.Ok(auth.HttpResolveTimeoutMs > 0, "KeycloakAuth should default the DNS resolve timeout to a positive value") | |||||
| Call ASPUnit.Ok(auth.HttpConnectTimeoutMs > 0, "KeycloakAuth should default the connect timeout to a positive value") | |||||
| Call ASPUnit.Ok(auth.HttpSendTimeoutMs > 0, "KeycloakAuth should default the send timeout to a positive value") | |||||
| Call ASPUnit.Ok(auth.HttpReceiveTimeoutMs > 0, "KeycloakAuth should default the receive timeout to a positive value") | |||||
| Call ASPUnit.Ok(auth.AllowedClockSkewSeconds >= 0, "KeycloakAuth should default the allowed clock skew to a non-negative value") | |||||
| End Function | |||||
| Function KeycloakOperationalConfigurationAllowsProductionSafeHttpsUrls() | |||||
| Dim auth, result | |||||
| Set auth = NewTestKeycloakAuth() | |||||
| result = auth.ValidateOperationalConfiguration("Production") | |||||
| Call ASPUnit.Ok(CBool(result), "ValidateOperationalConfiguration should accept HTTPS Keycloak URLs in Production") | |||||
| Call ASPUnit.Equal(auth.ErrorMessage, "", "ValidateOperationalConfiguration should not leave an error message for production-safe URLs") | |||||
| End Function | |||||
| Function KeycloakOperationalConfigurationRejectsProductionHttpRedirectUri() | |||||
| Dim auth, result | |||||
| Set auth = NewTestKeycloakAuth() | |||||
| auth.RedirectUri = "http://app.example.test/auth/callback" | |||||
| result = auth.ValidateOperationalConfiguration("Production") | |||||
| Call ASPUnit.Ok(Not CBool(result), "ValidateOperationalConfiguration should reject a non-HTTPS redirect URI in Production") | |||||
| Call ASPUnit.Ok(InStr(LCase(auth.ErrorMessage), "https") > 0 And InStr(LCase(auth.ErrorMessage), "redirecturi") > 0, "ValidateOperationalConfiguration should explain redirect URI HTTPS failures") | |||||
| End Function | |||||
| Function KeycloakOperationalConfigurationAllowsLocalHttpDuringDevelopment() | |||||
| Dim auth, result | |||||
| Set auth = NewTestKeycloakAuth() | |||||
| auth.BaseUrl = "http://localhost:8180" | |||||
| auth.RedirectUri = "http://localhost:8080/auth/callback" | |||||
| auth.LogoutRedirectUri = "http://localhost:8080/" | |||||
| result = auth.ValidateOperationalConfiguration("Development") | |||||
| Call ASPUnit.Ok(CBool(result), "ValidateOperationalConfiguration should allow local HTTP URLs outside Production") | |||||
| End Function | |||||
| Function KeycloakSetPostLoginRedirectPathStoresRelativePath() | |||||
| Dim auth | |||||
| Set auth = NewTestKeycloakAuth() | |||||
| Call auth.SetPostLoginRedirectPath("/reports/weekly?site=42") | |||||
| Call ASPUnit.Equal(Session("Keycloak_PostLoginRedirectPath"), "/reports/weekly?site=42", "SetPostLoginRedirectPath should store a safe relative return path in Session") | |||||
| End Function | |||||
| Function KeycloakSetPostLoginRedirectPathRejectsAbsoluteUrl() | |||||
| Dim auth, storedValue | |||||
| Set auth = NewTestKeycloakAuth() | |||||
| Call auth.SetPostLoginRedirectPath("https://evil.example.test/phish") | |||||
| On Error Resume Next | |||||
| storedValue = Session("Keycloak_PostLoginRedirectPath") | |||||
| If Err.Number <> 0 Then | |||||
| storedValue = "" | |||||
| Err.Clear | |||||
| End If | |||||
| On Error GoTo 0 | |||||
| Call ASPUnit.Equal(CStr(storedValue), "", "SetPostLoginRedirectPath should ignore absolute URLs to avoid open redirects") | |||||
| End Function | |||||
| Function KeycloakConsumePostLoginRedirectPathReturnsStoredValueAndClearsIt() | |||||
| Dim auth, redirectPath, storedValue | |||||
| Set auth = NewTestKeycloakAuth() | |||||
| Session("Keycloak_PostLoginRedirectPath") = "/surveys/open/7" | |||||
| redirectPath = auth.ConsumePostLoginRedirectPath("/") | |||||
| On Error Resume Next | |||||
| storedValue = Session("Keycloak_PostLoginRedirectPath") | |||||
| If Err.Number <> 0 Then | |||||
| storedValue = "" | |||||
| Err.Clear | |||||
| End If | |||||
| On Error GoTo 0 | |||||
| Call ASPUnit.Equal(redirectPath, "/surveys/open/7", "ConsumePostLoginRedirectPath should return the stored post-login destination") | |||||
| Call ASPUnit.Equal(CStr(storedValue), "", "ConsumePostLoginRedirectPath should clear the stored post-login destination after reading it") | |||||
| End Function | |||||
| Function KeycloakHasRealmRoleReadsIdTokenClaims() | |||||
| Dim auth | |||||
| Set auth = NewTestKeycloakAuth() | |||||
| Session("Keycloak_IdToken") = BuildUnsignedJwt("{""iss"":""" & auth.RealmBaseUrl() & """,""sub"":""user-123"",""aud"":""classic-app"",""exp"":2147483647,""iat"":1700000000,""realm_access"":{""roles"":[""admin"",""author""]}}") | |||||
| Call ASPUnit.Ok(auth.HasRealmRole("author"), "HasRealmRole should read realm roles from the stored ID token claims") | |||||
| Call ASPUnit.Ok(Not auth.HasRealmRole("approver"), "HasRealmRole should return False when the requested realm role is missing") | |||||
| End Function | |||||
| Function KeycloakHasClientRoleReadsIdTokenClaims() | |||||
| Dim auth | |||||
| Set auth = NewTestKeycloakAuth() | |||||
| Session("Keycloak_IdToken") = BuildUnsignedJwt("{""iss"":""" & auth.RealmBaseUrl() & """,""sub"":""user-123"",""aud"":""classic-app"",""exp"":2147483647,""iat"":1700000000,""resource_access"":{""classic-app"":{""roles"":[""editor"",""reviewer""]}}}") | |||||
| Call ASPUnit.Ok(auth.HasClientRole("classic-app", "reviewer"), "HasClientRole should read client roles from the stored ID token claims") | |||||
| Call ASPUnit.Ok(Not auth.HasClientRole("classic-app", "publisher"), "HasClientRole should return False when the requested client role is missing") | |||||
| End Function | |||||
| Function KeycloakValidateIdTokenAcceptsExpectedClaims() | |||||
| Dim auth, token, result | |||||
| Set auth = NewTestKeycloakAuth() | |||||
| token = BuildUnsignedJwt("{""iss"":""" & auth.RealmBaseUrl() & """,""sub"":""user-123"",""aud"":""classic-app"",""exp"":2147483647,""iat"":1700000000,""nonce"":""nonce-456""}") | |||||
| result = auth.ValidateIdToken(token, "nonce-456", True) | |||||
| Call ASPUnit.Ok(CBool(result), "ValidateIdToken should accept a token whose issuer, audience, expiry, and nonce all match") | |||||
| Call ASPUnit.Equal(auth.ErrorMessage, "", "ValidateIdToken should not leave an error message behind for a valid token") | |||||
| End Function | |||||
| Function KeycloakValidateIdTokenRejectsNonceMismatch() | |||||
| Dim auth, token, result | |||||
| Set auth = NewTestKeycloakAuth() | |||||
| token = BuildUnsignedJwt("{""iss"":""" & auth.RealmBaseUrl() & """,""sub"":""user-123"",""aud"":""classic-app"",""exp"":2147483647,""iat"":1700000000,""nonce"":""unexpected-nonce""}") | |||||
| result = auth.ValidateIdToken(token, "expected-nonce", True) | |||||
| Call ASPUnit.Ok(Not CBool(result), "ValidateIdToken should reject a token when the nonce claim differs from the login session nonce") | |||||
| Call ASPUnit.Ok(InStr(LCase(auth.ErrorMessage), "nonce") > 0, "ValidateIdToken should mention the nonce in the failure message when the nonce is wrong") | |||||
| End Function | |||||
| Function KeycloakValidateIdTokenRejectsExpiredTokens() | |||||
| Dim auth, token, result | |||||
| Set auth = NewTestKeycloakAuth() | |||||
| auth.AllowedClockSkewSeconds = 0 | |||||
| token = BuildUnsignedJwt("{""iss"":""" & auth.RealmBaseUrl() & """,""sub"":""user-123"",""aud"":""classic-app"",""exp"":946684800,""iat"":946684200,""nonce"":""nonce-456""}") | |||||
| result = auth.ValidateIdToken(token, "nonce-456", True) | |||||
| Call ASPUnit.Ok(Not CBool(result), "ValidateIdToken should reject an ID token whose exp claim is already in the past") | |||||
| Call ASPUnit.Ok(InStr(LCase(auth.ErrorMessage), "expired") > 0, "ValidateIdToken should mention expiration when the token has expired") | |||||
| End Function | |||||
| Function KeycloakValidateIdTokenAcceptsMultipleAudiencesWhenAzpMatches() | |||||
| Dim auth, token, result | |||||
| Set auth = NewTestKeycloakAuth() | |||||
| token = BuildUnsignedJwt("{""iss"":""" & auth.RealmBaseUrl() & """,""sub"":""user-123"",""aud"":[""account"",""classic-app""],""azp"":""classic-app"",""exp"":2147483647,""iat"":1700000000,""nonce"":""nonce-456""}") | |||||
| result = auth.ValidateIdToken(token, "nonce-456", True) | |||||
| Call ASPUnit.Ok(CBool(result), "ValidateIdToken should accept a multi-audience ID token when azp matches the configured client") | |||||
| End Function | |||||
| Function BuildUnsignedJwt(ByVal payloadJson) | |||||
| Dim xml, node, stream, bytes, base64Value | |||||
| Set stream = Server.CreateObject("ADODB.Stream") | |||||
| stream.Type = 2 | |||||
| stream.Charset = "utf-8" | |||||
| stream.Open | |||||
| stream.WriteText payloadJson | |||||
| stream.Position = 0 | |||||
| stream.Type = 1 | |||||
| bytes = stream.Read | |||||
| stream.Close | |||||
| On Error Resume Next | |||||
| Set xml = Server.CreateObject("MSXML2.DOMDocument.6.0") | |||||
| If Err.Number <> 0 Then | |||||
| Err.Clear | |||||
| Set xml = Server.CreateObject("MSXML2.DOMDocument") | |||||
| End If | |||||
| On Error GoTo 0 | |||||
| Set node = xml.createElement("base64") | |||||
| node.DataType = "bin.base64" | |||||
| node.nodeTypedValue = bytes | |||||
| base64Value = Replace(Replace(node.Text, vbCr, ""), vbLf, "") | |||||
| base64Value = Replace(base64Value, "+", "-") | |||||
| base64Value = Replace(base64Value, "/", "_") | |||||
| base64Value = Replace(base64Value, "=", "") | |||||
| BuildUnsignedJwt = "e30." & base64Value & ".signature" | |||||
| Set node = Nothing | |||||
| Set xml = Nothing | |||||
| Set stream = Nothing | |||||
| End Function | |||||
| %> | |||||
| @@ -0,0 +1,162 @@ | |||||
| <!-- #include file="../aspunit/Lib/ASPUnit.asp" --> | |||||
| <!-- #include file="../bootstrap.asp" --> | |||||
| <!-- #include file="../../core/lib.json.asp" --> | |||||
| <!-- #include file="../../core/lib.Keycloak.asp" --> | |||||
| <% | |||||
| Call ASPUnit.AddModule( _ | |||||
| ASPUnit.CreateModule( _ | |||||
| "Keycloak Callback Behavior Tests", _ | |||||
| Array( _ | |||||
| ASPUnit.CreateTest("EnsurePendingLoginValueCreatesNewValueWhenMissing"), _ | |||||
| ASPUnit.CreateTest("EnsurePendingLoginValueReusesExistingValue"), _ | |||||
| ASPUnit.CreateTest("HandleCallbackReturnsFalseWhenCodeIsMissing"), _ | |||||
| ASPUnit.CreateTest("HandleCallbackSetsErrorMessageOnMissingCode"), _ | |||||
| ASPUnit.CreateTest("StateValidationErrorExplainsMissingStoredState"), _ | |||||
| ASPUnit.CreateTest("StateValidationErrorExplainsMismatchedStoredState"), _ | |||||
| ASPUnit.CreateTest("IsLoggedInReturnsFalseWithEmptySession"), _ | |||||
| ASPUnit.CreateTest("IsLoggedInReturnsTrueWhenTokenStoredInSession"), _ | |||||
| ASPUnit.CreateTest("ClearSessionRemovesStoredTokens") _ | |||||
| ), _ | |||||
| ASPUnit.CreateLifeCycle("SetupKeycloakCallbackBehavior", "TeardownKeycloakCallbackBehavior") _ | |||||
| ) _ | |||||
| ) | |||||
| Call ASPUnit.Run() | |||||
| Sub SetupKeycloakCallbackBehavior() | |||||
| Call ResetTestRuntime() | |||||
| KeycloakAuth_Class__Singleton = Empty | |||||
| Session.Contents.Remove "Keycloak_AccessToken" | |||||
| Session.Contents.Remove "Keycloak_RefreshToken" | |||||
| Session.Contents.Remove "Keycloak_IdToken" | |||||
| Session.Contents.Remove "Keycloak_State" | |||||
| Session.Contents.Remove "Keycloak_Nonce" | |||||
| Session.Contents.Remove "Keycloak_UserInfoJson" | |||||
| End Sub | |||||
| Sub TeardownKeycloakCallbackBehavior() | |||||
| Session.Contents.Remove "Keycloak_AccessToken" | |||||
| Session.Contents.Remove "Keycloak_RefreshToken" | |||||
| Session.Contents.Remove "Keycloak_IdToken" | |||||
| Session.Contents.Remove "Keycloak_State" | |||||
| Session.Contents.Remove "Keycloak_Nonce" | |||||
| Session.Contents.Remove "Keycloak_UserInfoJson" | |||||
| KeycloakAuth_Class__Singleton = Empty | |||||
| Call ResetTestRuntime() | |||||
| End Sub | |||||
| ' Builds a configured KeycloakAuth_Class instance for callback behavior tests | |||||
| Function NewCallbackTestAuth() | |||||
| Dim auth | |||||
| Set auth = New KeycloakAuth_Class | |||||
| Call auth.Configure("https://login.example.test/", "survey", "classic-app", "secret", "https://app.example.test/auth/callback") | |||||
| auth.LogoutRedirectUri = "https://app.example.test/" | |||||
| Set NewCallbackTestAuth = auth | |||||
| End Function | |||||
| ' A fresh login should create a new pending value in Session so the redirect can | |||||
| ' include state/nonce even when the session starts empty. | |||||
| Function EnsurePendingLoginValueCreatesNewValueWhenMissing() | |||||
| Dim auth, value | |||||
| Set auth = NewCallbackTestAuth() | |||||
| Session.Contents.Remove "Keycloak_State" | |||||
| value = auth.EnsurePendingLoginValue("Keycloak_State") | |||||
| Call ASPUnit.Ok(Len(value) > 0, "EnsurePendingLoginValue should create a value when the session does not have one") | |||||
| Call ASPUnit.Equal(Session("Keycloak_State"), value, "EnsurePendingLoginValue should store the created value in Session") | |||||
| End Function | |||||
| ' Repeated hits to /auth/login in the same session should keep using the same | |||||
| ' pending state instead of overwriting it and breaking the first callback. | |||||
| Function EnsurePendingLoginValueReusesExistingValue() | |||||
| Dim auth, value | |||||
| Set auth = NewCallbackTestAuth() | |||||
| Session("Keycloak_State") = "existing-state-123" | |||||
| value = auth.EnsurePendingLoginValue("Keycloak_State") | |||||
| Call ASPUnit.Equal(value, "existing-state-123", "EnsurePendingLoginValue should reuse an existing pending value") | |||||
| Call ASPUnit.Equal(Session("Keycloak_State"), "existing-state-123", "EnsurePendingLoginValue should not overwrite an existing session value") | |||||
| End Function | |||||
| ' HandleCallback returns False when the request has no 'code' query parameter | |||||
| ' (the typical outcome of a direct navigation or an incomplete redirect) | |||||
| Function HandleCallbackReturnsFalseWhenCodeIsMissing() | |||||
| Dim auth, result | |||||
| Set auth = NewCallbackTestAuth() | |||||
| result = auth.HandleCallback() | |||||
| Call ASPUnit.Ok(Not CBool(result), "HandleCallback should return False when no authorization code is present in the request") | |||||
| End Function | |||||
| ' HandleCallback must describe the failure in ErrorMessage so the view | |||||
| ' can surface a meaningful message to the user | |||||
| Function HandleCallbackSetsErrorMessageOnMissingCode() | |||||
| Dim auth | |||||
| Set auth = NewCallbackTestAuth() | |||||
| Call auth.HandleCallback() | |||||
| Call ASPUnit.Ok( _ | |||||
| InStr(LCase(auth.ErrorMessage), "authorization code") > 0, _ | |||||
| "HandleCallback should set an error message mentioning 'authorization code' when the code parameter is absent" _ | |||||
| ) | |||||
| End Function | |||||
| ' IsLoggedIn reflects the presence of an access token in the Session — | |||||
| ' no token means not logged in | |||||
| Function IsLoggedInReturnsFalseWithEmptySession() | |||||
| Dim auth | |||||
| Set auth = NewCallbackTestAuth() | |||||
| Call ASPUnit.Ok(Not auth.IsLoggedIn(), "IsLoggedIn should return False when no access token is stored in session") | |||||
| End Function | |||||
| ' Placing a token in the Session should cause IsLoggedIn to return True | |||||
| ' without any HTTP call — the session IS the auth state | |||||
| Function IsLoggedInReturnsTrueWhenTokenStoredInSession() | |||||
| Dim auth | |||||
| Set auth = NewCallbackTestAuth() | |||||
| Session("Keycloak_AccessToken") = "eyJ.test.token" | |||||
| Call ASPUnit.Ok(auth.IsLoggedIn(), "IsLoggedIn should return True when an access token is present in session") | |||||
| End Function | |||||
| ' ClearSession must remove all Keycloak_ prefixed keys so that a subsequent | |||||
| ' IsLoggedIn check correctly reports the user as signed out | |||||
| Function ClearSessionRemovesStoredTokens() | |||||
| Dim auth | |||||
| Set auth = NewCallbackTestAuth() | |||||
| Session("Keycloak_AccessToken") = "eyJ.test.token" | |||||
| Session("Keycloak_RefreshToken") = "eyJ.refresh.token" | |||||
| Call auth.ClearSession() | |||||
| Call ASPUnit.Ok(Not auth.IsLoggedIn(), "ClearSession should remove stored tokens so IsLoggedIn returns False") | |||||
| End Function | |||||
| ' When the stored login state is absent, the callback failure should point to | |||||
| ' session loss, callback reload, or direct navigation instead of a generic | |||||
| ' mismatch so troubleshooting is faster. | |||||
| Function StateValidationErrorExplainsMissingStoredState() | |||||
| Dim auth, message | |||||
| Set auth = NewCallbackTestAuth() | |||||
| message = auth.StateValidationError("callback-state-123") | |||||
| Call ASPUnit.Ok( _ | |||||
| InStr(LCase(message), "stored session state is missing") > 0, _ | |||||
| "StateValidationError should explain when the stored session state is missing" _ | |||||
| ) | |||||
| End Function | |||||
| ' When a session state exists but differs from the callback state, the helper | |||||
| ' should describe a stale callback or overlapping login rather than session loss. | |||||
| Function StateValidationErrorExplainsMismatchedStoredState() | |||||
| Dim auth, message | |||||
| Set auth = NewCallbackTestAuth() | |||||
| Session("Keycloak_State") = "expected-state-123" | |||||
| message = auth.StateValidationError("callback-state-456") | |||||
| Call ASPUnit.Ok( _ | |||||
| InStr(LCase(message), "did not match the active login session") > 0 And InStr(LCase(message), "another login attempt") > 0, _ | |||||
| "StateValidationError should explain when the callback state differs from the stored login state" _ | |||||
| ) | |||||
| End Function | |||||
| %> | |||||
Powered by TurnKey Linux.