<% '............................................... On Error Resume Next '............................................... '************************* SYSTEM DATABASES *********************** '----------------- AUTHOR ---------------- 'Chief Software Architect - Mitchell Stokely - USA 'Contact: sales@giantisland.com '---------------- VERSION ---------------- 'Database Class: SystemDatabases.asp 'Current Version: 3.00 'Date Updated: May, 2007 'Prior Versions: 1.02,1.01,1.00 'Date Originated: June, 2005 '---------- ADDITIONS & BUG FIXES -------- '1. LoadXMLFile Function : Added timer that allows multiple users the ability to update and load the same XML files 'Before, the system would create XML load exception and multiple users could not update the XML at the same time. 'Example of this error was uploading files, while another browser user was assigning them. Now, the latter will wait in a 'timed loop until the former process is finished processing the XML file. '2. GetFilteredData Function : Added method that allows you to generate an id list from one method, then use that array of values in this method to actually call the specific records you need from another table. You can use this to get all records or all but the provided id records. '3. SortData Function : You can do sorting with this function that uses a column to sort by and either ascending or descending sorts like "ORDER BY" in T-SQL. '4. Fixed minor query bugs in GetData methods, so if no values returned does not error out loops. '5. Added updates for GetData and Update functions whereby now, you can pass in arrays of values to update as well as specific ids and the system will now only get the specific set.xml file rather than the all records when performing those calls. Much faster querying and when large numbers of files are stored, still allows things like uploads and GetData calls for single items to run faster and not suffer as the database increases in size. '----------------------------------------- '\\\\\\\\\\\\\\\\\\\\\ XML FILE MANAGER ////////////////////// '----------------------------------------------------------- 'Built by GiantIsland LLC, USA, Copyright (C) 2007, www.giantisland.com. '----------------------------------------------------------- Class Database '----------------------FIELDS------------------------- 'Class Variables Public databasePath Public databaseLoaded Public modulePath 'Class Objects Public XMLFile Public NewXMLSetFile Public XMLTableAttributeArray Public XMLTableSetListArray Public XMLTableColumnListArray 'Error Messages Public theError '---------------------- PROPERTIES ------------------------- '********************************************************* ' Error Property - This class manages its own error and feedback system, and may be enabled to access specific errors inside functions and subroutines inside the class. '********************************************************* Public Property Let AddError(anError) if (Me.theError = "" or IsEmpty(Me.theError)) then Me.theError = "
Database Class - Processing Log The messages below are returned from various functions and subroutines contained in the Database Class used in this page (stored in 'SystemDatabase.asp'). Some data returned may be general processing messages, while other may be caused by an issue/error in the class. Please read below to get more information:
" end if Me.theError = Me.theError + anError + "
" End Property Public Property Get GetAllErrors() GetAllErrors = Me.theError End Property '********************************************************* '---------------------- CONSTRUCTORS ------------------------ '****************FUNCTION: Class_Initialize**************** 'Class_Initialize starts when class is first called. When the class is first referenced, go ahead and create, in-memory, a placeholder for the XML DOM object. This will hold the xml datafile(s) when stored later. 'Note: The system does not store XML objects in shared memory beyond whats shared inside instantiated instances of the Database Class user here, so that each web page process is managed separately and a bottleneck doesnt occur when accessing this class. If you see large volumes of hits to this class and XML read/write or memory usage on the server creates errors or taxes the web application, the XML objects created below may be stored and pulled from Application level variables. '********************************************************** Private Sub Class_Initialize() '............................................... On Error Resume Next '............................................... Me.theError = "" Me.databasePath = "" Me.databaseLoaded = "" Me.modulePath = Application("II_WEBROOT_PATH") & "/" & Application("II_MODULE_PATH") & "/" 'CREATE MSXML PARSER '----------------------------------------------------- 'This system uses Microsoft's MSXML Parser for accessing and manipulating XML files stored in the product. You should check which version of MSXML is installed on this server, if you are having errors with the version of MSXML used below. In general Internet Explorer 5 comes with 1 and 2 (parser versions of MSXML), and IE 6 comes with version 3 and above. Software installs of SQL Server, IIs and Service Packs install newer versions of MSXML parser on the web server for you by default, which may include more advanced MSXML features. For this application to run correctly, you MUST have Internet Explorer 5 or later (or other advanced web server product installed - post Windows NT Server)installed on the web server where your web site is stored in order to allow this script to run. 'Note: "Microsoft.FreeThreadedXMLDOM" represents the old MSXML 2 parser.  MSXML 3, SP1+, installs in "replace mode", and re-maps the Microsoft.XMLDOM parser registry entry to the newer parser (version 3 below) in "most scenarios", so it will actually work with the old name used here ("Microsoft.XMLDOM"). For this reason, in most cases, you may be using MSXML 3 in your web site by default. This could conceivably cause problems as it refers to the old parser, however, as newer parsers may install in replacement mode and not support older implmentations. If you have errors related to the MSXML object, try using the newer parsers for the CreateObject statement below: "Microsoft.XMLDOM". Also, you can also use the free threaded version of the MSXML DOM if we will be servicing multiple and simultaneous requests, or you need to store this object in an application scoped variable. 'IMPORTANT: If you see frequent MSXML errors in this web application, it most likely is caused by the fact that you need READ/WRITE ACCESS on all folders inside this web application on the web server. The IUSER or anonomous internet accounts where the modules and xml database files are stored must have been granted read/write access on the web server for the ASP or worker process accounts to write xml to the database xml files for each module. ' Note: 'CreateObject' call alows you to integrate with VBScript server-side, while 'ActiveXObject' calls allow you to run with Javascript client-side. 'MSXML VERSIONS released by Microsoft (try a later version if you have problems with using the object) set XMLFile = Server.CreateObject("Microsoft.XMLDOM") 'set XMLFile = Server.CreateObject("Microsoft.FreeThreadedXMLDOM") 'old msxml version 2 parser 'set XMLFile = Server.CreateObject("Msxml2.DOMDocument") 'newer version 3 that should be called when Microsoft.XMLDOM is installed in most installs 'set XMLFile = Server.CreateObject("Msxml2.FreethreadedDomDocument") 'set XMLFile = Server.CreateObject("Msxml2.DOMDocument.3.0") 'set XMLFile = Server.CreateObject("Msxml2.FreeThreadedDOMDocument.3.0") 'set XMLFile = Server.CreateObject("Msxml2.DOMDocument.4.0") 'PRIMARY properties supported by old parser Microsoft.XMLDOM - stable and reliable 'Basic properties (which need to be set using this syntax) XMLFile.async = false 'async: Turn off asyncronous file loading: make sure that the parser will not continue execution of the script before the document is fully loaded XMLFile.resolveExternals = false 'determines whether MSXML loads external entities or not from as DTD. resolveExternals: do not resolve external DTDs, so set to false for now... XMLFile.preserveWhiteSpace = true 'preserveWhiteSpace: preserve actual whitespace defined in the page so the actual xml file is not 'mushed' together when viewed externally 'resolveExternals: do not resolve external DTDs XMLFile.validateOnParse = false 'validateOnParse: you can make sure the document is valid...but not used here 'SECONDARY properties (optional here) only supported by later parsers - important to try and set, though support may vary slightly on older parsers XMLFile.SetProperty "ServerHTTPRequest", false 'for loading over a url use "true", else for files on the server use "false" XMLFile.SetProperty "SelectionLanguage", "XPath" 'SelectionLanguage: fixes bug in MSXMLDOM version 3+ in IE version 6 browser MSXML that defaults its parse engine to 'XSL pattern' matching rather than 'XPath'. Note: This is required for all queries in the system to work, as they use XPATH as their query language. 'SPECIAL properties not recommended as tied to more advanced parsers or features - unreliable except for using newer more advanced parsers 'Note: Some older Windows NT web servers and installs have been shown to have poor support for these MSXML object properties 'XMLFile.SetProperty "AllowDocumentFunction", true 'true by default. allows you to use document() in xsl which calls another xml document. Seems to cause issues in MSXML3 on Windows NT servers, as not supported. 'XMLFile.SetProperty "ForcedResync", true 'Enables/disables resynchronization during loading through Inernet Explorers url monitor service (URLMON). This property is useful for optimizing cache utility in high-load server applications. To force resynchronization, set this property to true. Otherwise, set it to false. The default value of this property is true. 'XMLFile.SetProperty "MaxXMLSize", 1000 'sets maximun size of xml that may be loaded in kilobytes...dont use in this app! 'XMLFile.SetProperty "NewParser", True 'works only with "Msxml2.DOMDocument.4.0" or later. Instructs MSXML to use a parser which offers greater performance, but does not yet support asynchronous mode or DTD validation. '........................................................... If Err.number <> 0 then Call CaptureThisError("SystemDatabases.asp:Database Class:Class_Initialize:Check this file, class, and method for the error.") Err.Clear End If '........................................................... End Sub '********************************************************** '******************** FUNCTION: LoadXMLFile Function ******** 'newPath - The path and file name of the XML file. This method is used to handle all loading of XML files in the class, 'and stores xml data loaded into the Class XMLFile object. It will catch any errors that the xml loading process creates 'and returns true/false values. '********************************************************** Public Function LoadXMLFile(newPath) '............................................... On Error Resume Next '............................................... Dim MyLoadFileTest 'DOES FILE EXISTS AT THE FILE PATH?: First, check that the file exists... Set MyLoadFileTest = Server.CreateObject("Scripting.FileSystemObject") if MyLoadFileTest.FileExists(newPath) then 'Load xml file: load in the xml file based on the path inserted. 'Returns true or false if file is loaded... '*** Special script that prevents file "locking" or permission issues. 'This occurs when someone tries to upload and update XML database files that are used by another user or process. 'This script uses timeout to check again for permission error and keeps trying until file is unlocked dim stopCheck,isFinished isFinished = false stopCheck = 0 On Error Resume Next Do 'Should the file be permanently locked, this check prevents endless loop stopCheck = stopCheck + 1 if (stopCheck >= 1000000000) then Exit Do end if 'Try Opening LoadXMLFile = Me.XMLFile.load(newPath) If Err.Number = 70 Then 'Permission denied error 'Waiting 1/2 a second before trying again WScript.Echo "sleeping" WScript.Sleep 500 ElseIf Err.Number <> 0 then 'WScript.Echo "Other Error: " & Err.Number Exit Do isFinished = true Else 'Load ok. Go process XML isFinished = true LoadXMLFile = true End If Err.Clear Loop Until isFinished 'Err.Clear 'WAS XML FILE LOADED?: check that the file was loaded, then if it is valid xml and was thus parsed... if LoadXMLFile then AddError = "New Database set.xml File Loaded! 'LoadXMLFile' Method Successful! The XML File was loaded correctly!" else 'return false: parse error means file was not loaded LoadXMLFile = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! 'LoadXMLFile' Method. File not loaded. Checking parser for xml errors...
" 'IS THE XML FILE BAD-CANNOT BE PARSED?: Run loading xml error checker... If Me.XMLFile.parseError.errorCode <> 0 Then Session("II_MESSAGE") = Session("II_MESSAGE") & "Warning: XML file parse error: " & Me.XMLFile.parseError.reason & ". Your xml file may be damaged or corrupted. Please check your xml file located here: " & newPath & "
" 'Display XML parse error message in detail for troubleshooting the xml error in the file... Session("II_MESSAGE") = Session("II_MESSAGE") & "
Invalid XML file!
" _ & "Line No. " & Me.XMLFile.parseError.line & "
" _ & "Character: " & Me.XMLFile.parseError.linepos & "
" _ & "File Position: " & Me.XMLFile.parseError.filepos & "
" _ & "Source Text: " & Me.XMLFile.parseError.srcText & "
" _ & "Error Code: " & Me.XMLFile.parseError.errorCode & "
" _ & "Description: " & Me.XMLFile.parseError.reason & "
" '& "File URL: " & Me.XMLFile.parseError.url & "
" end If end if else LoadXMLFile = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! 'LoadXMLFile' Method. File path is incorrect: Please check file path passed into the method.
XML File Accessed: " & newPath & "
" end if Set MyLoadFileTest = Nothing If Err.number <> 0 then Call CaptureThisError("SystemDatabases.asp:Database Class:LoadXMLFile:Check this file, class, and method for the error.") Err.Clear End If End Function '********************************************************** '********************* BuildFullArray **************************** 'Same type of function used in 'SystemModules.asp' file and used to regenerate the MODULE_ARRAY application variable used by the system in managing modules and their data and database locations. Stores complete list of all modules, their configuration.xml info, and includes path to database folder which holds the list of tables for that module. 'TheModuleRootPath - This is the path to your modules root folder, which contains your modules. This is usually built from WEBROOT_PATH and MODULE_PATH application variables values '************************************************************* Sub BuildFullArray(TheModuleRootPath) '............................................... On Error Resume Next '............................................... if (IsEmpty(TheModuleRootPath) or TheModuleRootPath = "") then Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Please check the 'SystemSettings.asp' file in the System folder and make sure that there is a valid path to your Skins and Module folders.
" Application.Lock Application("II_MODULE_PATH") = null Application.Unlock else Dim TheFolderObject,theFolder,theSubFolder,FolderArray(),ParentFolderObject,i,newFolderArray,theConfigFile,configFilePath,numberOfConfigItems,namesOfConfigItems 'Set the number of nodes or items stored from module/skin configuration.xml files and allowed in the application array here.... numberOfConfigItems = Application("II_CONFIGURATION_XML_NUMBER") 'Sets an array list of acceptable values/names as found in the attrinute names of item nodes 'in the configuration.xml file. It is based on SystemSettings.asp application variable values allowed namesOfConfigItems = Application("II_CONFIGURATION_XML_VALUES") if (IsNull(numberOfConfigItems) or IsEmpty(numberOfConfigItems)) then numberOfConfigItems = 0 end if if (IsNull(namesOfConfigItems) or IsEmpty(namesOfConfigItems)) then namesOfConfigItems = 0 end if 'note: only last dimension may be redimmed and preserved. Neg. value set here to start with... ReDim FolderArray((numberOfConfigItems-1),-1) Dim tempPath tempPath = Server.MapPath(TheModuleRootPath) if IsNull(tempPath) then Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Error finding either the module and skins folders. None are found in their respective folders. Check that the web path (" & TheModuleRootPath & ") to the modules and/or skins folder is correct. (check Settings.asp)
" Application.Lock Application("II_MODULE_PATH") = null Application.Unlock else Set TheFolderObject = CreateObject("Scripting.FileSystemObject") If TheFolderObject.FolderExists(tempPath) Then Set ParentFolderObject = TheFolderObject.GetFolder(tempPath) if (ParentFolderObject.SubFolders.Count > 0) then For Each theFolder In ParentFolderObject.SubFolders configFilePath = tempPath & "\" & theFolder.Name & "\" & "configuration.xml" 'only ubound of last array in multimdimensional arrays may be redimensioned... ReDim Preserve FolderArray((numberOfConfigItems-1),UBound(FolderArray,2)+1) FolderArray(0,UBound(FolderArray,2)) = theFolder.Name 'Now add the configuration.xml "datemodified" value, if found If TheFolderObject.FileExists(configFilePath) Then Set theConfigFile = TheFolderObject.GetFile(configFilePath) FolderArray(1,UBound(FolderArray,2)) = theConfigFile.DateLastModified 'always release objects in loops... Set theConfigFile = nothing theConfigFile = Empty Else FolderArray(1,UBound(FolderArray,2)) = "" End If '******** GET CONFIGURATION.XML DATA FOR THIS MODULE/SKIN ******** 'Now build the full array with configuration.xml data, if found dim ConfigXMLFile,isLoaded,myNodeList,newArray1,newArray2,k,j,l,n isLoaded = false 'Load configuration.xml data If TheFolderObject.FileExists(configFilePath) Then set ConfigXMLFile = Server.CreateObject("Microsoft.XMLDOM") With ConfigXMLFile .async = False .validateOnParse = False .preserveWhiteSpace = True .resolveExternals = False End With ConfigXMLFile.setProperty "SelectionLanguage", "XPath" isLoaded = ConfigXMLFile.load(configFilePath) if (isLoaded) then 'load data into xml object using XPATH... Set myNodeList = ConfigXMLFile.documentElement.selectNodes("/configuration/*") 'Set myNodeList = ConfigXMLFile.documentElement.selectSingleNode("/configuration/item/@name") 'response.write("
TYPE: " & TheFolderType) if myNodeList.length > 0 then ReDim newArray1(myNodeList.length) ReDim newArray2(myNodeList.length) 'First build complete list of all "items" stored in this configuration.xml file For k = 0 To myNodeList.length - 1 newArray1(k) = myNodeList.item(k).attributes(0).value 'get name/attribute of node newArray2(k) = myNodeList.item(k).Text 'get text value of node Next 'SUCCESS! Now add data to FolderArray... 'Order all xml node values by the correct name of attribute based on application array and set value if (IsArray(namesOfConfigItems)) then n = 0 For j = 0 to Ubound(namesOfConfigItems) if (Lcase(Cstr(namesOfConfigItems(j))) = "folder_name" or Lcase(Cstr(namesOfConfigItems(j))) = "folder_path" or Lcase(Cstr(namesOfConfigItems(j))) = "datetime_modified") then else For l = 0 to Ubound(newArray1) if (Lcase(Cstr(namesOfConfigItems(j))) = Lcase(Cstr(newArray1(l)))) then '(n+2) means to reserve the first two array indices for the folder name and configuration.xml date_modified values and start storing actual configuration.xml node values starting with third index for the array (see SystermSettings.asp) if ((n+2) <= (numberOfConfigItems-1)) then FolderArray(n+2,UBound(FolderArray,2)) = newArray2(l) exit for end if end if Next n = n+1 end if Next else 'Do not store values from the configuration.xml file if somehow the application values ahve been erased 'that control the names and order of allowed values (ie. array is lost or missing!) end if else 'NO XML FOUND IN FILE... 'note: for now, assume that the creator intended that no data to exist, so allow an empty configuration.xml file end if Erase newArray1 Erase newArray2 Set myNodeList = nothing else 'Configuration.xml is not well-formed. Alert user of error! Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! There was an error in one of the files inside your skin or module folders inside your web site! A Configuration.xml file for one of your modules/skins did not load correctly into the system! Checking parser for xml errors...see error list below
" 'IS THE XML FILE BAD-CANNOT BE PARSED?: Run loading xml error checker... If ConfigXMLFile.parseError.errorCode <> 0 Then Session("II_MESSAGE") = Session("II_MESSAGE") & "
Configuration.xml file parse error: " & ConfigXMLFile.parseError.reason & " Your xml file may be damaged or corrupted.
Please check your Configuration.xml file located here: " & configFilePath & "
" 'Display XML parse error message in detail for troubleshooting the xml error in the file... Session("II_MESSAGE") = Session("II_MESSAGE") & "Configuration.xml Information:
" _ & "File URL: " & ConfigXMLFile.parseError.url & "
" _ & "Line No. " & ConfigXMLFile.parseError.line & "
" _ & "Character: " & ConfigXMLFile.parseError.linepos & "
" _ & "File Position: " & ConfigXMLFile.parseError.filepos & "
" _ & "Source Text: " & ConfigXMLFile.parseError.srcText & "
" _ & "Error Code: " & ConfigXMLFile.parseError.errorCode & "
" _ & "Description: " & ConfigXMLFile.parseError.reason & "
" _ & "Please Note: This error will not affect the module directly, so it will load and this error will go away. But please note that parts of that module that use data may not work, or all module pages may not work, until you correct the xml file listed above. This error may cause issues later if your module tries to pull data from its database. For this reason please go into configuration.xml at the path above and try and clean up the xml so it is well-formed. You may open the file with Notepad or other plain text editor and try and retype the text to correct the error. If you are having trouble understanding the error or XML in general, please visit our web site for more information or download similar modules if available: " & Application("II_COMPANY_NAME") & "" end If end if 'always release objects in loops... Set ConfigXMLFile = nothing ConfigXMLFile = Empty else 'No configuration.xml file found...which is ok. All values should be empty then by default... 'TODO:build empty config values into arrays here... End If '**************************************************************** Next end if Set ParentFolderObject = nothing ParentFolderObject = Empty if Ubound(FolderArray,2) < 0 then Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Error finding either the module or skins folders. None are found in their respective folders. Check that the web path (" & TheModuleRootPath & ") to the modules and/or skins folder is correct. (check Settings.asp)
" end if 'Now assign array to application array and store Application.Lock Application("II_MODULE_ARRAY") = FolderArray Application.Unlock else Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Error finding the module and skins parent folder as set in your 'SystemSettings.asp' file. Please go to SystemSettings.asp and make sure you are pointing to your correct module or skin folder. (check Settings.asp)
" Application.Lock Application("II_MODULE_PATH") = null Application.Unlock end if Set TheFolderObject = nothing TheFolderObject = Empty end if Erase FolderArray end if If Err.number <> 0 then Call CaptureThisError("SystemDatabases.asp:Database Class:BuildFullArray:Check this file, class, and method for the error.") Err.Clear End If End Sub '************************************************************* '********************** LoadModule ************************** 'Checks to see if module "foldername" or "name" and "database_location" is found in the MODULE_ARRAY variable. 'Those values are generally stored with the configuration.xml file found with the module itself. 'The "SystemSettings.asp" file stores and controls the master configuration array stored in Application("II_CONFIGURATION_XML_VALUES") 'and that determines which configuration.xml values are used below. '************************************************************* Public Function LoadModule(NameOfModule,ByRef ModuleDatabaseLocation) '............................................... On Error Resume Next '............................................... Dim appArray,configArray,index1,index2,index3,currentIndex,j,k,l,m,checkSuccess configArray = Application("II_CONFIGURATION_XML_VALUES") index1 = -1 index2 = -1 index3 = -1 checkSuccess = false ModuleDatabaseLocation = "" 'First, get correct location of module "folder_name" or "name" value, to check... if (IsArray(configArray)) then 'get index location of "folder_name" or directory name assigned to module, for match For j = 0 to Ubound(configArray) if (Lcase(Cstr(configArray(j))) = "folder_name" or Lcase(Cstr(configArray(j))) = "folder_path") then index1 = j exit for end if Next 'get index location of "name" or value of node assigned in the configuration.xml file, for match For k = 0 to Ubound(configArray) if (Lcase(Cstr(configArray(k))) = "name" or Lcase(Cstr(configArray(k))) = "module_name") then index2 = k exit for end if Next 'get index location of "database_location" or value of node assigned in the configuration.xml file For l = 0 to Ubound(configArray) if (Lcase(Cstr(configArray(l))) = "database_location" or Lcase(Cstr(configArray(l))) = "database_path") then index3 = l exit for end if Next appArray = Application("II_MODULE_ARRAY") 'Use folder name index in check above to check MODULE_ARRAY stored values for match with NameOFModule in query 'Note: this check makes sure that a database location path exists, as well as presence of either folder_name or name if ((index1 >= 0 or index2 >= 0) and index3 >= 0) then 'first check folder name for the module for match...if not, check name stored in configuration.xml file for the module if (IsArray(appArray) and ubound(appArray,1) >= index1 and ubound(appArray,1) >= index2 and ubound(appArray,1) >= index3) then For m = 0 to Ubound(appArray,2) 'loop through application array to see if any module folder name or name stored there matches name of module requested if (appArray(index1,m) = NameOfModule or appArray(index2,m) = NameOfModule) then if (appArray(index3,m) = "" or IsEmpty(appArray(index3,m)) or IsNull(appArray(index3,m))) then 'means configuration.xml file for the module doesnt have a database_location value or empty 'so forces a rebuild below to see if database can be located physically... checkSuccess = false else 'SUCCESS!!! Go ahead and get the database path for this module in the array and pass out to calling method ModuleDatabaseLocation = appArray(index1,m) & "/" & appArray(index3,m) 'Now, test to see if the user has added parent path, or a "SECURE DATABASE PATH" (ie ../../Database/ModuleName/Data) if InStr(ModuleDatabaseLocation,".") then 'Only return path from configuration.xml file for module (ie ../../Database/ModuleName/Data) ModuleDatabaseLocation = appArray(index3,m) end if checkSuccess = true exit for end if end if Next end if end if '############### MODULE LOST!!! RUN AUTO MODULE REPAIRER ################### 'If no valid database location value is found above, this very cool code below 'checks the system to try and rebuild/repair the MODULE_ARRAY in application scoped variable list and tries 'to capture correct database values for a module thats required from the configuration value. 'This sometimes occurs if the user has changed module folder names in the physical file folder system 'on the server. The database calls from other modules can no longer find that module's data, so connection 'with the module is broken. 'If module is still not found, this system code below dynamically does a search for a folder with the 'configuration value matching the database call and then for a folder in there called 'Data'. 'If the 'Data' folder is found, system then uses that for the database! 'Note: If this call fails checker below, then database for the module is not found and needs to download the correct module 'or type in a valid module folder name with data base path inside. 'Now see if you can pull up Module data, dynamically, by rebuilding the application array. 'Trying to locate and find both module folder and configuration.xml database info on-the-fly, if possible. if (checkSuccess = false) then 'Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Attempting to repair system (rebuilding module list)
" '++++++++++ REBUILD MODULE LISTING ++++++++ 'The array is rebuilt here to see if the system can find the missing module and database 'required by the web page calling this object Me.BuildFullArray(Me.modulePath) '++++++++++++++++++++++++++++++++++++++++++ 'Rerun same check as above to see if this fixes the missing array problem Dim TheFolderObject,tempPath Set TheFolderObject = CreateObject("Scripting.FileSystemObject") tempPath = "" appArray = Application("II_MODULE_ARRAY") if ((index1 >= 0 or index2 >= 0) and index3 >= 0) then if (IsArray(appArray) and ubound(appArray,1) >= index1 and ubound(appArray,1) >= index2 and ubound(appArray,1) >= index3) then For m = 0 to Ubound(appArray,2) if (appArray(index1,m) = NameOfModule or appArray(index2,m) = NameOfModule) then if (appArray(index3,m) = "" or IsEmpty(appArray(index3,m)) or IsNull(appArray(index3,m))) then 'Database STILL NOT FOUND so help user by doing a search for default location of Data folder is present... 'Attempt to build database location/path based on standard location for XML Database "Data" folder and if this exists for this module, and based on users module name entered, use this path everytime below... tempPath = Server.MapPath(Application("II_WEBROOT_PATH") & "/" & Application("II_MODULE_PATH") & "/" & NameOfModule & "/" & "Data") 'response.write("
PATH TEST: " & tempPath) If TheFolderObject.FolderExists(tempPath) Then ModuleDatabaseLocation = NameOfModule & "/" & "Data" checkSuccess = true end if Set TheFolderObject = nothing TheFolderObject = Empty Exit For else 'SUCCESS!!! Go ahead and get the database path for this module in the array and pass out to calling method ModuleDatabaseLocation = NameOfModule & "/" & appArray(index3,m) checkSuccess = true Exit For end if end if Next end if end if end if '################################################ 'Sorry, failed to find either the module, its folder name or name in its configuration.xml file, so send alert... if (checkSuccess = false) then Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, the following module is missing: " & NameOfModule & ". This page was trying to retrieve data from this module's database. Either the module is missing, the module folder's name is incorrect, the module does not have a database, or the module's database and information is missing. (note: check the database call in this web page and make sure your database call is using the correct module folder or module name found in its configuration.xml file. If not, try changing the folder name for the module or its configuration.xml name value so that they match the name used by the calling page. You may get more modules for this web application at " & Application("II_COMPANY_NAME") & "
" end if else Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, no modules found. You may be missing Application('CONFIGURATION_XML_VALUES') values or this file has been removed. (check SystemSettings.asp) You may get more modules for this web application at " & Application("II_COMPANY_NAME") & "
" end if LoadModule = checkSuccess '........................................................... If Err.number <> 0 then Call CaptureThisError("SystemDatabases.asp:Database Class:LoadModule:Check this file, class, and method for the error.") Err.Clear End If '........................................................... End Function '*********************************************************** '******************** LoadDatabase Function *************** 'This method is used to load the master database file or metadata "indexer.xml" file for each module database path stored in the MODULE_ARRAY. This indexer file contains paths to all tables in the database for that module. Gets the table folder locations and their respective table indexer files relative to the indexer. The indexer file controls all tables used by this module and tells the system where to find that table. Public Function LoadDatabase(ModuleDatabasePath,NameOfTable,ModuleTablePath) '............................................... On Error Resume Next '............................................... Dim tempPath,IndexerFile,myNodeList1,myNodeList2,myNodeList3,i LoadDatabase = false ModuleTablePath = "" 'SECURE DATABASE: Check if the user has added a secure database path in the configuration.xml file and enabled parent paths on the server. This secures the database one level above the web root, and the user moves the database there. Otherwise, use traditional path to Module's Database. 'NOTE: This will NOT work unless the Windows 2003 server is set with "parent paths" enabled on the web site. Otherwise will fail. if (InStr(ModuleDatabasePath,".")) then tempPath = ModuleDatabasePath & "/" & "indexer.xml" else tempPath = Application("II_WEBROOT_PATH") & "/" & Application("II_MODULE_PATH") & "/" & ModuleDatabasePath & "/" & "indexer.xml" end if 'DOES FILE EXIST AT THE FILE PATH?: First, check that the file exists... Set IndexerFile = Server.CreateObject("Scripting.FileSystemObject") if (IndexerFile.FileExists(server.MapPath(tempPath))) then 'Note, this reuses the 'XMLFile' object as that file was successfully loaded on class initialization above... if (not IsObject(Me.XMLFile)) then Set Me.XMLFile = Server.CreateObject("Microsoft.XMLDOM") 'BASIC properties Me.XMLFile.async = false Me.XMLFile.resolveExternals = false Me.XMLFile.preserveWhiteSpace = true Me.XMLFile.validateOnParse = false 'SECONDARY properties (optional here) only supported by later parsers Me.XMLFile.SetProperty "ServerHTTPRequest", false Me.XMLFile.SetProperty "SelectionLanguage", "XPath" 'Me.XMLFile.SetProperty "AllowDocumentFunction", true 'Me.XMLFile.SetProperty "ForcedResync", true end if LoadDatabase = Me.XMLFile.load(server.MapPath(tempPath))'tempPath 'WAS XML FILE LOADED?: check that the file was loaded, then if it is valid xml and was thus parsed... if (LoadDatabase) then 'Get the database table listing and store and cache into an array....store in the Application cache... 'This stored array will allow for faster referencing as the web application calls various tables in the database... 'get the table path as a text node value... Set myNodeList1 = Me.XMLFile.documentElement.selectNodes("/indexer/*") 'get database name from the attribute value... Set myNodeList2 = Me.XMLFile.documentElement.selectNodes("/indexer/table/@name") 'get database path from the attribute value... Set myNodeList3 = Me.XMLFile.documentElement.selectNodes("/indexer/table/@path") if myNodeList1.length > 0 then '*Note: An array of ALL tables for this database is built here, but not used yet 'In the future, having an array of all tables for the given database and module might be helpful. ReDim newArray(myNodeList1.length,1) For i = 0 To myNodeList1.length - 1 'Build array of available tables with their paths and names here (not used here) 'newArray(i,0) = myNodeList2.item(i).Text 'store name of table 'newArray(i,1) = myNodeList1.item(i).Text 'store path to table 'compare users database "name" with the name assigned to the table node attribute value 'if the same, the pass the table node's text value which is the path to the table's folder of xml data files if (myNodeList2.item(i).Text = NameOfTable) then '***LOADING SUCCESS: So, return true to calling method if file loaded and cache values of config in an application variable for reuse throughout the scope of the app LoadDatabase = true ModuleTablePath = myNodeList3.item(i).Text end if Next if (LoadDatabase = true) then AddError = "The module's database indexer.xml file loaded successfully! 'LoadDatabase' Method Successful! The XML Indexer File Data for this module was loaded correctly!
" else Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Database not found! Make sure your module is calling the correct table name, as found in the attribute value found in the module's database indexer.xml file.
" end if else 'NOTE: THIS MEANS THERE IS AN XML ERROR...missing nodes or data, but xml file is still well-formed Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! 'LoadDatabase' Method Error! The XML Database Indexer File was missing data. Please make sure the indexer.xml file is not corrupted!
" LoadDatabase = false ModuleTablePath = "" end if Set myNodeList1 = nothing Set myNodeList2 = nothing Set myNodeList3 = nothing else 'PARSE XML ERROR: FILE IS NOT WELL-FORMED! return false: parse error means file was not loaded LoadDatabase = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! 'LoadDatabase' Method. Configuration File not loaded. Checking parser for xml errors...
" 'IS THE XML FILE BAD-CANNOT BE PARSED?: Run xml error checker... If Me.XMLFile.parseError.errorCode <> 0 Then ModuleTablePath = "" Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Parse error: " & Me.XMLFile.parseError.reason & " (Your xml file may be damaged or corrupted. Please check your indexer.xml file located here):
" & tempPath & "
" 'Display XML parse error message in detail for troubleshooting the xml error in the file... Session("II_MESSAGE") = Session("II_MESSAGE") & "
Invalid XML Indexer Data file!
" _ & "Line No. " & Me.XMLFile.parseError.line & "
" _ & "Character: " & Me.XMLFile.parseError.linepos & "
" _ & "File Position: " & Me.XMLFile.parseError.filepos & "
" _ & "Source Text: " & Me.XMLFile.parseError.srcText & "
" _ & "Error Code: " & Me.XMLFile.parseError.errorCode & "
" _ & "Description: " & Me.XMLFile.parseError.reason & "
" '& "File URL: " & Me.XMLFile.parseError.url & "
" _ 'security risk: remove as shows path on server end If end if else LoadDatabase = false ModuleTablePath = "" Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! There was an error getting data on this page. The page is trying to access data, but the module's data indexer.xml file appears to be missing. Please check file path passed into the method, or the xml file name, path and content located here: " & tempPath & "
" end if Set IndexerFile = Nothing '........................................................... If Err.number <> 0 then Call CaptureThisError("SystemDatabases.asp:Database Class:LoadDatabase:Check this file, class, and method for the error.") Err.Clear End If '........................................................... End Function '*********************************************************** '****************** LoadTable Function ********************* 'This function is called below from various get and update functions and retrieves 'the individual indexer.xml table file that stores the metadata/list of information for the current table in a given database in a module. 'The array of data returned here (and arrays) is then used in other functions to loop through the xml set data files stored in the folder. 'Table nformation obtained here includes number of rows per set.xml file, number of columns of data, etc. '*********************************************************** Public Function LoadTable(ModuleDatabaseTablePath) '............................................... On Error Resume Next '............................................... Dim IndexerFile,tempPath tempPath = Application("II_WEBROOT_PATH") & "/" & Application("II_MODULE_PATH") & "/" & ModuleDatabaseTablePath & "/" & "indexer.xml" 'DOES FILE EXIST AT THE FILE PATH?: First, check that the file exists... Set IndexerFile = Server.CreateObject("Scripting.FileSystemObject") if (IndexerFile.FileExists(server.MapPath(tempPath))) then 'Note, this reuses the 'XMLFile' object as that file was successfully loaded on class initialization above... if (not IsObject(Me.XMLFile)) then Set Me.XMLFile = Server.CreateObject("Microsoft.XMLDOM") 'BASIC properties Me.XMLFile.async = false Me.XMLFile.resolveExternals = false Me.XMLFile.preserveWhiteSpace = true Me.XMLFile.validateOnParse = false 'SECONDARY properties (optional here) only supported by later parsers Me.XMLFile.SetProperty "ServerHTTPRequest", false Me.XMLFile.SetProperty "SelectionLanguage", "XPath" 'Me.XMLFile.SetProperty "AllowDocumentFunction", true 'Me.XMLFile.SetProperty "ForcedResync", true end if LoadTable = Me.XMLFile.load(server.MapPath(tempPath)) if (LoadTable) then 'Get the database table listing and store and cache into an array....store in the Application cache... 'This stored array will allow for faster referencing as the web application calls various tables in the database... Dim myNodeList0,myNodeList1,myNodeList2,myNodeList3,myNodeList4,i Set myNodeList0 = Me.XMLFile.documentElement.selectNodes("/table/c/*") 'get text node values: number of set.xml files for this table folder Set myNodeList1 = Me.XMLFile.documentElement.selectNodes("/table/s/*") 'get attribute values:no. of total records Set myNodeList2 = Me.XMLFile.documentElement.selectSingleNode("/table/@records") 'get attribute values:no. of records per set file Set myNodeList3 = Me.XMLFile.documentElement.selectSingleNode("/table/@rowsperfile") 'get attribute values:no. of columns per row Set myNodeList4 = Me.XMLFile.documentElement.selectSingleNode("/table/@colsperrow") 'special test to make sure attributes exist. If not, dont allow them to be stored... if (myNodeList1.length > 0 and TypeName(myNodeList2) <> "Nothing" and TypeName(myNodeList3) <> "Nothing" and TypeName(myNodeList4) <> "Nothing")then 'Redimension the table array based on the number of child nodes and attributes found in each table in the system 'Make sure you have at least 3 slots in the array to hold the attributes below... ReDim XMLTableColumnListArray(myNodeList0.length-1) ReDim XMLTableSetListArray(myNodeList1.length-1) ReDim XMLTableAttributeArray(2) 'Store just the attributes you need into the array's first dimension. Even though its 'bounds' will hold all value, currently we just need to manage this data here Me.XMLTableAttributeArray(0) = myNodeList2.Text Me.XMLTableAttributeArray(1) = myNodeList3.Text Me.XMLTableAttributeArray(2) = myNodeList4.Text For i = 0 To (myNodeList0.length - 1) Me.XMLTableColumnListArray(i) = myNodeList0.item(i).Text Next 'Store the starting row id's as found in the set nodes in the indexer and controlled by the rowsperfile attribute value in the same xml file For i = 0 To (myNodeList1.length - 1) Me.XMLTableSetListArray(i) = myNodeList1.item(i).Text Next AddError = "Database Individual Table indexer.xml file Loaded Successfully! 'LoadTable' Method Successful! The XML Table Indexer File Data was loaded correctly and stored in the application cache!
--STARTING ROW NUMBER FOR FIRST XML FILE SET: " & Me.XMLTableSetListArray(0) & "
--TOTAL NUMBER of SET XML FILES for this TABLE: " & Ubound(Me.XMLTableSetListArray) & "
--NUMBER OF RECORDS IN THIS TABLE: " & Me.XMLTableAttributeArray(0) & "
--NUMBER OF RECORDS PER SET FILE: " & Me.XMLTableAttributeArray(1) & "
--NUMBER OF COLUMNS PER ROW: " & Me.XMLTableAttributeArray(2) & "
" '***LOADING SUCCESS LoadTable = true 'return a boolean success/fail value from the actual method... else 'NOTE: THIS MEANS THERE IS AN XML ERROR...missing nodes or data, but xml file is still well-formed ReDim XMLTableAttributeArray(0) Me.XMLTableAttributeArray(0) = "" Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! 'LoadTable' Method Error! The XML Indexer File was missing data. Please make sure the indexer.xml file is not corrupted!
" LoadTable = false end if Set myNodeList0 = nothing Set myNodeList1 = nothing Set myNodeList2 = nothing Set myNodeList3 = nothing Set myNodeList4 = nothing else 'PARSE XML ERROR: FILE IS NOT WELL-FORMED! return false: parse error means file was not loaded LoadTable = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! 'LoadTable' Method. Table Indexer File not loaded. Checking parser for xml errors...
" 'IS THE XML FILE BAD-CANNOT BE PARSED?: Run loading xml error checker... If Me.XMLFile.parseError.errorCode <> 0 Then Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Parse error: " & Me.XMLFile.parseError.reason & " Your xml file may be damaged or corrupted. Please check your indexer.xml file located here:
" & tempPath & "
" 'Display XML parse error message in detail for troubleshooting the xml error in the file... Session("II_MESSAGE") = Session("II_MESSAGE") & "
Invalid XML Table Indexer Data file!
" _ & "Line No. " & Me.XMLFile.parseError.line & "
" _ & "Character: " & Me.XMLFile.parseError.linepos & "
" _ & "File Position: " & Me.XMLFile.parseError.filepos & "
" _ & "Source Text: " & Me.XMLFile.parseError.srcText & "
" _ & "Error Code: " & Me.XMLFile.parseError.errorCode & "
" _ & "Description: " & Me.XMLFile.parseError.reason & "
" '& "File URL: " & Me.XMLFile.parseError.url & "
" _ end If end if else LoadTable = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! 'LoadTable' Method. Indexer File path is incorrect: Please check file path passed into the method.
XML Indexer File Accessed: " & tempPath & "
" end if Set IndexerFile = Nothing '............................................................ If Err.number <> 0 then Call CaptureThisError("SystemDatabases.asp:Database Class:LoadTable:Check this file, class, and method for the error.") Err.Clear End If '............................................................ End Function '************************************************************* '************************************************************* Public Function GetFilteredData(NameOfModule,NameOfTable,XPath,TypeOfXPath,IDArray,IsTrue) 'This new function alls you to join data between two tables and return just the rows of data needed, rather than having to do a double loop on both sets, filtering by a certain value. This function allows you to query your first table for say, an array of ids found in a second table, and insert that array to get just the rows and id values from the second table. This is normally done in T-SQL using an "inner join", but here, allows you to call a simple method that allows the same sort of filtering on a key, or unique id value. Using this method, you want to return a single dimension array using GetData first, using "columns" values, then insert the array returned into this GetFilteredData function and return "rows" from your second table. '............................................................. On Error Resume Next '............................................................. Dim isDatabaseFound,isTableFound,isTableLoaded,ModuleAndDatabasePath,ModuleDatabaseTablePath,ModuleTablePath ModuleAndDatabasePath = "" ModuleTablePath = "" ModuleDatabaseTablePath = "" isDatabaseFound = false isTableFound = false isTableLoaded = false GetFilteredData = null dim d,c,numberOfIDRows,theStringQuery,newArray,theCounter Redim newArray(-1) theStringQuery = "id=0 " theCounter = 0 if (IsNull(TypeOfXPath) or IsEmpty(TypeOfXPath) or TypeOfXPath = "") then TypeOfXPath = "columns" end if 'FIRST, CHECK MODULE/DATABASE EXISTS: Finds the module folder name and its child database folder name and returns them as a string. Call method to check if name of module exists, and if not, attempt to find it and return the database path for the module named Note: ModuleAndDatabasePath's value is passed back from the function to the variable ByRef, and is in the format "Modulefoldername/Datafoldername" isDatabaseFound = LoadModule(NameOfModule,ModuleAndDatabasePath) 'Response.Write("
TEST: " & ModuleAndDatabasePath) 'Response.Write("
TEST: " & isDatabaseFound) if (isDatabaseFound) then 'SECOND, LOAD DATABASE TABLES LIST: Finds the matching table folder name thats contained in the given module's database. Note: ModuleTablePath's value is passed back from the function to the variable ByRef, and is in the format "ModuleTableFolderName" isTableFound = LoadDatabase(ModuleAndDatabasePath,NameOfTable,ModuleTablePath) 'Response.Write("
TEST: " & ModuleTablePath) 'Response.Write("
TEST: " & isTableFound) if (isTableFound) then 'THIRD, BUILD COMBINED PATH TO THE TABLE FOLDER AND LOAD TABLE VALUES ModuleDatabaseTablePath = ModuleAndDatabasePath & "/" & ModuleTablePath isTableLoaded = LoadTable(ModuleDatabaseTablePath) 'Response.Write("
TEST: " & ModuleDatabaseTablePath) 'Response.Write("
TEST: " & isTableLoaded) if (isTableLoaded) then 'Response.Write("
Me.XMLTableAttributeArray(0): " & Me.XMLTableAttributeArray(0)) 'Response.Write("
Me.XMLTableColumnListArray(0): " & Me.XMLTableColumnListArray(0)) 'Response.Write("
Me.XMLTableSetListArray(0): " & Me.XMLTableSetListArray(0)) '+++++++++++++++++++++++++++ BEGIN LOAD DATA ++++++++++++++++++++++++++++++++++++++ Dim columnsAllowed,XMLDataArrayRows(),XMLDataArray(),q,tempPath,TheFile,ThePath,wasLoaded,DataSet,myNodeList1,newUBound,dontStoreAgain,r,s,myColumn,newUBound1,tempNewXPath,str1,str2,tempUBound1,tempUBound2,tempWasLoaded,e,SetFileNum,previousSetFileNum tempUBound1 = 0 tempUBound2 = 0 SetFileNum = 0 previousSetFileNum = -1'SetFileNum and this value must be different at first to make sure first set.xml file is always loaded 'The path for the modules set files... ThePath = Application("II_WEBROOT_PATH") & "/" & Application("II_MODULE_PATH") & "/" & ModuleDatabaseTablePath & "/" Set TheFile = Server.CreateObject("Scripting.FileSystemObject") 'Stores number of columns allowed per table as set in the tables indexer.xml file. 'Note: Make sure column value is set to at least '1'. columnsAllowed = Me.XMLTableAttributeArray(2) 'reset the 'XMLDataArray' Redim XMLDataArray(0) tempWasLoaded = false dontStoreAgain = 0 '***************************** if (columnsAllowed = "" or columnsAllowed = 0) then columnsAllowed = 1 elseif (IsNull(columnsAllowed) or IsEmpty(columnsAllowed) or columnsAllowed = 0 or IsObject(columnsAllowed)) then columnsAllowed = 1 end if 'SET NEW ARRAY OF DATATABLE ROWS: The actual numerical 'index' of the array is always the size or length returned less 1 'Note: If "TypeOfXPath" is "rows", then this 2-d array is used to store column and row data from set xml file below. Redim XMLDataArrayRows((columnsAllowed-1),0) 'GET LIST OF SET XML FILES in the table folder, base on whats in the tables indexer.xml listing. tempUBound1 = (UBound(IDArray) - LBound(IDArray)) tempUBound2 = (Ubound(Me.XMLTableSetListArray) - Lbound(Me.XMLTableSetListArray)) '**************************************************************** '#################### QUERY TEST ######################## 'Note: If the "IsTrue" value is true in the paramter list for this function, then call only the id's in the arrar from the database set xml files. 'If the "IsTrue" value is false, that means call ALL files in the database but the ones sent. In that case, an XPATH query is built below, 'and sent to the GetData call below, that calls all xml files in the system for the values needed. if (IsTrue) then' 'Continue processing this function... else 'Build new query and send to GetData function... '============== FILTER XPATH ID QUERY BY ID VALUES NOT USED ===================== 'Custom build an addition to the existing XPATH call: example might return "/s/r[isdeleted!=1 and (id=0 or id=3 or id=8)]/id" str1 = "(id!=0" str2 = " and id!=" theStringQuery = str1 'Get the id array of values from the other table you want to query in this table if (IsArray(IDArray)) then if (Ubound(IDArray) >= 0) then 'Loop through all id's in the array parameter looking for just the id's that fit the range of id's found 'in this set for the this table. For d = 0 To UBound(IDArray) 'If the id array value is within the current id range for the current set file in the table, then build query xpath string if (IsNumeric(IDArray(d))) then if (CInt(IDArray(d)) > CInt(0)) then 'Response.Write("
DATABASE ID: " & IDArray(d)) theStringQuery = theStringQuery & str2 & IDArray(d) Exit For end if end if Next end if end if theStringQuery = theStringQuery & ")" 'IMPORTANT - test what the user has used as a xpth query string and make sure you find the right pattern to put the new id querystring 'If none found, do not insert filter! if (InStr(XPath,"r[")) then tempNewXPath = Replace(XPath,"]"," and " & theStringQuery & "]") elseif (InStr(XPath,"/r/")) then tempNewXPath = Replace(XPath,"/r","/r[" & theStringQuery & "]/") else 'else, do not modify query by the array (as not known where to apply the filter???) tempNewXPath = XPath end if 'Response.Write("
STRINGS QUERY: " & tempNewXPath) '============================================================================== GetFilteredData = GetData(NameOfModule,NameOfTable,tempNewXPath,TypeOfXPath) exit function end if '######################################################## '--------------------------- BEGIN LOOP ---------------------------- 'Loop through ALL AVAILABLE XML ROW 'SET' FILES FOR THIS TABLE... For q = 0 To tempUBound1 SetFileNum = 0 '**************** NOW LOAD ONLY THE SET FILE NEEDED ************* if (IsNumeric(IDArray(q))) then if (CInt(IDArray(q)) > CInt(0)) Then For e = 0 to tempUBound2 if (IsNumeric(Me.XMLTableSetListArray(e))) then if (CInt(Me.XMLTableSetListArray(e)) < CInt(IDArray(q))) then 'This will get the last index of the last set file that could hold the index of the id needed 'In this way, for each filter array id provided, only the set xml file with that id will be loaded and queried. SetFileNum = e else exit for end if end if Next end if end if '******************************************************************* 'Create the path to each 'set.xml' file found above and loop through them looking for data... tempPath = server.MapPath(ThePath) & "\" & "set" & SetFileNum & ".xml" if (CInt(previousSetFileNum) = CInt(SetFileNum) or TheFile.FileExists(tempPath)) then if (CInt(previousSetFileNum) <> CInt(SetFileNum)) then 'This allows you to use the previous XML file loaded into memory if it contains the next file id in the array. wasLoaded = LoadXMLFile(tempPath) else wasLoaded = true end if if wasLoaded then '============== NEW! FILTER XPATH ID QUERY BY NEW ARRAY ===================== 'Custom build an addition to the existing XPATH call: example might return "/s/r[isdeleted!=1 and (id=0 or id=3 or id=8)]/id" 'IMPORTANT: There are two kinds of filtered queries below. 1 - If IsTrue is true, the get only those id's submitted to this function. 'IfTrue is false, then that means get all id's EXCEPT those in the array. In that case, this function must built the non-queried id list then call "GetData" for this new prebuilt xpath on ALL RECORDS! 'Response.Write("
IsArray(IDArray): " & IsArray(IDArray)) 'Response.Write("
IsNumeric(IDArray(q)): " & IsNumeric(IDArray(q))) 'Response.Write("
CInt(IDArray(q)): " & CInt(IDArray(q))) 'default empty query value theStringQuery = "id=0" 'Get the id array of values from the other table you want to query in this table if (IsArray(IDArray)) then if (IsNumeric(IDArray(q))) then if (CInt(IDArray(q)) > CInt(0)) Then 'Response.Write("
DATABASE ID: " & IDArray(q)) theStringQuery = "id=" & IDArray(q) end if end if end if 'response.write("
SYSTEM DATABASES:theStringQuery: " & theStringQuery) 'IMPORTANT - test what the user has used as a xpth query string and make sure you find the right pattern to put the new id querystring 'If none found, do not insert filter! if (InStr(XPath,"r[")) then tempNewXPath = Replace(XPath,"]"," and " & theStringQuery & "]") elseif (InStr(XPath,"/r/")) then tempNewXPath = Replace(XPath,"/r/","/r[" & theStringQuery & "]/") else 'else, do not modify query by the array (as not known where to apply the filter???) tempNewXPath = XPath end if 'Response.Write("
DATABASE XPATH: " & tempNewXPath) '============================================================================== '++++++++++++++++++++++++++++++ GET THE DATA FROM THE XML FILES ++++++++++++++++++++++++++++++++++ 'SUCCESS!: file loaded! If 'set.xml' file loaded, then run query and add to array of data... '**********SET FILE LOADED WITH CURRENT ROWS...NOW CHECK FOR DATA IN XPATH*********** 'Extract data.... 'Now, if getting only single columns from rows, then type passed in will be "1" 'Otherwise if '2', the loop needs to query the "r" rows and get all columns found there and store in a 2-d array if (TypeOfXPath = "columns") then 'GET SINGLE ARRAY COLUMN OF DATA '======================================== Set myNodeList1 = Me.XMLFile.documentElement.selectNodes(tempNewXPath) 'Keeps adding 'text' values to the array from each 'set' file 'Because the array call is special when the index is '0', use the first condition then the second for all others... newUBound = (UBound(XMLDataArray)-LBound(XMLDataArray))'start off array where the last set file list of values was stored if myNodeList1.length > 0 then if (newUBound = 0 and dontStoreAgain = 0) then 'FIRST SET.XML FILE DATA IS STORED IN THIS CONDITION ReDim Preserve XMLDataArray((newUBound + myNodeList1.length - 1)) dontStoreAgain = 1 'make sure the 0 index in the array is never written to again with data! For r = 0 To (myNodeList1.length-1) XMLDataArray(newUBound + r) = myNodeList1.item(r).Text '*TEST QUERY LOOP: UNCOMMENT BELOW TO DISPLAY QUERY LIST RESULTS IN HEADER MESSAGE IN BROWSER 'Session("II_MESSAGE") = Session("II_MESSAGE") & "TEST LOOP 1: " & myNodeList1.item(r).Text & "
" Next else 'ALL OTHER SET.XML FILE DATA IS STORED UNDER THIS CONDITION ReDim Preserve XMLDataArray((newUBound + myNodeList1.length)) For r = 0 To (myNodeList1.length-1) XMLDataArray(newUBound + r + 1) = myNodeList1.item(r).Text '*TEST QUERY LOOP: UNCOMMENT BELOW TO DISPLAY QUERY LIST RESULTS IN HEADER MESSAGE IN BROWSER 'Session("II_MESSAGE") = Session("II_MESSAGE") & "TEST LOOP 1: " & myNodeList1.item(r).Text & "
" Next end if end if 'We are recycling this Me.XMLFile so dont destroy here... 'Set myNodeList1 = Nothing '======================================== elseif (TypeOfXPath = "rows") then 'GET MULTIPLE ARRAY OF COLUMNS/ROWS DATA '======================================== 'THIS PULLS RECORDS OF DATA SO SYSTEM CAN GET TO COLUMNS and ROW ATTRIBUTE VALUES! Set myNodeList1 = Me.XMLFile.documentElement.selectNodes(tempNewXPath) 'Below, says to get the 'ubound of the second dimension in the array' 'Note: This is storing the 'column values' of the rows nodes in the first dimension, and the row numbers in the second newUBound1 = (UBound(XMLDataArrayRows,2)-LBound(XMLDataArrayRows,2))'start off array where the last set file list of values was stored 'Response.Write("Starting Array UBound: " & UBound(XMLDataArrayRows,2) & "
") if myNodeList1.length > 0 then if (newUBound1 = 0 and dontStoreAgain = 0) then 'Add more rows to array based on number of value matches for xpath query ReDim Preserve XMLDataArrayRows((columnsAllowed-1),(newUBound1 + myNodeList1.length - 1)) dontStoreAgain = 1 'make sure the 0 index in the array is never written to again with data! 'Response.Write("
myNodeList1.length: " & myNodeList1.length) For r = 0 To (myNodeList1.length-1)'loop through all rows with matching values... 'XMLDataArrayRows((columnsAllowed-1),newUBound1 + r) = myNodeList1.item(r).Text'add another row! '*TEST QUERY LOOP: UNCOMMENT BELOW TO DISPLAY QUERY LIST RESULTS IN HEADER MESSAGE IN BROWSER 'Session("II_MESSAGE") = Session("II_MESSAGE") & "TEST LOOP 1: " & myNodeList1.item(r).parentNode.nodeName & "
" '**************ALTERNATE NODE VALUE EXTRACTION****************** 'Note: This system returns all the attribute values of the "" row node and stores those in the array then all the child nodes values. Note, it skips the names of attributes and child nodes. Keep in mind any attributes added to child nodes inside rows will also appear in the 2-d array and so you can basically access all values starting with the rows first attribute (which is usually its "id" and on down to every column node value in the row s = 0 'This gets the queried nodes parent, which should be (row) and then all children of that, which is the rows field list or nodes list for that row in the XML file. For Each myColumn in myNodeList1.item(r).parentNode.childNodes '*TEST QUERY LOOP: UNCOMMENT BELOW TO DISPLAY QUERY LIST RESULTS IN HEADER MESSAGE IN BROWSER 'Session("II_MESSAGE") = Session("II_MESSAGE") & "TEST LOOP 1: " & myColumn.nodeName & "
" 'Session("II_MESSAGE") = Session("II_MESSAGE") & "TEST LOOP 1: " & myColumn.nodeType & "
" 'Session("II_MESSAGE") = Session("II_MESSAGE") & "TEST LOOP 1: " & columnsAllowed-1 & "
" 'Note: the 'attribute' called 'id' in the 'r' row element is considered a childNode so will be included 'in the array data generated below...but this code checks for child node names and skips those values 'but gets their stored text nodes...1 is a text node and 3 is a child node with name, which we dont want! 'NOTE: Support for value types in the database beyond TEXT types is not supported at this time using the code below... 'Filters out only element nodes and gets their atomic values(node type list: http://www.w3schools.com/dom/dom_nodetype.asp) 'Get TEXT and their text values only...check that the current node's parent is a row....all other node vlaues hide! 'First make sure the number of actual columns in the set files does NOT exceed the number set in the colsperrow attribute in the indexer.xml file ' ADD AN ROW ATTRIBUTE VALUE... ' Shows how to get an attribute value for the ROW node, if needed later... ' if (s=0) then ' Me.XMLDataArrayRows(0,newUBound1 + r) = myNodeList1.item(r).attributes(0).value ' s = s+1 ' end if 'Make sure you dont exceed the allowed column list as assigned in the XMLTableColumnListArray 'and pulled from the index.xml file for the table if (s <= columnsAllowed-1) then 'filter out only the text values if (myColumn.nodeType = 1) then XMLDataArrayRows(s,newUBound1 + r) = myColumn.Text 'Response.Write("
XMLDataArrayRows(s,newUBound1 + r): " & XMLDataArrayRows(s,newUBound1 + r)) '*TEST QUERY LOOP: UNCOMMENT BELOW TO DISPLAY QUERY LIST RESULTS IN HEADER MESSAGE IN BROWSER 'Session("II_MESSAGE") = Session("II_MESSAGE") & "TEST LOOP 1: " & myColumn.Text & "
" s=s+1 end if end if Next 'Set myColumn = Nothing 'Fill extra column index values in XMLDataArrayRows array with empty values, if not full 'ARRAY CLEANUP: Any empty array indices that are not filled by column data fill with "empty text strings"... 'This would occur if you have a higher colsperrow value in the indexer attribute than are columns per row 'This prevents the array from storing a large series of text values in the last array index equal to all 'the nodes text values and covers scenarios where the use has increased the colsperrow value in the 'indexer which is greater than the actual columns stored in the rows in the set files themsleves... if (s < (columnsAllowed-1)) then For s = s to (columnsAllowed-1) XMLDataArrayRows(s,newUBound1 + r) = "" s=s+1 Next end if '----------------------------- 'Use for accessing "subnodes" beneath a node extracted via XPath above... 'Most of the time you should not need this as your XPath should cover this query. But for subnodes, may be helpful later 'For Each item in myNodeList 'item.selectSingleNode("URL").nodeTypedValue 'item.selectSingleNode("Title").nodeTypedValue 'Next 'Set tester = objXMLDoc2.documentElement.selectNodes("/s/r")'GET RIGHT ROWS... 'For Each x In tester.documentElement.childNodes 'tester.documentElement.appendChild x 'Next '*************************************************************** Next else ReDim Preserve XMLDataArrayRows((columnsAllowed-1),(newUBound1 + myNodeList1.length)) For r = 0 To (myNodeList1.length-1) 'XMLDataArrayRows((columnsAllowed-1),newUBound1 + r + 1) = myNodeList1.item(r).Text '**************ALTERNATE NODE VALUE EXTRACTION****************** s = 0 For Each myColumn in myNodeList1.item(r).parentNode.childNodes ' ADD AN ROW ATTRIBUTE VALUE... ' Shows how to get an attribute value for the ROW node, if needed later... ' if (s=0) then ' Me.XMLDataArrayRows(0,newUBound1 + r + 1) = myNodeList1.item(r).attributes(0).value ' s = s+1 ' end if 'Make sure you dont exceed the allowed column list as assigned in the XMLTableColumnListArray 'and pulled from the index.xml file for the table if (s <= columnsAllowed-1) then 'filter out only the text values if (myColumn.nodeType = 1) then XMLDataArrayRows(s,newUBound1 + r + 1) = myColumn.Text 'Response.Write("
XMLDataArrayRows(s,newUBound1 + r)2: " & XMLDataArrayRows(s,newUBound1 + r)) '*TEST QUERY LOOP: UNCOMMENT BELOW TO DISPLAY QUERY LIST RESULTS IN HEADER MESSAGE IN BROWSER 'Session("II_MESSAGE") = Session("II_MESSAGE") & "TEST LOOP 1: " & myColumn.Text & "
" 'Response.Write("
myColumn.Text2: " & myColumn.Text) s=s+1 end if end if Next Set myColumn = Nothing 'Fill extra column index values in XMLDataArrayRows array with empty values, if not full ' clean up all empty column array indices if (s < (columnsAllowed-1)) then For s = s to (columnsAllowed-1) XMLDataArrayRows(s,newUBound1 + r + 1) = "" s=s+1 Next end if '*************************************************************** Next end if 'Response.Write("ENDING Array UBound: " & UBound(XMLDataArrayRows,2) & "
") end if 'We are recycling this Me.XMLFile so dont destroy here... 'Set myNodeList1 = Nothing '======================================== end if '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ else Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, there was a problem with your call to the Module's database. A 'set.xml' file inside one of its database tables would not load. ('GetFilteredData' Method). XML File Attempted: " & tempPath & "
" end if end if 'Move to load next set.xml file.... 'reset to false to make sure tests pass for each load of an xml file above... wasLoaded = false 'This value is used below to allow the system to not have to relaod a set.xml file if its been previously loaded for the last id previousSetFileNum = SetFileNum 'Response.Write("
DATABASE LOOP: " & XMLDataArrayRows(0,0)) Next '-------------------------- END LOOP ----------------------------- '************************************************************************* '************************************************************************* 'NOW PASS BACK THE DATA ARRAY STORED FROM THE SET XML FILES TO BYREF OBJECT IN THE XMLDATAMANAGER CLASS... if (TypeOfXPath = "columns") then GetFilteredData = XMLDataArray elseif (TypeOfXPath = "rows") then GetFilteredData = XMLDataArrayRows end if '************************************************************************* '************************************************************************* 'close the filesystem object in memory Set TheFile = Nothing '+++++++++++++++++++++++++++ END LOAD DATA ++++++++++++++++++++++++++++++++++++++ else Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, there is a problem with the indexer.xml file for the module and database table called from within this page. (Please verify that the database table indexer.xml file for the module you are accessing is valid.)(GetFilteredData Method)
" end if else Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, there is a problem with the indexer.xml file for the module and database called from within this page. (Please verify that the database folder for the module you are accessing has a valid indexer.xml file.)(GetFilteredData Method)
" end if else Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, this module and its database can not be used in this page. (Please verify that this page is calling the right module and database.)(GetFilteredData Method)
" end if '........................................................... If Err.number <> 0 then Call CaptureThisError("SystemDatabases.asp:Database Class:GetFilteredData:Check this file, class, and method for the error.") Err.Clear End If '........................................................... End Function '************************************************************* '************************************************************* Public Function GetData(NameOfModule,NameOfTable,XPath,TypeOfXPath) 'Use GetData for all major calls for accessing data from module xml database tables. 'Note - the current xpath system only supports xpath structures as follows: "/s/r[filter or expression]/columnname" 'In general, try and use this xpath structure when querying either a single column or rows with multiple columns '............................................................. On Error Resume Next '............................................................. Dim isDatabaseFound,isTableFound,isTableLoaded,ModuleAndDatabasePath,ModuleDatabaseTablePath,ModuleTablePath ModuleAndDatabasePath = "" ModuleTablePath = "" ModuleDatabaseTablePath = "" isDatabaseFound = false isTableFound = false isTableLoaded = false GetData = null if (IsNull(TypeOfXPath) or IsEmpty(TypeOfXPath) or TypeOfXPath = "") then TypeOfXPath = "columns" end if 'FIRST, CHECK MODULE/DATABASE EXISTS: Finds the module foilder name and its child database folder name and returns them as a string. Call method to check if name of module exists, and if not, attempt to find it and return the database path for the module named Note: ModuleAndDatabasePath's value is passed back from the function to the variable ByRef, and is in the format "Modulefoldername/Datafoldername" isDatabaseFound = LoadModule(NameOfModule,ModuleAndDatabasePath) 'Response.Write("
TEST: " & ModuleAndDatabasePath) 'Response.Write("
TEST: " & isDatabaseFound) if (isDatabaseFound) then 'SECOND, LOAD DATABASE TABLES LIST: Finds the matching table folder name thats contained in the given module's database. Note: ModuleTablePath's value is passed back from the function to the variable ByRef, and is in the format "ModuleTableFolderName" isTableFound = LoadDatabase(ModuleAndDatabasePath,NameOfTable,ModuleTablePath) 'Response.Write("
TEST: " & ModuleTablePath) 'Response.Write("
TEST: " & isTableFound) if (isTableFound) then 'THIRD, BUILD COMBINED PATH TO THE TABLE FOLDER AND LOAD TABLE VALUES ModuleDatabaseTablePath = ModuleAndDatabasePath & "/" & ModuleTablePath isTableLoaded = LoadTable(ModuleDatabaseTablePath) 'Response.Write("
TEST: " & ModuleDatabaseTablePath) 'Response.Write("
TEST: " & isTableLoaded) if (isTableLoaded) then 'Response.Write("
Me.XMLTableAttributeArray(0): " & Me.XMLTableAttributeArray(0)) 'Response.Write("
Me.XMLTableColumnListArray(0): " & Me.XMLTableColumnListArray(0)) 'Response.Write("
Me.XMLTableSetListArray(0): " & Me.XMLTableSetListArray(0)) '+++++++++++++++++++++++++++ BEGIN LOAD DATA ++++++++++++++++++++++++++++++++++++++ Dim columnsAllowed,tempUBound,XMLDataArrayRows(),XMLDataArray(),q,tempPath,TheFile,ThePath,wasLoaded,DataSet,myNodeList1,newUBound,dontStoreAgain,r,s,myColumn,newUBound1 ThePath = Application("II_WEBROOT_PATH") & "/" & Application("II_MODULE_PATH") & "/" & ModuleDatabaseTablePath & "/" Set TheFile = Server.CreateObject("Scripting.FileSystemObject") 'Stores number of columns allowed per table as set in the tables indexer.xml file. 'Note: Make sure column value is set to at least '1'. columnsAllowed = Me.XMLTableAttributeArray(2) 'reset the 'XMLDataArray' Redim XMLDataArray(0) tempWasLoaded = false dontStoreAgain = 0 '***************************** if (columnsAllowed = "" or columnsAllowed = 0) then columnsAllowed = 1 elseif (IsNull(columnsAllowed) or IsEmpty(columnsAllowed) or columnsAllowed = 0 or IsObject(columnsAllowed)) then columnsAllowed = 1 end if 'SET NEW ARRAY OF DATATABLE ROWS: The actual numerical 'index' of the array is always the size or length returned less 1 Redim XMLDataArrayRows((columnsAllowed-1),0) 'GET LIST OF SET XML FILES in the table folder, base on whats in the tables indexer.xml listing. 'Loop through them using the array index of all set files pulled from the table indexer.xml file 'Note: Pulls the ubound of the array which should be the number of set files in the system, as 'taken from the nodes found in the tables indexer file. tempUBound = (Ubound(Me.XMLTableSetListArray) - Lbound(Me.XMLTableSetListArray)) 'Loop through ALL AVAILABLE XML ROW 'SET' FILES FOR THIS TABLE... For q = 0 To tempUBound 'Create the path to each 'set.xml' file found above and loop through them looking for data... tempPath = server.MapPath(ThePath) & "\" & "set" & (q) & ".xml" 'Response.Write("
TEST: " & tempPath) if TheFile.FileExists(tempPath) then wasLoaded = LoadXMLFile(tempPath) 'Response.Write("
TEST: " & wasLoaded) if wasLoaded then '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 'SUCCESS!: file loaded! If 'set.xml' file loaded, then run query and add to array of data... '**********SET FILE LOADED WITH CURRENT ROWS...NOW CHECK FOR DATA IN XPATH*********** 'Extract data.... 'Now, if geeting only single columns from rows, then type passed in will be "1" 'Otherwise if '2', the loop needs to query the "r" rows and get all columns found there and store in a 2-d array if (TypeOfXPath = "columns") then 'GET SINGLE ARRAY COLUMN OF DATA '======================================== Set myNodeList1 = Me.XMLFile.documentElement.selectNodes(XPath) 'Keeps adding 'text' values to the array from each 'set' file 'Because the array call is special when the index is '0', use the first condition then the second for all others... newUBound = (UBound(XMLDataArray)-LBound(XMLDataArray))'start off array where the last set file list of values was stored if myNodeList1.length > 0 then if (newUBound = 0 and dontStoreAgain = 0) then 'FIRST SET.XML FILE DATA IS STORED IN THIS CONDITION ReDim Preserve XMLDataArray((newUBound + myNodeList1.length - 1)) dontStoreAgain = 1 'make sure the 0 index in the array is never written to again with data! For r = 0 To (myNodeList1.length-1) XMLDataArray(newUBound + r) = myNodeList1.item(r).Text '*TEST QUERY LOOP: UNCOMMENT BELOW TO DISPLAY QUERY LIST RESULTS IN HEADER MESSAGE IN BROWSER 'Session("II_MESSAGE") = Session("II_MESSAGE") & "TEST LOOP 1: " & myNodeList1.item(r).Text & "
" Next else 'ALL OTHER SET.XML FILE DATA IS STORED UNDER THIS CONDITION ReDim Preserve XMLDataArray((newUBound + myNodeList1.length)) For r = 0 To (myNodeList1.length-1) XMLDataArray(newUBound + r + 1) = myNodeList1.item(r).Text '*TEST QUERY LOOP: UNCOMMENT BELOW TO DISPLAY QUERY LIST RESULTS IN HEADER MESSAGE IN BROWSER 'Session("II_MESSAGE") = Session("II_MESSAGE") & "TEST LOOP 1: " & myNodeList1.item(r).Text & "
" Next end if end if Set myNodeList1 = Nothing '======================================== elseif (TypeOfXPath = "rows") then 'GET MULTIPLE ARRAY OF COLUMNS/ROWS DATA '======================================== 'THIS PULLS RECORDS OF DATA SO I CAN GET TO COLUMNS and ROW ATTRIBUTE VALUES! Set myNodeList1 = Me.XMLFile.documentElement.selectNodes(XPath) 'Below, says to get the 'ubound of the second dimension in the array' 'Note: This is storing the 'column values' of the rows nodes in the first dimension, and the row numbers in the second newUBound1 = (UBound(XMLDataArrayRows,2)-LBound(XMLDataArrayRows,2))'start off array where the last set file list of values was stored 'Response.Write("Starting Array UBound: " & UBound(XMLDataArrayRows,2) & "
") if myNodeList1.length > 0 then if (newUBound1 = 0 and dontStoreAgain = 0) then 'Add more rows to array based on number of value matches for xpath query ReDim Preserve XMLDataArrayRows((columnsAllowed-1),(newUBound1 + myNodeList1.length - 1)) dontStoreAgain = 1 'make sure the 0 index in the array is never written to again with data! For r = 0 To (myNodeList1.length-1)'loop through all rows with matching values... 'XMLDataArrayRows((columnsAllowed-1),newUBound1 + r) = myNodeList1.item(r).Text'add another row! '*TEST QUERY LOOP: UNCOMMENT BELOW TO DISPLAY QUERY LIST RESULTS IN HEADER MESSAGE IN BROWSER 'Session("II_MESSAGE") = Session("II_MESSAGE") & "TEST LOOP 1: " & myNodeList1.item(r).parentNode.nodeName & "
" '**************ALTERNATE NODE VALUE EXTRACTION****************** 'Note: this system returns FIRST, all the attribute values of the "" row node and stores those in the array then all the child nodes values. Note, it skips the names of attributes and child nodes. Keep in mind any attributes added to chold nodes inside rows will also appear in the 2-d array and so you can basically access all values starting with the rows first attribute (which is usually its "id" and on down to every column node value in the row s = 0 'This gets the queried nodes parent, which should be (row) and then all children of that, which is the rows field list or nodes list for that row in the XML file. For Each myColumn in myNodeList1.item(r).parentNode.childNodes '*TEST QUERY LOOP: UNCOMMENT BELOW TO DISPLAY QUERY LIST RESULTS IN HEADER MESSAGE IN BROWSER 'Session("II_MESSAGE") = Session("II_MESSAGE") & "TEST LOOP 1: " & myColumn.nodeName & "
" 'Session("II_MESSAGE") = Session("II_MESSAGE") & "TEST LOOP 1: " & myColumn.nodeType & "
" 'Session("II_MESSAGE") = Session("II_MESSAGE") & "TEST LOOP 1: " & columnsAllowed-1 & "
" 'Note: the 'attribute' called 'id' in the 'r' row element is considered a childNode so will be included 'in the array data generated below...but this code checks for child node names and skips those values 'but gets their stored text nodes...1 is a text node and 3 is a child node with name, which we dont want! 'NOTE: Support for value types in the database beyond TEXT types is not supported at this time using the code below... 'Filters out only element nodes and gets their atomic values(node type list: http://www.w3schools.com/dom/dom_nodetype.asp) 'Get TEXT and their text values only...check that the current node's parent is a row....all other node vlaues hide! 'First make sure the number of actual columns in the set files does NOT exceed the number set in the colsperrow attribute in the indexer.xml file ' ADD AN ROW ATTRIBUTE VALUE... ' Shows how to get an attribute value for the ROW node, if needed later... ' if (s=0) then ' Me.XMLDataArrayRows(0,newUBound1 + r) = myNodeList1.item(r).attributes(0).value ' s = s+1 ' end if 'Make sure you dont exceed the allowed column list as assigned in the XMLTableColumnListArray 'and pulled from the index.xml file for the table if (s <= columnsAllowed-1) then 'filter out only the text values if (myColumn.nodeType = 1) then XMLDataArrayRows(s,newUBound1 + r) = myColumn.Text '*TEST QUERY LOOP: UNCOMMENT BELOW TO DISPLAY QUERY LIST RESULTS IN HEADER MESSAGE IN BROWSER 'Session("II_MESSAGE") = Session("II_MESSAGE") & "TEST LOOP 1: " & myColumn.Text & "
" s=s+1 end if end if Next Set myColumn = Nothing 'Fill extra column index values in XMLDataArrayRows array with empty values, if not full 'ARRAY CLEANUP: Any empty array indices that are not filled by column data fill with "empty text strings"... 'This would occur if you have a higher colsperrow value in the indexer attribute than are columns per row 'This prevents the array from storing a large series of text values in the last array index equal to all 'the nodes text values and covers scenarios where the use has increased the colsperrow value in the 'indexer which is greater than the actual columns stored in the rows in the set files themsleves... if (s < (columnsAllowed-1)) then For s = s to (columnsAllowed-1) XMLDataArrayRows(s,newUBound1 + r) = "" s=s+1 Next end if '----------------------------- 'Use for accessing "subnodes" beneath a node extracted via XPath above... 'Most of the time you should not need this as your XPath should cover this query. But for subnodes, may be helpful later 'For Each item in myNodeList 'item.selectSingleNode("URL").nodeTypedValue 'item.selectSingleNode("Title").nodeTypedValue 'Next 'Set tester = objXMLDoc2.documentElement.selectNodes("/s/r")'GET RIGHT ROWS... 'For Each x In tester.documentElement.childNodes 'tester.documentElement.appendChild x 'Next '*************************************************************** Next else ReDim Preserve XMLDataArrayRows((columnsAllowed-1),(newUBound1 + myNodeList1.length)) For r = 0 To (myNodeList1.length-1) 'XMLDataArrayRows((columnsAllowed-1),newUBound1 + r + 1) = myNodeList1.item(r).Text '**************ALTERNATE NODE VALUE EXTRACTION****************** s = 0 For Each myColumn in myNodeList1.item(r).parentNode.childNodes ' ADD AN ROW ATTRIBUTE VALUE... ' Shows how to get an attribute value for the ROW node, if needed later... ' if (s=0) then ' Me.XMLDataArrayRows(0,newUBound1 + r + 1) = myNodeList1.item(r).attributes(0).value ' s = s+1 ' end if 'Make sure you dont exceed the allowed column list as assigned in the XMLTableColumnListArray 'and pulled from the index.xml file for the table if (s <= columnsAllowed-1) then 'filter out only the text values if (myColumn.nodeType = 1) then XMLDataArrayRows(s,newUBound1 + r + 1) = myColumn.Text '*TEST QUERY LOOP: UNCOMMENT BELOW TO DISPLAY QUERY LIST RESULTS IN HEADER MESSAGE IN BROWSER 'Session("II_MESSAGE") = Session("II_MESSAGE") & "TEST LOOP 1: " & myColumn.Text & "
" s=s+1 end if end if Next Set myColumn = Nothing 'Fill extra column index values in XMLDataArrayRows array with empty values, if not full ' clean up all empty column array indices if (s < (columnsAllowed-1)) then For s = s to (columnsAllowed-1) XMLDataArrayRows(s,newUBound1 + r + 1) = "" s=s+1 Next end if '*************************************************************** Next end if 'Response.Write("ENDING Array UBound: " & UBound(XMLDataArrayRows,2) & "
") end if Set myNodeList1 = Nothing '======================================== end if '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ else Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, there was a problem with your call to the Module's database. A 'set.xml' file inside one of its database tables would not load. ('GetData' Method). XML File Attempted: " & tempPath & "
" end if end if 'Move to load next set.xml file.... 'reset to false to make sure tests pass for each load of an xml file above... wasLoaded = false Next '************************************************************************* '************************************************************************* 'NOW PASS BACK THE DATA ARRAY STORED FROM THE SET XML FILES TO BYREF OBJECT IN THE XMLDATAMANAGER CLASS... if (TypeOfXPath = "columns") then GetData = XMLDataArray elseif (TypeOfXPath = "rows") then GetData = XMLDataArrayRows end if '************************************************************************* '************************************************************************* 'close the filesystem object in memory Set TheFile = Nothing '+++++++++++++++++++++++++++ END LOAD DATA ++++++++++++++++++++++++++++++++++++++ else Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, there is a problem with the indexer.xml file for the module and database table called from within this page. (Please verify that the database table indexer.xml file for the module you are accessing is valid.)(GetData Method)
" end if else Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, there is a problem with the indexer.xml file for the module and database called from within this page. (Please verify that the database folder for the module you are accessing has a valid indexer.xml file.)(GetData Method)
" end if else Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, this module and its database can not be used in this page. (Please verify that this page is calling the right module and database.)(GetData Method)
" end if '........................................................... If Err.number <> 0 then Call CaptureThisError("SystemDatabases.asp:Database Class:GetData:Check this file, class, and method for the error.") Err.Clear End If '........................................................... End Function '********************************************************** '******************** AddIndexerData Function ********************** 'Used to add a row of new set data to the set list in the chosen table's indexer.xml file. 'Called by the AddIndexerDataFunction below when it creates the actual new ROW added to 'the actual database set file. If the new set file and row is created by that function, then this function below 'is required to update the table's indexer.xml set row node list. '******************************************************************* Public Function AddIndexerData(NameOfModule,NameOfTable) '............................................................. On Error Resume Next '............................................................. Dim isDatabaseFound,isTableFound,isTableLoaded,ModuleAndDatabasePath,ModuleDatabaseTablePath,ModuleTablePath,NewXMLFile1 ModuleAndDatabasePath = "" ModuleTablePath = "" ModuleDatabaseTablePath = "" isDatabaseFound = false isTableFound = false isTableLoaded = false AddIndexerData = false 'FIRST, CHECK MODULE/DATABASE EXISTS: Finds the module foilder name and its child database folder name and returns them as a string. Call method to check if name of module exists, and if not, attempt to find it and return the database path for the module named Note: ModuleAndDatabasePath's value is passed back from the function to the variable ByRef, and is in the format "Modulefoldername/Datafoldername" isDatabaseFound = LoadModule(NameOfModule,ModuleAndDatabasePath) 'Response.Write("
TEST: " & ModuleAndDatabasePath) 'Response.Write("
TEST: " & isDatabaseFound) if (isDatabaseFound) then 'SECOND, LOAD DATABASE TABLES LIST: Finds the matching table folder name thats contained in the given module's database. Note: ModuleTablePath's value is passed back from the function to the variable ByRef, and is in the format "ModuleTableFolderName" isTableFound = LoadDatabase(ModuleAndDatabasePath,NameOfTable,ModuleTablePath) 'Response.Write("
TEST: " & ModuleTablePath) 'Response.Write("
TEST: " & isTableFound) if (isTableFound) then 'THIRD, BUILD COMBINED PATH TO THE TABLE FOLDER AND LOAD TABLE VALUES ModuleDatabaseTablePath = ModuleAndDatabasePath & "/" & ModuleTablePath isTableLoaded = LoadTable(ModuleDatabaseTablePath) 'Response.Write("
TEST: " & ModuleDatabaseTablePath) 'Response.Write("
TEST: " & isTableLoaded) if (isTableLoaded) then 'Response.Write("
Me.XMLTableAttributeArray(0): " & Me.XMLTableAttributeArray(0)) 'Response.Write("
Me.XMLTableColumnListArray(0): " & Me.XMLTableColumnListArray(0)) 'Response.Write("
Me.XMLTableSetListArray(0): " & Me.XMLTableSetListArray(0)) '+++++++++++++++++++++++++++ BEGIN ADD DATA ++++++++++++++++++++++++++++++++++++++ dim ThePath,TheFile,tempPath,wasLoaded,tempXMLFile,x,rowsPerFile,lastSetFileRow,node1,node2,node3,node4,node5 wasLoaded = false ThePath = Application("II_WEBROOT_PATH") & "/" & Application("II_MODULE_PATH") & "/" & ModuleDatabaseTablePath & "/" Set TheFile = Server.CreateObject("Scripting.FileSystemObject") 'Create the path to each 'set.xml' file found above and loop through them looking for data... tempPath = server.MapPath(ThePath) & "\" & "indexer.xml" 'Response.Write("
TEST: " & tempPath) if TheFile.FileExists(tempPath) then 'Create Fresh XML file for use below in creating a new xml file on the server... Set NewXMLFile1 = Server.CreateObject("Microsoft.XMLDOM") 'BASIC properties NewXMLFile1.async = false NewXMLFile1.resolveExternals = false NewXMLFile1.preserveWhiteSpace = true NewXMLFile1.validateOnParse = false 'SECONDARY properties (optional here) only supported by later parsers NewXMLFile1.SetProperty "ServerHTTPRequest", false NewXMLFile1.SetProperty "SelectionLanguage", "XPath" 'NewXMLFile1.SetProperty "AllowDocumentFunction", true 'NewXMLFile1.SetProperty "ForcedResync", true wasLoaded = NewXMLFile1.load(tempPath) if (wasLoaded) then 'Response.Write("
TEST: " & "SUCCESSFULLY LOADED!") 'Get all 'set' nodes inside the tables indexer.xml file... 'Also, use XPATH to get the last set file value added... set tempXMLFile = NewXMLFile1.documentElement.selectNodes("/table/s/set[last()]") 'Get the last set value entered and its value. You will use this to set the value of the next set row added to the indexer file... For Each x in tempXMLFile.item(0).ChildNodes lastSetFileRow = x.Text Next 'Make sure last set value in tables indexer.xml really is the last value! 'Good policy here to make sure whats created directly from the indexer matches what was stored earlier.... 'If not, use the Array value, as its used when the rows are actually added in the set.xml files themselves... 'If there is a mistake and the indexer.xml set file list gets corrupted, the system will store a fresh set row in the indexer.xml with a starting row value equal to whats used in the actual set.xml files. This helps make sure the indexer's set node listing and matching set.xml files match when possible... if CInt(lastSetFileRow) = Cint(Me.XMLTableSetListArray(Ubound(Me.XMLTableSetListArray))) then lastSetFileRow = CInt(lastSetFileRow) else lastSetFileRow = Cint(Me.XMLTableSetListArray(Ubound(Me.XMLTableSetListArray))) end if 'Stores number of rows allowed per table set.xml file... 'This is equal to the value of the attribute calls 'rowsperfile' set in the tables indexer.xml table node. 'Note: 'rowsperfile' inder.xml attribute allows you to manually change this value in the indexer using Notepad, if you like. The system will pick up the new value on next parse, and when it creates the next set.xml file with nodes, will allow the next set file to hold the new number of rows. This is powerful in that as your database grows, you can increase this attribute value so your set files hold more and more rows of data, and therefore need less set.xml file. Increases performance and volume of data you can hold. rowsPerFile = Me.XMLTableAttributeArray(1) 'Update the Tables Set File Array...(not used here, as next call to the Class will update this array automatically). 'newIndex = CInt(Ubound(Me.XMLTableSetListArray))+1 'Redim Preserve XMLTableSetListArray(newIndex) 'Add a new value to the array... 'XMLTableSetListArray(newIndex) = Cint(lastSetFileRow) + Cint(rowsPerFile) 'CREATE YOUR NEW 'SET' ROW WITH VALUE... set node1 = NewXMLFile1.documentElement.selectSingleNode("/table/s") set node2 = NewXMLFile1.createElement("set") set node3 = NewXMLFile1.createTextNode(Cint(lastSetFileRow) + Cint(rowsPerFile)) node2.appendChild(node3) node1.appendChild(node2) node1.appendChild NewXMLFile1.createTextNode(vbCrlf) 'creates new carriage return 'ATTACH THE ROW WITH ATTACHED COLUMNS TO THE FINAL XML ROOT NODE... 'Me.XMLFile.documentElement.appendChild(node1) 'Me.XMLFile.documentElement.appendChild Me.XMLFile.createTextNode(vbCrlf) 'creates new carriage return 'Me.XMLFile.documentElement.appendChild Me.XMLFile.createTextNode(vbNewLine) 'creates new empty line 'SAVE FILE... NewXMLFile1.save tempPath AddError = "'AddIndexerData' Method called. Success! New set node added to the table's indexer.xml file added correctly! XML File Attempted: " & NameOfTable AddIndexerData = true set tempXMLFile = Nothing end if Set NewXMLFile1 = Nothing end if set TheFile = Nothing '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ else AddIndexerData = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, there is a problem with the indexer.xml file for the module and database table called from within this page. (Please verify that the database table indexer.xml file for the module you are accessing is valid.)(AddIndexerData Method)
" end if else AddIndexerData = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, there is a problem with the indexer.xml file for the module and database called from within this page. (Please verify that the database folder for the module you are accessing has a valid indexer.xml file.)(AddIndexerData Method)
" end if else AddIndexerData = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, this module and its database can not be used in this page. (Please verify that this page is calling the right module and database.)(AddIndexerData Method)
" end if '........................................................... If Err.number <> 0 then Call CaptureThisError("SystemDatabases.asp:Database Class:AddIndexerData:Check this file, class, and method for the error.") Err.Clear End If '........................................................... End Function '********************************************************** '********** FUNCTION: CreateFile Function ********************* 'Creates Blank XML File. 'newPath - The path and file name of the XML file passed in. 'yourXML - Allows you to optionally pass in custom prewritten XML into the function thats written. 'IMPORTANT: Because your new XML file will NOT have a Document Root Element by default, 'you should add one into the 'yourXML' parameter as an example as follows: "". 'writeOver - Gives the method permision to write over other xml data files if they exist. 'Might be wise to turn that to false if you dont want senstive data written over in XML files 'Note: Be sure to assign 'READ/WRITE' permissions on your server to support the reading and writing of new XML files by the IUSR anonymous account... 'Note: 'Me.NewXMLSetFile' is stored as a class member and used in the 'AddData' method below for storing fresh set and row information inside of it. Public Function CreateFile(newPath, yourXML, writeOver) '............................................................. On Error Resume Next '............................................................. 'stores uploaded path into class field for use if loaded xml object leaves memory and fails Dim TheFile, errorText,wasLoaded,TheNewFile wasLoaded = false CreateFile = true Set TheFile = Server.CreateObject("Scripting.FileSystemObject") if (TheFile.FileExists(newPath) and not writeOver) then 'set whether you allow ability to write-over old xml file...dangerous! Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, 'CreateFile Method called. File already exists at this path: For safety purposes, please consider writing to another location. File write-over disallowed in the method!
XML File Accessed: " & newPath & "
" CreateFile = false else Set TheNewFile = TheFile.CreateTextFile(newPath, writeOver) TheNewFile.WriteLine("") TheNewFile.WriteLine(yourXML) TheNewFile.Close AddError = "'CreateFile' Method called. File written correctly with new data. Now run test to make sure it exists and is well-formed.
XML File Accessed: " & newPath & "
" 'Now, after creating file, make sure it exists and that it parses (no corrupt xml data) if TheFile.FileExists(newPath) then 'Create Fresh XML file for use below in creating a new xml file on the server... Set Me.NewXMLSetFile = Server.CreateObject("Microsoft.XMLDOM") 'BASIC properties Me.NewXMLSetFile.async = false Me.NewXMLSetFile.resolveExternals = false Me.NewXMLSetFile.preserveWhiteSpace = true Me.NewXMLSetFile.validateOnParse = false 'SECONDARY properties (optional here) only supported by later parsers Me.NewXMLSetFile.SetProperty "ServerHTTPRequest", false Me.NewXMLSetFile.SetProperty "SelectionLanguage", "XPath" 'Me.NewXMLSetFile.SetProperty "AllowDocumentFunction", true 'Me.NewXMLSetFile.SetProperty "ForcedResync", true Me.NewXMLSetFile.load(newPath) CreateFile = true 'IS THE XML FILE BAD-CANNOT BE PARSED?: Run loading xml error checker... If Me.NewXMLSetFile.parseError.errorCode <> 0 Then Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, 'CreateFile' Method called. Warning: XML file parse error: " & Me.NewXMLSetFile.parseError.reason & "
Your xml file may be damaged or corrupted or have bad xml data that is not well-formed. Please check your xml file located here: " & newPath & "
" 'Display XML parse error message in detail for troubleshooting the xml error in the file... Session("II_MESSAGE") = Session("II_MESSAGE") & "
Invalid XML file!
" _ & "Line No. " & Me.NewXMLSetFile.parseError.line & "
" _ & "Character: " & Me.NewXMLSetFile.parseError.linepos & "
" _ & "File Position: " & Me.NewXMLSetFile.parseError.filepos & "
" _ & "Source Text: " & Me.NewXMLSetFile.parseError.srcText & "
" _ & "Error Code: " & Me.NewXMLSetFile.parseError.errorCode & "
" _ & "Description: " & Me.NewXMLSetFile.parseError.reason & "
" '& "File URL: " & Me.NewXMLSetFile.parseError.url & "
" CreateFile = false end If else CreateFile = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, 'CreateFile' Method called. File does not exist and path may be incorrect: Please check file path passed into the method.
XML File Accessed: " & newPath & "
" end if end if Set TheFile = Nothing '........................................................... If Err.number <> 0 then Call CaptureThisError("SystemDatabases.asp:Database Class:CreateFile:Check this file, class, and method for the error.") Err.Clear End If '........................................................... End Function '********************************************************** '*************************AddData Function****************************** 'Used to add a row of new data. Passes in an array to each of the columns in the table provided. 'NOTE: When the system creates a new table row, you can return the "TheID" created for the row, and use that to call 'a table update and store data in that new row. '************************************************************************** Public Function AddData(NameOfModule,NameOfTable,ByRef TheID) '............................................................. On Error Resume Next '............................................................. Dim isDatabaseFound,isTableFound,isTableLoaded,ModuleAndDatabasePath,ModuleDatabaseTablePath,ModuleTablePath ModuleAndDatabasePath = "" ModuleTablePath = "" ModuleDatabaseTablePath = "" isDatabaseFound = false isTableFound = false isTableLoaded = false AddData = false 'TheID will be retrieved when the new row is added. Its sent back to the users calling function as a "By Reference" value, 'so user can turn arund and use it to add values to the new row using an update method from this Class, if they like. TheID = 0 'FIRST, CHECK MODULE/DATABASE EXISTS: Finds the module folder name and its child database folder name and returns them as a string. Calls method to check if name of module exists, and if not, attempt to find it and return the database path for the module named Note: ModuleAndDatabasePath's value is passed back from the function to the variable ByRef, and is in the format "Modulefoldername/Datafoldername" isDatabaseFound = LoadModule(NameOfModule,ModuleAndDatabasePath) 'Response.Write("
TEST: " & ModuleAndDatabasePath) 'Response.Write("
TEST: " & isDatabaseFound) if (isDatabaseFound) then 'SECOND, LOAD DATABASE TABLES LIST: Finds the matching table folder name thats contained in the given module's database. Note: ModuleTablePath's value is passed back from the function to the variable ByRef, and is in the format "ModuleTableFolderName" isTableFound = LoadDatabase(ModuleAndDatabasePath,NameOfTable,ModuleTablePath) 'Response.Write("
TEST: " & ModuleTablePath) 'Response.Write("
TEST: " & isTableFound) if (isTableFound) then 'THIRD, BUILD COMBINED PATH TO THE TABLE FOLDER AND LOAD TABLE VALUES ModuleDatabaseTablePath = ModuleAndDatabasePath & "/" & ModuleTablePath isTableLoaded = LoadTable(ModuleDatabaseTablePath) 'Response.Write("
TEST: " & ModuleDatabaseTablePath) 'Response.Write("
TEST: " & isTableLoaded) if (isTableLoaded) then 'Response.Write("
Me.XMLTableAttributeArray(0): " & Me.XMLTableAttributeArray(0)) 'Response.Write("
Me.XMLTableColumnListArray(0): " & Me.XMLTableColumnListArray(0)) 'Response.Write("
Me.XMLTableSetListArray(0): " & Me.XMLTableSetListArray(0)) '++++++++++++++++++++++++++++++++ ADD DATA ++++++++++++++++++++++++++++++++ 'CREATE FILE SYSTEM OBJECT... Dim TheFile,tempPath2,tempUBound,myNodeList1,tempWasLoaded,rowsPerFile,ThePath,q ThePath = Application("II_WEBROOT_PATH") & "/" & Application("II_MODULE_PATH") & "/" & ModuleDatabaseTablePath & "/" Set TheFile = Server.CreateObject("Scripting.FileSystemObject") tempWasLoaded = false 'Reset the 'XMLDataArray' bounds... 'Redim XMLDataArray(0) 'The XMLTableAttributeArray(2) stores the number of columns per record in this table. Pulled from the tables indexer file above... 'Note: this uses the tables indexer's stored value for number of columns per row to set the allowed number of columns to match the array index required rowsPerFile = Me.XMLTableAttributeArray(1)'stores number of rows allowed per table set.xml file... if (rowsPerFile = null or rowsPerFile < 1) then rowsPerFile = 1 end if 'Get list of xml files in the table folder 'Loop through them using the array index of all set files pulled from the table indexer.xml file tempUBound = (Ubound(Me.XMLTableSetListArray) - Lbound(Me.XMLTableSetListArray))'pulls the ubound of the array which should be the number of set files in the system, as taken from the nodes found in the tables indexer file... 'Load ONLY the last set.xml file in the set...you are going to add a row to it OR create a new set.xml file and add to it... For q = tempUBound To tempUBound 'ONLY GET THE LAST SET FILE VALUE IN THE LIST! 'Create the path to each 'set.xml' file found above and loop through them looking for data... tempPath2 = server.MapPath(ThePath) & "\" & "set" & (q) & ".xml" 'response.write ("
" & tempPath2) 'TESTING... 'AddXMLData = Me.XMLTableSetListArray(q)'get the starting row value for the last row in the indexer set.xml file list... if TheFile.FileExists(tempPath2) then 'Get a number of rows in the last set.xml file listed in the indexer... dim tempSetXML,numberOfRows,x,tester,NewXMLFile 'Create Fresh XML file for use below in creating a new xml file on the server... Set NewXMLFile = Server.CreateObject("Microsoft.XMLDOM") 'BASIC properties NewXMLFile.async = false NewXMLFile.resolveExternals = false NewXMLFile.preserveWhiteSpace = true NewXMLFile.validateOnParse = false 'SECONDARY properties (optional here) only supported by later parsers NewXMLFile.SetProperty "ServerHTTPRequest", false NewXMLFile.SetProperty "SelectionLanguage", "XPath" 'NewXMLFile.SetProperty "AllowDocumentFunction", true 'NewXMLFile.SetProperty "ForcedResync", true tempWasLoaded = NewXMLFile.load(tempPath2) if (tempWasLoaded) then 'SUCCESS!: Last set.xml file matches the one in the indexer table list, so file loaded! If 'set.xml' file loaded, then begin loading rows to see if you need to create a new set file and row... 'Get the latest xml file loaded above, and use XPATH to get the total number of rows... set tempSetXML = NewXMLFile.documentElement.selectNodes("/s/r") dim rownode,newtext,columnnode,column '/////////////////////// ADD NEW ROWS //////////////////////////// 'Get the total number of rows for this last set.xml file and compare to make sure it does not exceed the allowed 'rowsperfile' value... numberOfRows = tempSetXML.length 'Note: checks if the total number of rows "allowed" per set file (as set in the attribute 'rowsperfile' in the tables indexer.xml file) has been exceeded for the last set.xml file in the database table... if Cint(numberOfRows) < Cint(rowsPerFile) then 'Add new row to existing file 'CREATE YOUR NEW ROWS...WITH COLUMNS set rownode = NewXMLFile.createElement("r") ' add special VB blank line... rownode.appendChild NewXMLFile.createTextNode(vbNewLine)'creates new empty line 'CREATE EMPTY COLUMNS EXCEPT FOR THE ROW ID COLUMN...(increment that value by one) For Each column in Me.XMLTableColumnListArray rownode.appendChild NewXMLFile.createTextNode(vbTab)'creates new empty tab set columnnode = NewXMLFile.createElement(column) if (column = "id") then '*** Return the ID of the row via a By Ref variable stored in the method call (ie. TheID)! TheID = Me.XMLTableSetListArray(Ubound(Me.XMLTableSetListArray)) + numberOfRows + 1 'Set the new ID value... set newtext = NewXMLFile.createTextNode(TheID) else 'Set all new column values to empty by default... set newtext = NewXMLFile.createTextNode("") end if columnnode.appendChild(newtext) rownode.appendChild(columnnode) rownode.appendChild NewXMLFile.createTextNode(vbNewLine)'creates new empty line 'EXAMPLE of how to use special line feed and tab formatting in your xml file...creates blank text lines... 'vNode.appendChild objXMLDoc.createTextNode(vbNewLine) 'vNode.appendChild objXMLDoc.createTextNode(vbTab) Next Set column = Nothing 'ATTACH THE ROW WITH ATTACHED COLUMNS TO THE FINAL XML ROOT NODE... NewXMLFile.documentElement.appendChild(rownode) NewXMLFile.documentElement.appendChild NewXMLFile.createTextNode(vbNewLine) 'SAVE FILE... NewXMLFile.save tempPath2 'TESTING...return number of rows found in set file for testing 'AddData = tempSetXML.length 'AddData = Me.XMLTableSetListArray(Ubound(Me.XMLTableSetListArray)) + numberOfRows + 1 'AddXMLData = numberOfRows AddData = true AddError = "'AddXMLData' Method called. Success! The CURRENT 'set.xml file' was loaded correctly and a new row added! XML File Attempted: " & tempPath2 & "
" '//////////////////////////////////////////////////////// else 'CREATE NEW SET.XML FILE AND UPDATE INDEXER.XML FOR TABLE WITH SET ROW... 'Rows in this set file exceed the number allowed, so create new set.xml file and add in row. 'CREATE NEW SET.XML FILE!!! '------------------------------------------------------ Dim tempNewPath,wasfileCreated, wastablesetCreated 'create new path and name for new set.xml file... tempNewPath = server.MapPath(ThePath) & "\" & "set" & (tempUBound+1) & ".xml" 'This returns a new Class object in memory called 'Me.XMLFile' you can access to get to its xml nodes below... 'The actual 'CreateFile' method returns true or false if file created sucecssfully 'Note: Be sure to assign 'READ/WRITE' permissions on your server to support the reading and writing 'of new XML files by the IUSR anonymous account... 'CREATE NEW SET FILE!!! 'tempNewPath - full server path to the new set.xml file '"" - any xml you need to set in the file 'false/true - set whether you allow the system to write-over another set file, if the system does this in error 'setting this to false ehlps protect the users data set files, and the system is set up to send an error message 'if a write over was detected, and thus prevents it and sends back a message. Set to tru if you 'dont care and/or dont want extra error messages in the display when or if that occurs. This should rarely if ever occur. '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ wasfileCreated = CreateFile(tempNewPath,"", false) '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 'ADD NEW SET ROW TO TABLE INDEXER FILE!!! 'If you have added a new row of data to a set file AND had to create a new set file to hold the new row, 'you must update the indexer.xml file for the table by added a set node. This tells the system how many set files 'and helps the system loop through all available set files and their rows faster on XPATH queries. '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ wastablesetCreated = AddIndexerData(NameOfModule,NameOfTable) '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 'Both new file must be built and indexer.xml updated before adding new row to new set file... if wasfileCreated and wastablesetCreated then 'NEW SET.XML FILE WAS WRITTEN. GO AHEAD AND ADD ROWS TO THE NEW SET FILE... 'CREATE YOUR NEW ROWS...WITH COLUMNS 'set newTempFile = Me.XMLFile.documentElement.selectNodes("/s/r") set rownode = Me.NewXMLSetFile.createElement("r") 'add special VB blank line... rownode.appendChild Me.NewXMLSetFile.createTextNode(vbNewLine)'creates new empty line 'CREATE EMPTY COLUMNS EXCEPT FOR THE ROW ID COLUMN... For Each column in Me.XMLTableColumnListArray rownode.appendChild Me.NewXMLSetFile.createTextNode(vbTab)'creates new empty tab set columnnode = Me.NewXMLSetFile.createElement(column) if (column = "id") then '*** Return the ID of the row via a By Ref variable stored in the method call (ie. TheID)! TheID = Me.XMLTableSetListArray(Ubound(Me.XMLTableSetListArray)) + numberOfRows + 1 'Set the new ID value... set newtext = Me.NewXMLSetFile.createTextNode(TheID) else set newtext = Me.NewXMLSetFile.createTextNode("") end if columnnode.appendChild(newtext) rownode.appendChild(columnnode) rownode.appendChild Me.NewXMLSetFile.createTextNode(vbNewLine)'creates new empty line Next Set column = Nothing 'ATTACH THE ROW WITH ATTACHED COLUMNS TO THE FINAL XML ROOT NODE... Me.NewXMLSetFile.documentElement.appendChild Me.NewXMLSetFile.createTextNode(vbNewLine) Me.NewXMLSetFile.documentElement.appendChild(rownode) Me.NewXMLSetFile.documentElement.appendChild Me.NewXMLSetFile.createTextNode(vbNewLine) 'SAVE FILE... Me.NewXMLSetFile.save tempNewPath 'AddData = numberOfRows AddData = true AddError = "'AddXMLData' Method called. Success! A NEW 'set.xml file' was built and loaded correctly and a new row added! XML File Attempted: " & tempNewPath & "
" 'SET FILE NOT CREATED OR CORRUPTED, SO RETURN FALSE AND ERROR MESSAGE... else AddData = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, FAILURE! A NEW 'set.xml file' was not written to the server or loaded correctly! Please check READ and WRITE PERMISSIONS ON YOUR WEB SERVER! These must be set for the web site folder on the server for xml files to be written to the server. Please contact your Host ISP support engineers to set this up for you. XML Set File Attempted to be written: " & tempNewPath & "
" end if end if '//////////////////////////////////////////////////////// else 'tempWasLoaded was false: current SET.XML file NOT loaded...so return an error... AddData = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, the last 'set.xml file' for this table did not load! XML File Attempted: " & tempPath2 & "
" end if Set NewXMLFile = Nothing else 'last set.xml file could not be found.... AddData = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, the last 'set.xml file' for this table could not be found and therefore could not load! Make sure you have not changed the names of any of your set files. They should be numbered consecutively. XML File Attempted: " & tempPath2 & "
" end if 'Move to load next set.xml file.... 'reset to false to make sure tests pass for each load of an xml file above... tempWasLoaded = false Next 'AddXMLData = true 'close the filesystem object in memory Set TheFile = nothing '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ else AddData = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, there is a problem with the indexer.xml file for the module and database table called from within this page. (Please verify that the database table indexer.xml file for the module you are accessing is valid.)(AddData Method)
" end if else AddData = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, there is a problem with the indexer.xml file for the module and database called from within this page. (Please verify that the database folder for the module you are accessing has a valid indexer.xml file.)(AddData Method)
" end if else AddData = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, this module and its database can not be used in this page. (Please verify that this page is calling the right module and database.)(AddData Method)
" end if '........................................................... If Err.number <> 0 then Call CaptureThisError("SystemDatabases.asp:Database Class:AddData:Check this file, class, and method for the error.") Err.Clear End If '........................................................... End Function '*********************************************************************************** '-------------------------- METHODS : UPDATE XML DATA By XPATH --------------------------------- '*********FUNCTION: UpdateDatabyXPath Function*********************************** ' Used to update a column of data. Passes in an variable that holds new data for the column in the table provided. 'Note: Calls the "UpdateDataByID" function below. Use this method to load ALL xml data and update multiple files. '**************************************************************************** Public Function UpdateDataByXPath(NameOfModule,NameOfTable,newXPath,newColumnArray) '............................................................. On Error Resume Next '............................................................. Dim wasCalled UpdateDataByXPath = false 'This call tells the "UpdateDataByID" function to process the call using a range of values stored in the XPath wasCalled = UpdateDataByID(NameOfModule,NameOfTable,newXPath,newColumnArray,0) UpdateDataByXPath = wasCalled '............................................................. If Err.number <> 0 then Call CaptureThisError("SystemDatabases.asp:Database Class:UpdateDataByXPath:Check this file, class, and method for the error.") Err.Clear End If '............................................................. End Function '***************************************************************************** '-------------------------- METHODS : UPDATE XML DATA BY ID ---------------------------- '*********FUNCTION: UpdateDataByID Function************************************ ' Used to update an array of data. Passes in an array of name/value fields that hold new data for the column in the table provided. 'Note: Use this function to do a single record update using just a single xml set file, rather than loading ALL data files (faster). '***************************************************************************** Public Function UpdateDataByID(NameOfModule,NameOfTable,newXPath,newColumnArray,theID) '............................................................. On Error Resume Next '............................................................. Dim isDatabaseFound,isTableFound,isTableLoaded,ModuleAndDatabasePath,ModuleDatabaseTablePath,ModuleTablePath ModuleAndDatabasePath = "" ModuleTablePath = "" ModuleDatabaseTablePath = "" isDatabaseFound = false isTableFound = false isTableLoaded = false UpdateDataByID = false 'FIRST, CHECK MODULE/DATABASE EXISTS: Finds the module folder name and its child database folder name and returns them as a string. Call method to check if name of module exists, and if not, attempt to find it and return the database path for the module named Note: ModuleAndDatabasePath's value is passed back from the function to the variable ByRef, and is in the format "Modulefoldername/Datafoldername" isDatabaseFound = LoadModule(NameOfModule,ModuleAndDatabasePath) 'Response.Write("
TEST: " & ModuleAndDatabasePath) 'Response.Write("
TEST: " & isDatabaseFound) if (isDatabaseFound) then 'SECOND, LOAD DATABASE TABLES LIST: Finds the matching table folder name thats contained in the given module's database. Note: ModuleTablePath's value is passed back from the function to the variable ByRef, and is in the format "ModuleTableFolderName" isTableFound = LoadDatabase(ModuleAndDatabasePath,NameOfTable,ModuleTablePath) 'Response.Write("
TEST: " & ModuleTablePath) 'Response.Write("
TEST: " & isTableFound) if (isTableFound) then 'THIRD, BUILD COMBINED PATH TO THE TABLE FOLDER AND LOAD TABLE VALUES ModuleDatabaseTablePath = ModuleAndDatabasePath & "/" & ModuleTablePath isTableLoaded = LoadTable(ModuleDatabaseTablePath) 'Response.Write("
TEST: " & ModuleDatabaseTablePath) 'Response.Write("
TEST: " & isTableLoaded) if (isTableLoaded) then 'Response.Write("
Me.XMLTableAttributeArray(0): " & Me.XMLTableAttributeArray(0)) 'Response.Write("
Me.XMLTableColumnListArray(0): " & Me.XMLTableColumnListArray(0)) 'Response.Write("
Me.XMLTableSetListArray(0): " & Me.XMLTableSetListArray(0)) '++++++++++++++++++++++++++++++++ UPDATE DATA ++++++++++++++++++++++++++++++++ Dim TheFile,ThePath,tempPath,tempWasLoaded,q,tempSetXML,columnnode,r,t,numberOfIDsPerRow,e,newColumnName,newColumnValue,beginUBound,endUBound ThePath = Application("II_WEBROOT_PATH") & "/" & Application("II_MODULE_PATH") & "/" & ModuleDatabaseTablePath & "/" Set TheFile = Server.CreateObject("Scripting.FileSystemObject") '*** NOW LOAD ONLY THE SET FILE NEEDED TO UPDATE THE RECORD *** 'Now pick the exact set file needed to pull the record, so you do not load ALL set files, wasting time and resources 'or, if calling a range of records not by id If (CInt(theID) > 0) Then 'Process just the single record using the ID For e = 0 to Ubound(Me.XMLTableSetListArray) if (IsNumeric(Me.XMLTableSetListArray(e)) and IsNumeric(theID)) then if (CInt(Me.XMLTableSetListArray(e)) < CInt(theID)) then 'This will get the index of the last set file that could hold the index of the id needed beginUBound = e endUBound = e else Exit For end if end if Next Else 'Process ALL the records and query using those stored in the XPath beginUBound = 0 endUBound = (Ubound(Me.XMLTableSetListArray) - Lbound(Me.XMLTableSetListArray)) End If 'Get list of xml files in the table folder 'Loop through them using the array index of all set files pulled from the table indexer.xml file 'pulls the ubound of the array which should be the number of set files in the system, as taken from the nodes found in the tables indexer file... '-----------Loop through all available 'set.xml' data files for the table-------------- r = 0 For q = beginUBound To endUBound 'Create the path to each 'set.xml' file found above and loop through them looking for data... tempPath = server.MapPath(ThePath) & "\" & "set" & q & ".xml" 'response.write "
tempPath: " & tempPath 'TESTING... 'get the starting row value for the last row in the indexer set.xml file list... 'UpdateDataByID = Me.XMLTableSetListArray(q) if TheFile.FileExists(tempPath) then 'If file exists, then load the xml file and look for data... tempWasLoaded = LoadXMLFile(tempPath) if (tempWasLoaded) then 'SUCCESS!: Last set.xml file matches the one in the indexer table list, so file loaded! If 'set.xml' file loaded, then begin loading rows to see if the data you need to change exists... 'Get a number of rows in the last set.xml file listed in the indexer... 'Get the latest xml file loaded above, and use XPATH to see if the column exists... set tempSetXML = Me.XMLFile.documentElement.selectNodes(newXPath) if (IsArray(newColumnArray)) then 'newColumnArray(0,x) === name of column to update 'newColumnArray(1,x) === value of column to update For t = 0 to ubound(newColumnArray,2) 'CHECK FOR INVALID XML STRINGS - make sure user has not entered bad data into xml tree in database. Replace these with xml entities... newColumnName = newColumnArray(0,t) newColumnValue = replace(replace(replace(replace(replace(newColumnArray(1,t),"&","&"),"<","<"),">",">"),"'","'"),"""",""") 'Response.Write ("
newColumnName: " & newColumnName) 'Response.Write ("
newColumnValue: " & newColumnValue) '=================== ADD CHANGED COLUMN VALUE HERE ========================== For Each columnnode In tempSetXML if (columnnode.nodeName = newColumnName) then columnnode.Text = newColumnValue 'value to be updated is stored inside the column r = r + 1 'stores number of sucessful updates in table UpdateDataByID = true end if Next '============================================================================ Next Me.XMLFile.Save tempPath Set columnnode = Nothing else Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, update unsuccessful! Please check the update array of values to see if the array is valid.
" end if AddError = "'UpdateXMLData' Method called. Success! The CURRENT 'set.xml file' was loaded correctly and if there was a match, the column was updated and the file saved successfully! (UpdateDataByID Method) XML File Attempted: " & tempPath & "
" else 'tempWasLoaded was false: current SET.XML file NOT loaded...so return an error... UpdateXMLData = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, the last 'set.xml file' for this table did not load! (UpdateDataByID Method) XML File Attempted: " & tempPath & "
" end if else 'last set.xml file could not be found.... UpdateDataByID = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, the last 'set.xml file' for this table could not be found and therefore could not load! Make sure you have not chnaged the names of any of your set files. They should be numbered consecutively. (UpdateDataByID Method) XML File Attempted: " & tempPath & "
" end if 'Move to load next set.xml file.... 'reset to false to make sure tests pass for each load of an xml file above... tempWasLoaded = false Next if (r > 0) then 'Call this success message instead in the calling page, by capturing the true/false returned for this function, and then use a test in that ASP page to control what message is displayed in the Session("II_MESSAGE") area! 'Session("II_MESSAGE") = Session("II_MESSAGE") & "Success! Item(s) sucessfully updated!
" end if 'UpdateXMLData = true 'close the filesystem object in memory Set TheFile = nothing '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ else UpdateDataByID = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, there is a problem with the indexer.xml file for the module and database table called from within this page. (Please verify that the database table indexer.xml file for the module you are accessing is valid.)(UpdateDataByID Method)
" end if else UpdateDataByID = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, there is a problem with the indexer.xml file for the module and database called from within this page. (Please verify that the database folder for the module you are accessing has a valid indexer.xml file.)(UpdateDataByID Method)
" end if else UpdateDataByID = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, this module and its database can not be used in this page. (Please verify that this page is calling the right module and database.)(UpdateDataByID Method)
" end if '........................................................... If Err.number <> 0 then Call CaptureThisError("SystemDatabases.asp:Database Class:UpdateDataByID:Check this file, class, and method for the error.") Err.Clear End If '........................................................... End Function '*********************************************************************************** '-------------------------- METHODS : SORT DATA --------------------------------- '*********FUNCTION: SortData Function************************************ 'Used to sort data arrays 'When data is returned in an array from the xml database, use this 'function to sort the data and return a new ordered set based on one column 'in a multidimensional array of values. (ie. sort by name, date, id, etc.) '------------------------------------------------------------------------ Function SortData(TheArray,whichSortDirection,whichSortIndex,ByRef OutputArray) '............................................................. On Error Resume Next '............................................................. Dim x Dim y Dim columnValue Dim columnIndex dim minIndex dim maxIndex dim tempValue dim theType dim theSortDirection dim z dim firstAvailableIndex if ((whichSortIndex < 0) or (whichSortIndex > ubound(TheArray,1))) then 'return array as is...no sorting SortData = TheArray else if lcase(whichSortDirection) = "desc" then theSortDirection = 2 elseif lcase(whichSortDirection) = "asc" then theSortDirection = 1 else theSortDirection = 1 end if minIndex = lbound(TheArray,2) maxIndex = ubound(TheArray,2) firstAvailableIndex = minIndex while len(trim(TheArray(whichSortIndex,firstAvailableIndex))) = 0 and firstAvailableIndex < ubound(TheArray,2) firstAvailableIndex = firstAvailableIndex + 1 wend if isDate(trim(TheArray(whichSortIndex,firstAvailableIndex))) then theType = 3 else if isNumeric(trim(TheArray(whichSortIndex,firstAvailableIndex))) then theType = 2 else theType = 1 end if end if For x = minIndex To maxIndex - 1 columnValue = TheArray(whichSortIndex,x) columnIndex = x 'Loop check that gets index of smallest value in array set For y = x + 1 To maxIndex select case theType case 1 'The StrComp function compares two strings and returns a value that represents the result of the comparison. 'The StrComp function can return one of the following values: '-1 (if string1 < string2) '0 (if string1 = string2) '1 (if string1 > string2) 'Null (if string1 or string2 is Null) If strComp(TheArray(whichSortIndex,y),columnValue,vbTextCompare) = theSortDirection Then columnValue = TheArray(whichSortIndex,y) columnIndex = y End If case 2 if theSortDirection = 2 then if cdbl(TheArray(whichSortIndex,y)) < cdbl(columnValue) then columnValue = TheArray(whichSortIndex,y) columnIndex = y end if else if cdbl(TheArray(whichSortIndex,y)) > cdbl(columnValue) then columnValue = TheArray(whichSortIndex,y) columnIndex = y end if end if case 3 if theSortDirection = 2 then if DateDiff("s",TheArray(whichSortIndex,y),columnValue) > 0 then columnValue = TheArray(whichSortIndex,y) columnIndex = y end if else if DateDiff("s",TheArray(whichSortIndex,y),columnValue) < 0 then columnValue = TheArray(whichSortIndex,y) columnIndex = y end if end if end select Next 'If there has been ANY change in order, reorder all dimensions of array If (Cint(columnIndex) <> Cint(x)) Then 'Now sort ALL ROWS of data based on this one column's new order! for z = 0 to ubound(TheArray,1) tempValue = TheArray(z,columnIndex) TheArray(z,columnIndex) = TheArray(z,x) TheArray(z,x) = tempValue next End If Next ' return the array OutputArray = TheArray end if '........................................................... If Err.number <> 0 then Call CaptureThisError("SystemDatabases.asp:Database Class:SortData:Check this file, class, and method for the error.") Err.Clear End If '........................................................... End Function '************************************************************************** '-------------------------- METHODS : DELETE XML DATA By XPATH --------------------------------- '*********FUNCTION: DeleteDatabyXPath Function*********************************** ' Deletes one or more rows by changing the 'isdeleted' column of the database to a value of '1'. This preserves any older data in the system. ' Use when you need to "batch" delete many records across many set.xml files in the xml table. ' Note: Calls the "DeleteDataByID" function below. '**************************************************************************** Public Function DeleteDataByXPath(NameOfModule,NameOfTable,newXPath) '............................................................. On Error Resume Next '............................................................. Dim wasCalled DeleteDataByXPath = false 'This call tells the "DeleteDataByID" function to process the call using a range of values stored in the XPath wasCalled = DeleteDataByID(NameOfModule,NameOfTable,newXPath,0) DeleteDataByXPath = wasCalled '............................................................. If Err.number <> 0 then Call CaptureThisError("SystemDatabases.asp:Database Class:DeleteDataByXPath:Check this file, class, and method for the error.") Err.Clear End If '............................................................. End Function '***************************************************************************** '********* FUNCTION: DeleteDataByID Function *************** ' Deletes one or more rows by changing the 'isdeleted' column of the database to a value of '1'. This preserves any older data in the system. ' NOTE: Be sure when you call ALL DATA IN THE SYSTEM to check if 'isdeleted' is set to '0' or empty. ' NOTE: No row of data is EVER permanently deleted using this system! If data thats deleted builds up, could diminish speed of data pull, though at this time, there is no indication of performance issues in large storage xml sets where filtered data is flagged in the XPATH query. '***************************************************** Public Function DeleteDataByID(NameOfModule,NameOfTable,newXPath,theID) '............................................................. On Error Resume Next '............................................................. Dim isDatabaseFound,isTableFound,isTableLoaded,ModuleAndDatabasePath,ModuleDatabaseTablePath,ModuleTablePath ModuleAndDatabasePath = "" ModuleTablePath = "" ModuleDatabaseTablePath = "" isDatabaseFound = false isTableFound = false isTableLoaded = false DeleteDataByID = false 'FIRST, CHECK MODULE/DATABASE EXISTS: Finds the module folder name and its child database folder name and returns them as a string. Call method to check if name of module exists, and if not, attempt to find it and return the database path for the module named Note: ModuleAndDatabasePath's value is passed back from the function to the variable ByRef, and is in the format "Modulefoldername/Datafoldername" isDatabaseFound = LoadModule(NameOfModule,ModuleAndDatabasePath) 'Response.Write("
TEST: " & ModuleAndDatabasePath) 'Response.Write("
TEST: " & isDatabaseFound) if (isDatabaseFound) then 'SECOND, LOAD DATABASE TABLES LIST: Finds the matching table folder name thats contained in the given module's database. Note: ModuleTablePath's value is passed back from the function to the variable ByRef, and is in the format "ModuleTableFolderName" isTableFound = LoadDatabase(ModuleAndDatabasePath,NameOfTable,ModuleTablePath) 'Response.Write("
TEST: " & ModuleTablePath) 'Response.Write("
TEST: " & isTableFound) if (isTableFound) then 'THIRD, BUILD COMBINED PATH TO THE TABLE FOLDER AND LOAD TABLE VALUES ModuleDatabaseTablePath = ModuleAndDatabasePath & "/" & ModuleTablePath isTableLoaded = LoadTable(ModuleDatabaseTablePath) 'Response.Write("
TEST: " & ModuleDatabaseTablePath) 'Response.Write("
TEST: " & isTableLoaded) if (isTableLoaded) then 'Response.Write("
Me.XMLTableAttributeArray(0): " & Me.XMLTableAttributeArray(0)) 'Response.Write("
Me.XMLTableColumnListArray(0): " & Me.XMLTableColumnListArray(0)) 'Response.Write("
Me.XMLTableSetListArray(0): " & Me.XMLTableSetListArray(0)) '++++++++++++++++++++++++++++++++ DELETE DATA ++++++++++++++++++++++++++++++++ Dim TheFile,ThePath,tempPath,tempUBound,tempWasLoaded,tempSetXML,columnnode,wasLoaded,q,r,myNodeList1,rowsPerFile,e,beginUBound,endUBound ThePath = Application("II_WEBROOT_PATH") & "/" & Application("II_MODULE_PATH") & "/" & ModuleDatabaseTablePath & "/" Set TheFile = Server.CreateObject("Scripting.FileSystemObject") '*** NOW LOAD ONLY THE SET FILE NEEDED TO DELETE THE RECORD *** 'Now pick the exact set file needed to pull the record, so you do not load ALL set files, wasting time and resources 'or, if calling a range of records not by id If (CInt(theID) > 0) Then 'Process just the single record using the ID For e = 0 to Ubound(Me.XMLTableSetListArray) if (IsNumeric(Me.XMLTableSetListArray(e)) and IsNumeric(theID)) then if (CInt(Me.XMLTableSetListArray(e)) < CInt(theID)) then 'This will get the index of the last set file that could hold the index of the id needed beginUBound = e endUBound = e else Exit For end if end if Next Else 'Process ALL the records and query using those stored in the XPath beginUBound = 0 endUBound = (Ubound(Me.XMLTableSetListArray) - Lbound(Me.XMLTableSetListArray)) End If 'Get list of xml files in the table folder 'Loop through them using the array index of all set files pulled from the table indexer.xml file 'pulls the ubound of the array which should be the number of set files in the system, as taken from the nodes found in the tables indexer file... '-----------Loop through all available 'set.xml' data files for the table-------------- r = 0 For q = beginUBound To endUBound 'Create the path to each 'set.xml' file found above and loop through them looking for data... tempPath = server.MapPath(ThePath) & "\" & "set" & q & ".xml" 'TESTING... 'get the starting row value for the last row in the indexer set.xml file list... 'DeleteRowFromFile = Me.XMLTableSetListArray(q) if TheFile.FileExists(tempPath) then 'If file exists, then load the xml file and look for data... tempWasLoaded = LoadXMLFile(tempPath) if (tempWasLoaded) then 'SUCCESS!: Last set.xml file matches the one in the indexer table list, so file loaded! If 'set.xml' file loaded, then begin loading rows to see if the data you need to change exists... 'Get a number of rows in the last set.xml file listed in the indexer... 'Get the latest xml file loaded above, and use XPATH to see if the column exists... set tempSetXML = Me.XMLFile.documentElement.selectNodes(newXPath) '=================== ADD CHANGED COLUMN VALUE HERE ========================== For Each columnnode In tempSetXML columnnode.Text = 1 'flags "isdeleted" column in row as deleted r = r + 1 'stores number of sucessful deletions in the database Next Me.XMLFile.Save tempPath Set columnnode = Nothing '============================================================================ DeleteDataByID = true AddError = "'DeleteRowFromXMLFile' Method called. Success! The CURRENT 'set.xml file' was loaded correctly and if there was a match, the column was updated and the file saved successfully! (DeleteDataByID) XML File Attempted: " & tempPath & "
" else 'tempWasLoaded was false: current SET.XML file NOT loaded...so return an error... DeleteDataByID = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, the last 'set.xml file' for this table did not load! (DeleteDataByID) XML File Attempted: " & tempPath & "
" end if else 'last set.xml file could not be found.... DeleteDataByID = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, the last 'set.xml file' for this table could not be found and therefore could not load! Make sure you have not chnaged the names of any of your set files. They should be numbered consecutively. (DeleteDataByID) XML File Attempted: " & tempPath & "
" end if 'Move to load next set.xml file.... 'reset to false to make sure tests pass for each load of an xml file above... tempWasLoaded = false Next if (r > 0) then 'As in adding data or upldate, check this from the calling ASP page using the true/false value returned from this function. 'Session("II_MESSAGE") = Session("II_MESSAGE") & "Success! Item(s) sucessfully deleted!
" end if 'DeleteRowFromFile = true 'close the filesystem object in memory Set TheFile = nothing '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ else DeleteDataByID = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, there is a problem with the indexer.xml file for the module and database table called from within this page. (Please verify that the database table indexer.xml file for the module you are accessing is valid.)(DeleteDataByID Method)
" end if else DeleteDataByID = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, there is a problem with the indexer.xml file for the module and database called from within this page. (Please verify that the database folder for the module you are accessing has a valid indexer.xml file.)(DeleteDataByID Method)
" end if else DeleteDataByID = false Session("II_MESSAGE") = Session("II_MESSAGE") & "Alert! Sorry, this module and its database can not be used in this page. (Please verify that this page is calling the right module and database.)(DeleteDataByID Method)
" end if '........................................................... If Err.number <> 0 then Call CaptureThisError("SystemDatabases.asp:Database Class:DeleteDataByID:Check this file, class, and method for the error.") Err.Clear End If '........................................................... End Function '*********************************************************************************** '******************************PRINT OUTPUT FUNCTION******************************** 'All Class members and function generate information concerning what occured as data 'is accessed in the system. You can print out this information on the fly and use it to 'troubleshoot your database calls if you have problems. 'Note: Best to call this method then assign to Session(MESSAGE) variable for output at 'top of the web page. '*********************************************************************************** Public Function Output() '............................................................. On Error Resume Next '............................................................. dim TheLastASPError 'GET ALL MESSAGES/ERRORS generated by the class and assign here... Output = Me.theError '------------------------------------------------------------- 'Print any error messages generated in the system 'Alternate error system: ASP 3.0: Error Object Set TheLastASPError = Server.GetLastError Output = Output & "

If any general run-time errors occured on the server, they are listed below:
Description: " & TheLastASPError.Description & "
Category: " & TheLastASPError.Category & "
File: " & TheLastASPError.File & "
Number: " & TheLastASPError.Number & "
" '------------------------------------------------------------- '........................................................... If Err.number <> 0 then Call CaptureThisError("SystemDatabases.asp:Database Class:Output:Check this file, class, and method for the error.") Err.Clear End If '........................................................... End Function '*********************************************************************************** '-------------------------- METHODS : DESTRUCTORS --------------------------------- '***********FUNCTION: Destroy Function************* 'Important function used to destroy all types of objects as called by the Class_Terminate Function below. '********************************************************** Public Sub Destroy(ByRef Obj) '............................................................. On Error Resume Next '............................................................. Select Case True Case IsObject(Obj) Select Case LCase(TypeName(Obj)) Case "recordset", "command", "stream", "connection" 'close ADO objects If Obj.State <> 0 then Obj.Close End If case "dictionary" Obj.RemoveAll Case else 'nothing End Select Set Obj = Nothing Case IsArray(Obj) 'clear all arrays Erase Obj Case Else 'nothing End Select 'Now convert it to an unitialized state Obj = Empty '........................................................... If Err.number <> 0 then Call CaptureThisError("SystemDatabases.asp:Database Class:Destroy:Check this file, class, and method for the error.") Err.Clear End If '........................................................... End Sub '********************************************************** '***********FUNCTION: Class_Terminate Function************* 'Shuts down all class objects and remove from memory '********************************************************** Private Sub Class_Terminate() '............................................................. On Error Resume Next '............................................................. 'destroy all objects in memory... Destroy(Me.XMLFile) Destroy(Me.NewXMLSetFile) Destroy(Me.XMLTableAttributeArray) Destroy(Me.XMLTableSetListArray) Destroy(Me.XMLTableColumnListArray) Destroy(Me.theError) '........................................................... If Err.number <> 0 then Call CaptureThisError("SystemDatabases.asp:Database Class:Class_Terminate:Check this file, class, and method for the error.") Err.Clear End If '........................................................... End Sub End Class '***************************************************************** 'xxxxxxxxxxxxxxxxxxxxx DATABASE CLASS OUTPUT EXAMPLES xxxxxxxxxxxxxxxxxxxxxxx 'Use the commented out examples below if you are curious how the Database VBScript class works 'and need to get output from the system. 'TESTING... 'dim Database_Test,ArrayOfData 'Set Database_Test = new Database 'CALL DATABASE CLASS INSTANCE/OBJECT: (MODULE NAME, MODULE TABLE NAME, XPATH QUERY OF TABLE) 'Note returns a two dimensional array of data, who's dimensions represent columns and an array index of rows 'EXAMPLES: Format of data returned is "MyArray(ColumnValues,Rows)" 'ArrayOfData = Database_Test.GetData("ModuleName","TableName","/s/r/id") 'ArrayOfData = Database_Test.GetData("ModuleName","TableName","/s/r[isdeleted=1]/id") 'ArrayOfData = Database_Test.GetData("ModuleName","TableName","/s/r[not (isdeleted=1)]/id") 'ArrayOfData = Database_Test.GetData("ModuleName","TableName","/s/r[(id=1 or id=3 or id=4) and not(isdeleted=1)]/id") 'ArrayOfData = Database_Test.GetData("ModuleName","TableName","//id") 'GET ALL BASIC ROWS AND COLUMNS OF DATA 'response.write ("
IS DATA ARRAY RETURNED: " & IsArray(ArrayOfData)) 'response.write ("
NUMBER OF COLUMNS/FIELDS PER ROW (first dimension): " & Ubound(ArrayOfData,1)+1) 'response.write ("
NUMBER OF COLUMNS/FIELDS PER ROW (first dimension): " & Ubound(ArrayOfData)+1) 'response.write ("
NUMBER OF ROWS RETURNED (second dimension): " & Ubound(ArrayOfData,2)+1) 'response.write ("
SAMPLE DATA: " & ArrayOfData(0,0)) 'response.write ("
SAMPLE DATA: " & ArrayOfData(1,0)) 'response.write ("
SAMPLE DATA: " & ArrayOfData(2,0)) 'response.write ("
SAMPLE DATA: " & ArrayOfData(3,0)) 'response.write ("
SAMPLE DATA: " & ArrayOfData(4,0)) 'response.write ("
") 'GET ALL COLUMN VALUES PER ROW FOR ALL ROWS USING A LOOP 'Or, you can loop through the data... 'dim cols,rows 'response.write ("
PRINT OUT ROWS AND THEIR COLUMN VALUES:") 'For rows = 0 to Ubound(ArrayOfData,2) 'response.write ("
ROW: " & rows) 'For cols = 0 to Ubound(ArrayOfData,1) 'response.write ("
COLUMN VALUE: " & ArrayOfData(cols,rows)) 'Next 'response.write ("
") 'Next 'GET LAST ID : Best XPATH query I can find using my xml data system to get the latest id... 'Database_Test.GetData("ModuleName","TableName","/s[last()]/r[last()]/id[last()]") 'ADDDATA METHOD : ADD A NEW ROW OF XML DATA TO SET.XML FILE... 'Note how TheID is an empty reference parameter, which will return the ID of the row you just added 'This is helpful if you want to add a row to a table them update that row later with fresh data 'dim TheID 'Database_Test.AddData("ModuleName","TableName",TheID) 'response.write ("
Was AddData Successful?: " & Database_Test.AddData("ModuleName","TableName",TheID)) 'response.write ("
TheID: " & TheID) 'UPDATEDATABYID METHOD : UPDATE database row/column 'Updates only one record but with multiple column value changes... 'Dim columnArray() 'Redim columnArray(1,3) 'columnArray(0,0) = "isdeleted" 'columnArray(1,0) = "1" 'columnArray(0,1) = "number" 'columnArray(1,1) = "22" 'columnArray(0,2) = "company" 'columnArray(1,2) = "ACME" 'columnArray(0,3) = "photo" 'columnArray(1,3) = "TEST.jpg" 'Database_Test.UpdateDataByID("ModuleName","TableName","/s/r[id=2]/*",columnArray,2) 'DeleteDataByID METHOD : DELETE database row by flagging the "isdeleted" column for the row 'Note: You MUST use the "isdeleted" column in the XPATH querystring below, and the table must have that column in 'order for its data rows to be deleted. If another column name is used, you may substitute that name 'in your query for the 'isdeleted' name. 'Dim columnArray() 'Redim columnArray(1,0) 'columnArray(0,0) = "isdeleted" 'columnArray(1,0) = "1" 'Database_Test.DeleteDataByID("ModuleName","TableName","/s/r[id=3]/*",columnArray,3) 'Response.Write("
Was DeleteDataByID Successful?: " & Database_Test.DeleteDataByID("ModuleName","TableName","/s/r[id=3]/*",columnArray,3) & "
") '**************** DATBASE CLASS : ERRORS, OUTPUT, and FEEDBACK ********** 'OUTPUT or PRINT data messages associated with the Database Class 'Three examples of output into the browser... '************************************************************************* 'Session("II_MESSAGE") = Session("II_MESSAGE") & Database_Test.Output & "
" 'Session("II_MESSAGE") = Session("II_MESSAGE") & Database_Test.GetAllErrors & "
" 'Assign to Error logs which is printed at the bottom of the page... 'Call CaptureThisError(Database_Test.GetAllErrors) '************************************************************************* 'xxxxxxxxxxxxxxxxxxx RESOURCE SCRIPTS : VBSCRIPT xxxxxxxxxxxxxxxxxx 'TypeName - use to get what type of variant is used 'Byte - Indicates a byte value 'Integer - Indicates an integer value 'Long - Indicates a long integer value 'Single - Indicates a single-precision floating-point value 'Double - Indicates a double-precision floating-point value 'Currency - Indicates a currency value 'Decimal - Indicates a decimal value 'Date - Indicates a date or time value 'String - Indicates a character string value 'Boolean - Indicates a boolean value; True or False 'Empty - Indicates an unitialized variable 'Null - Indicates no valid data '<object type> - Indicates the actual type name of an object 'Object - Indicates a generic object 'Unknown - Indicates an unknown object type 'Nothing - Indicates an object variable that doesn't yet refer to an object instance 'Error - Indicates an error 'EXAMPLE: 'response.write("
LCase(TypeName(Database_Test)): " & LCase(TypeName(Database_Test))) 'EXAMPLE OF BUILDING A DYNAMIC PATH BASED ON APPLICATION VALUES... 'response.write("
Path: " & Application("II_WEBROOT_PATH") & "/" & Application("II_MODULE_PATH") & "/" & Application("II_MODULE_ARRAY")(0,0) & "/" & Application("II_MODULE_ARRAY")(9,0) & "") 'EXAMPLE OF TESTING IF YOU HAVE INSTANTIATED ONE OF THE APPS CLASSES 'response.write("
IsObject: " & IsObject(Database_Test)) 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx '================= FUTURE "HONEY-DO" LIST ================== '**** FIX, rework GetData method so user can vary their query and system knows how to put together a row of data 'example: this is corrupted in the array r = Database_Test.GetData("ModuleName","TableName","/s/r[isdeleted=1]") 'Issue: Because the GetFilteredData is affected by XPATH query structures, be sure to rework GetData and GetFilteredData methods when adding more advanced XPATH query support. At this time, users may "experiment" with various XPATH structures to see what is returned and if any errors are generated. Again, XPATH structures are limited to the following ("/s/r[somechildnodename=value and ...]/somechildnodename" or "/s/r/*"), as far as XPATH structure support goes. Some corruption of the data may occur if performed using different XPATHs in updates and adds, though the system should filter out bad calls in most cases. - GiantIsland LLC Development Team '========================================================== %> <% '........................................................... 'check for include page errors If Err.number <> 0 then Call CaptureThisError("SystemDatabases.asp:Check this file for the error.") Err.Clear End If '........................................................... %>