home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / nastroje / d3456 / KBMWABD.ZIP / WABD_Objects.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-07-16  |  388.8 KB  |  12,083 lines
  1. unit WABD_Objects;
  2.  
  3. {$include kbmWABD.inc}
  4.  
  5. interface
  6.  
  7. uses Classes, SysUtils, Windows, Forms, Graphics, Controls, StdCtrls, ExtCtrls, DB,
  8.       Grids, WABD_About, Chart, teEngine, dialogs, jpeg, WABD_Cookies,
  9.       WABD_Request, WABD_Response, ComCtrls, Inifiles, registry, WABD_Utils, WABD_ISAPI,
  10.       WABD_Graphics;
  11.  
  12. // =========================================================================
  13. // kbmWABD
  14. // -------
  15. // Web Application Builder for Delphi - Kim Bo Madsens interpretation.
  16. //
  17. // Based on the open source and freeware version 1.25 of Ben Zieglers library
  18. // WABD. Heavily modified and extended by Kim Bo Madsen/Optical Services - Scandinavia.
  19. //
  20. // The library contains all the functionality needed for building large scale
  21. // web ISAPI applications using D3/4/5 or BCB3/4 very rapidly.
  22. //
  23. // Copyright 1997,1998 for v. 1.25 and all previous versions Ben Ziegler (Zieglersoft)
  24. // Copyright 1999-2001 for v. 2.xx and newer Kim Bo Madsen/Optical Services - Scandinavia
  25. // All rights reserved.
  26. //
  27. // The copyright includes all files in this library, not only this file.
  28. //
  29. // LICENSE AGREEMENT
  30. //
  31. // You are allowed to use this component in any project for free.
  32. // You are NOT allowed to claim that you have created this component or to
  33. // copy its code into your own component and claim that it was your idea.
  34. //
  35. // Since this library is open source and freeware, all later incarnations _must_ also
  36. // be open source and freeware.
  37. //
  38. // All the added functionality to the original 1.25 library is offered for free
  39. // for your convinience, and the only thing I REQUIRE is to get an e-mail about what
  40. // project this library (or derived versions) are used for.
  41. //
  42. // You dont need to state the name of the creators (Ben Ziegler and Kim Bo Madsen) in
  43. // your software, although it would be appreciated if you do.
  44. //
  45. // If you find bugs or alter the component (f.ex. see suggested enhancements
  46. // further down), please DONT just send the corrected/new code out on the internet,
  47. // but instead send it to me, so I can put it into the official version. You will
  48. // be acredited if you do so.
  49. //
  50. // Ben Ziegler has to my knowledge not claimed any restrictions which
  51. // should violate this license agreement.
  52. //
  53. // DISCLAIMER
  54. // By using this component or parts theirof you are accepting the full
  55. // responsibility of the use. You are understanding that the authors (Ben Ziegler or
  56. // Kim Bo Madsen) cant be made responsible in any way for any problems occuring
  57. // using this component.
  58. // You also recognize the authors (Ben Ziegler and Kim Bo Madsen) as the creators
  59. // of this component and agrees not to claim otherwize!
  60. //
  61. // Please forward corrected versions (source code ONLY!), comments,
  62. // and emails saying you are using it for this or that project to:
  63. //            kbm@optical.dk
  64. //
  65. // New versions can be found at the kbmwabd community at
  66. //    http://www.egroups.com/group/kbmwabd
  67. //
  68. // Please direct all support questions through the kbmwabd community.
  69. // Support questions send directly to me will in general _not_ be answered.
  70. //
  71. // Suggestions for future enhancements:
  72. //
  73. //      - Help file,
  74. //      - Example projects
  75. //
  76. // History:
  77. // 1.25  Original version programmed and released as open source and freeware by Ben Ziegler.
  78. //
  79. // 2.00  Many, many, many things added, like remote administation, frames support, charting,
  80. //       Javascript support, statistics collection, logon security, file upload, javascript
  81. //       based menutree component and alot more. Most part of internal routines largely rewritten to
  82. //       support new functionality, avoid use of 3rd party libs unless extremely needed (Bens Lib)
  83. //       enhance stability. Kim Bo Madsen (kbm@optical.dk)
  84. //
  85. // 2.10  First stable version 2. The system is in its 2.10 release really very stable and is used
  86. //       for a large web based ISAPI EIS (Executive Information System) application.
  87. //       Kim Bo Madsen (kbm@optical.dk)
  88. //
  89. // 2.11  Fixed bug so a wannabe admin doesnt get aut. routed to another machine even if not authenticated.
  90. //       Prepared network timing utilities which when enabled in a future version will show up in the stats display.
  91. //
  92. // 2.12  Implemented network timing utilities.
  93. //       Fixed bug in TWABD_MenuTree where OnEvent JS function was reallocated even if it was allocated in the parent TWABD_Body.
  94. //
  95. // 2.13  Fixed bug not calling mousedown on TWABD_Chart. KBM 28-08-2000
  96. //
  97. // 2.20  Added TWABD_HTML and TWABD_HTMLFile (with support for file caching).
  98. //       Supporting Cookies in TWABD_Session. Improved variable access routines.
  99. //       Added Stateless sessions which will be destroyed right after use.
  100. //       Kim Bo Madsen (kbm@optical.dk) 27-11-2000
  101. //
  102. // 2.21  Added missing HTML_Input file. Added Anders Melanders GifImage          KBM 05-Jan-2001
  103. //       sources in a zipfile (not newest version).
  104. //       Fixed renamed MainForm (MainBody now) attribute reference in WABD_Admin.
  105. //       Fixed menutree.js javascript. Please reload it into the javascript component pointed
  106. //       at by the TWABD_MenuTree to activate the new changes.
  107. //       Fixed Acess Violation on Preview Browser on TWABD_Form.
  108. //
  109. // 2.22  Fixed TWABD_Label CanClick=true assertion error. Reason was missing _ in WABD_LABEL_STR.
  110. //
  111. // 2.23  Added TWABD_HTMLEmbed and TWABD_HTMLFileEmbed. Removed TWABD_RawSection.
  112. //       Fixed TWABD_Table_Strings.SetSafeSize which resulted in corrupt string array.
  113. //       bug reported by reidr@buzybee.com.
  114. //       Fixed several bugs todo with using Session without checking for nil. (Will be nil in
  115. //       design mode).
  116. //       TWABD_Raw changed name to TWABD_HTMLSection. If you have used TWABD_Raw anywhere,
  117. //       you have to change it to use TWABD_HTMLSection. You can preserve existing work by
  118. //       using the Borland utility 'Convert' to convert your datamodules (*.DFM) to
  119. //       text and then manually rename Lines to HTML for all TWABD_Raw entries. Then
  120. //       rename all references to TWABD_Raw to TWABD_HTMLSection. Further open your *.pas/*.cpp
  121. //       files in notepad and change all references too. Sorry if this causes troubles, but
  122. //       it is required to keep a consistent naming scheme.
  123. //
  124. // 2.23a Fixed missing Result:=HTML.Text in TWABD_HTMLSection.Object_To_HTML.
  125. // 2.23b Fixed EVENTID bug in Javascript due to renaming of constants in 2.20.
  126. //
  127. // 2.24  Added Show procedure to TWABD_Base_HTML. Thus one can force to show html instead
  128. //       of form dynamically during runtime.
  129. //       Made GetFilePath,GetLocalFilePath,GetImagePath,GetLocalImagePath public in TWABD_Setup.
  130. //       Changed reading ImagePath etc. to return only user setup, not interpreted stuff. Use
  131. //       GetImagePath etc. instead.
  132. //       Added NoWrap property to section objects.
  133. //       Added OnSetupClickableCell event for TWABD_Table and TWABD_Datatable for setting up
  134. //       if each cell is clickable and what is the target.
  135. //       Added OnUserClickCell event to TWABD_Table and TWABD_DataTable for reacting to
  136. //       users clicking a clickable cell.
  137. //       Enhanced TWABD_Table and TWABD_DataTable to allow Javascript for table, row and cell.
  138. //       Enhanced TWABD_Base_Image not to specify width and height if imageheight and imagewidth<=0.
  139. //       Fixed radio button behaviour and generated A/V on new session.
  140. //       Fixed showing TWABD_HTML or TWABD_HTMLFile in a frame.
  141. //       Fixed TWABD_MenuTree to generate correct node layout.
  142. //       Added support for embedding TWABD_MenuTree in subframe. Note only 1 TWABD_Menutree is
  143. //       allowed in the same webbrowser.
  144. //
  145. // 2.25  Added support for reloading menutree frame with new data on frame reload.
  146. //       Prepared for multiple concurrent menutrees in same browser.
  147. //       Fixed TWABD_Menutree loaddata generation on last top level node.
  148. //
  149. // 2.26  Changed to use Height/Width instead of ImageHeight/ImageWidth in IMG
  150. //       html. Added AutoSize property (boolean) to determine if to autosize
  151. //       image when ImageFile is set.
  152. //       Added Align property to TWABD_Formsection.
  153. //       Added TWABD_ExternalFrame for external framereferences for Target/SubmitTo.
  154. //       TWABD_FormSection_Base.Object_To_HTML now makes one cell less in headerline.
  155. //
  156. // 2.27  Added Height property for TWABD_FormSection and TWABD_Table.
  157. //       Fixed setting properties for non submitted forms (when a frame is loading the form f.ex.)
  158. //       Added VertAlign property to TWABD_Formsection.
  159. //       Renamed Align to HorzAlign in TWABD_FormSection.
  160. //       Changed the type of Cell oriented alignments to TWABD_HorzAlignment/TWBAD_VertAlignment.
  161. //       Changed name of TWABD_FormSection_Base to TWABD_FormSection_Grid and let it
  162. //       inherit from new TWABD_FormSection_Base.
  163. //       Added new TWABD_FormSection_Base which contains size and alignment settings.
  164. //       BEWARE that installing this version WILL require a few changes in your designtime
  165. //       properties. Remember to open all datamodules and ignore the warnings. Then reset the
  166. //       appropriate alignment values and if needed correct the eventhandler for cell setup.
  167. //       Added support for Height/Width on TWABD_Form level.
  168. //       Added support for showing another form on exception in OnExcetpion in TWABD_Session.
  169. //
  170. // 2.28  Added out of order detection for TWABD_Form. Check IsOutOfOrder and OnOutOfOrder event.
  171. //
  172. // 2.29  Added support for multiple selections in listboxes.
  173. //       Fixed bug on clickable TWABD_Image. Bug reported by Henk Fikkert (henk.fikkert@simulation.nl)
  174. //
  175. // 2.30  Fixed script 'Collection' bug in Menutree.
  176. //       Fixed menutree layout problem with two seperate subnodes. Bug reported
  177. //       by Szakßly Balßzs (szakalyb@freemail.hu).
  178. //       Fixed so OnShow is called before menutree is shown.
  179. //       Fixed AddNode on TWABD_MenuTree.
  180. //       Fixed Cell/Row Javascript of TWABD_Table variants. Bug reported by Henk Fikkert (henk.fikkert@simulation.nl)
  181. //       Made CreateSessionCookie public and improved it a bit.
  182. //       Added new method SaveHTMLToFile(AFile:string) which can be called for every kbmWABD element
  183. //       to generate static HTML. You can then f.ex. reference the static HTML using
  184. //       a TWABD_HTMLFile or TWABD_HTMLEmbed.
  185. //       Added Version property to TWABD_Session and TWABD_SessionMgr which simply reports
  186. //       the version of kbmWABD.
  187. //
  188. // 2.30a Added D3 installation package file.
  189. //
  190. // 2.31  Added support for file upload from browser (TWABD_UploadFile).
  191. //       Added UseSessionCookie property to all TWABD_Body based components.
  192. //       Default true for TWABD_HTML/HTMLFile body, and false for others.
  193. //       Added EncType to TWABD_Body. Published it in TWABD_HTML/HTMLFile and TWABD_Form.
  194. //       Default empty.
  195. //       Added support for Title on several form objects. Notice that this is not widely supported
  196. //       by browsers.
  197. //       Prepared support for other interfaces than ISAPI with Kylix and Apache in mind :)
  198. //       Thus removed HTML_Input.pas, and introduced several new units like:
  199. //       WABD_Cookies.pas, WABD_Request.pas, WABD_Response.pas, WABD_HTMLRequest.pas
  200. //       Added support for TWABD_Body EncodeType.
  201. //
  202. // 2.32  Changed TWABD_Frame.LinkForm to TWABD_Frame.LinkBody. You can change the name of
  203. //       your existing properties in your current DFM's
  204. //       by using the Borland tool Convert.exe to convert the DFM to text and back.
  205. //       Cleaned up Javascript event support. Now many more objects has support
  206. //       for more Javascript events.
  207. //       Removed unlogical JS_OnUserEvent on TWABD_Frameset. Ignore errors when opening form.
  208. //       HTMLRequest parsing routines now checking for no data.
  209. //       Changed so JS event code generation only surrounds eventhandler with " if eventhandler
  210. //       contains space and is not already surrounded by ' or ".
  211. //       Added installation packages for D4 and BCB4.
  212. //       Added nice About screen :)
  213. //       Removed orphaned FileData from TWABD_UploadFile. Shouldnt have been there in the first place.
  214. //       Please ignore property errors from this.
  215. //
  216. // 2.33  Automatic support for WML (Wap phones) now added.
  217. //       Following components are compatible with WAP and can generate and understand WML:
  218. //         TWABD_HTML, TWABD_HTMLFile, TWABD_Form, TWABD_FormSection,
  219. //         TWABD_HTMLSection, TWABD_HTMLFileSection, TWABD_AutoRefresh,
  220. //         TWABD_Expires, TWABD_BlankLines, TWABD_HTMLEmbed, HTML_HTMLFileEmbed,
  221. //         TWABD_AutoLoad, TWABD_Image, TWABD_LiveImage, TWABD_Chart,
  222. //         TWABD_Label, TWABD_Memo, TWABD_Button, TWABD_Edit, TWABD_ComboBox,
  223. //         TWABD_ListBox, TWABD_Anchor and TWABD_CheckBox.
  224. //       Some properties are only used by HTML for some
  225. //       of the components since they have no natural place in WML.
  226. //       All other components are simply ignored during WML generation.
  227. //       Added NoWrap to formsection_grid objects which if true will override
  228. //       settings on section object level.
  229. //       Added Format and EmptyOK to TWABD_Edit. These are only used by WAP.
  230. //       Added Produce property to TWABD_Session to specify what output should be produced.
  231. //       It can be set to prodAuto, prodHTML and prodWML. If set to auto, the request from the
  232. //       client will determine what format will be returned.
  233. //       Added liAuto to TWABD_LiveImage ImageType. If set to liAuto, then the imagetype send
  234. //       will be determined according to the Session.Produce and in case of HTML,
  235. //       the number of colors in the image.
  236. //       Added MaxAge to TWABD_Expires.
  237. //       Enhanced so adding an allready existing cookie will auto overwrite it.
  238. //       Added Literal property to TWABD_Table/TWABD_Datatable as suggested by Henk Fikkert.
  239. //       Added self parameter to TWABD_Session.OnException event handler.
  240. //       Added OnException handler to TWABD_SessionMgr (last line of defence).
  241. //       Fixed A/V bugs when TWABD_AutoLoad and TWABD_AutoRefresh was used.
  242. //       Added NewSession boolean to TWABD_AutoRefresh. If no URL specified and false will
  243. //       attempt to reload in current session, otherwise starts a new session.
  244. //       If URL is specified, reloads external page pointed to by URL.
  245. //       Improved TWABD_Anchor. If no destination or Target given the
  246. //       anchor will be percieved as a bookmark (a destination for a anchor).
  247. //       To jump to a bookmark, set the destination of another anchor to #nameofbookmark
  248. //       where nameofbookmark is the name of the TWABD_Anchor bookmark component.
  249. //       This is only valid for HTML, not WML.
  250. //       Remember to keep the generated WML relatively small for WAP devices not to choke.
  251. //       Images typically should be max 170x100 pixels large, although kbmWABD supports them
  252. //       much bigger.
  253. //       Modified the body searching mechanism to automatically look in multiple datamodules.
  254. //       The purpose is if a session has several datamodules opened at the same time
  255. //       to evenly distribute the kbmWABD components on them.
  256. //       Suggested by Szakßly Balßzs (szakalyb@freemail.hu).
  257. //
  258. // 2.34  16. July. 2001
  259. //       Added support for D6. Now all code is seperated in runtime and designtime.
  260. //       Fixed bug in TWABD_Menu.ProcessRequest where nodes added programmatically
  261. //       didnt fire the click event as expected. Problem was different owners
  262. //       of the programatically added nodes. Bug reported
  263. //       by Henk Fikkert (henk.fikkert@simulation.nl)
  264. //       Removed forgotten ShowMessage in TWABD_UploadFile. Problem spotted by
  265. //       Fred Schetterer (fredsegroups@home.com).
  266. //       Added designtime changing of size of components by click and drag on right or lower
  267. //       edge of component in formsection designer.
  268. //       Added Lock and Unlock thread locking on TWABD_Setup. Made all Getxxxx calls
  269. //       threadsafe. This will allow setting a TWABD_Setup on the sessionmanager module
  270. //       and let it be used by session modules. Remember to Lock...Unlock when setting
  271. //       properties at runtime if a TWABD_Setup is shared between sessions.
  272. //       Added LocalRootPath which if AutoSetGlobalRootPath is true
  273. //       alters the WABD_DefaultRequestLocalFilePath global variable.
  274. //       Added ExpandFromGlobalRootPath property which if true will use
  275. //       WABD_DefaultRequestLocalFilePath for expanding paths.
  276. //       Added ExpandFromRootPath property which if true will build local
  277. //       path names from GlobalRootPath or LocalRootPath and a relative
  278. //       LocalFile/LocalImage path. Only one TWABD_Setup on the TWABD_SessionMgr should
  279. //       have AutoSetGlobalRootPath:=true.
  280. //       Fixed multipart parsing when final line not ending with #10#13.
  281. //       Added RandomSessionID boolean on TWABD_SessionMgr (default false).
  282. //       If true will generate random session id number instead of sequential.
  283. //       Remember setting SiteID to -1 will generate a random site id 0-255.
  284. //       The siteid and the sessionid is combined for a 32 bit session id for the clients.
  285. //       Added TotalSessionCount readonly property which returns the total number
  286. //       of spawned sessions since the ISAPI was started.
  287.  
  288. const
  289.    WABD_VERSION_STR  = 'kbmWABD v. 2.34';
  290.    WABD_VERSION      = 2.34;
  291.  
  292.    CR                = #13#10;
  293.    PIXELS_PER_CHAR_X = 8;                    // I just picked this number
  294.    PIXELS_PER_CHAR_Y = 18;                   // I just picked this number
  295.  
  296.    MSECS=60*60*24*1000;                      // Millisecs per 24 hours.
  297.  
  298.    WABD_SES_ID_STR   = '_WABD_SESSIONID';    // Hidden Text field to hold session information
  299.    WABD_SES_ID_STR_FORMAT = '%d:%s';
  300.    WABD_EVENT_ID_STR = '_WABD_EVENTID';      // Hidden Text field. X:CtrlName
  301.                                              // X=0 : None
  302.                                              // X=1 : OnClick
  303.    WABD_CLIENTPROCESSTIME_STR = '_WABD_CLIENTPROCESSTIME'; // Hidden Text field send by client of how long time from request to answer.
  304.    WABD_SERVERPROCESSTIME_STR = '_WABD_SERVERPROCESSTIME'; // Hidden Text field send by server of how long server processing took on last request.
  305.    WABD_CLIENTSUBMITTIMESTAMP_STR = '_WABD_CLIENTSUBMITTIMESTAMP'; // Hidden Text field set by client to timestamp just before submitting.
  306.    WABD_CLIENTLOADTIMESTAMP_STR = '_WABD_CLIENTLOADTIMESTAMP'; // Hidden Text field set by client to timestamp just after page is loaded.
  307.    WABD_SERVERTIMESTAMP_STR = '_WABD_SERVERTIMESTAMP'; // Hidden Text field set by server to timestamp just before posting response.
  308.    WABD_FORMSUBMITCOUNT_STR = '_WABD_FORMSUBMITCOUNT'; // Hidden Text field set by server to identify out of order submissions of forms.
  309.    WABD_STAMP_STR    = '_WABD_STAMP';         // Time stamp (ignored by wabd on input).
  310.    WABD_RELOAD_STR   = '_WABD_RELOAD';        // Reload page without any inputs submitted.
  311.    WABD_LABEL_STR    = '_WABD_LABEL';
  312.    WABD_TABLE_STR    = '_WABD_TABLE';
  313.    WABD_DATA_STR     = '_WABD_DATA';
  314.    WABD_BUTTON_STR   = '_WABD_BUTTON_NAME';   // "Name" used for buttons
  315.    WABD_RADIO_STR    = '_WABD_RADIO_NAME';    // "Name" used for radiobuttons
  316.    WABD_FRAME_STR    = '_WABD_FRAME';         // To indicate that a frame is making the query.
  317.    WABD_MENUTREE_STR = '_WABD_MENUTREE';      // To indicate that a menutree is making the query.
  318.    LabPointSizes     : array[1..7] of integer = (6,8,9,12,18,24,36);
  319. //   XLabPointSizes    : array[1..7] of integer = (4,6,6,8,12,16,24);
  320.    XLabPointSizes    : array[1..7] of integer = (6,8,9,12,18,24,36);
  321.    YLabPointSizes    : array[1..7] of integer = (14,20,22,28,40,54,96);
  322.  
  323.    JS_BEGIN          = '<script LANGUAGE="JavaScript">'+CR+'<!--'+CR;
  324.    JS_END            = '//-->'+CR+'</script>'+CR;
  325.  
  326.    JS_MenuTree='menutree.js';
  327.  
  328.    WABD_SEMAPHORE_TIMEOUT=20*60*60*1000;      // 20 minutes should be more than enough.
  329.  
  330.    // Internal sequence names.
  331.    WABD_IMAGE_SEQUENCE = 'WABD_IMAGE_SEQUENCE';
  332.  
  333.    // Default group names for stats.
  334.    WABD_STATGRP_RESPONSE       = 'Response';
  335.    WABD_STATGRP_NETRESPONSE    = 'Net response';
  336.    WABD_STATGRP_SENDSIZE       = 'Sendsize';
  337.    WABD_STATGRP_RECVSIZE       = 'Recvsize';
  338.  
  339.    // Variable name constants for menutree.
  340.    WABD_MT_IMG_BLANK='MT_BLANK';
  341.    WABD_MT_IMG_BRANCH_CONT='MT_BRANCH_CONT';
  342.    WABD_MT_IMG_BRANCH_END='MT_BRANCH_END';
  343.    WABD_MT_IMG_FOLDER_CLOSED='MT_FOLDER_CLOSED';
  344.    WABD_MT_IMG_FOLDER_OPEN='MT_FOLDER_OPEN';
  345.    WABD_MT_IMG_ROOT='MT_ROOT';
  346.    WABD_MT_IMG_MINUS_CONT='MT_MINUS_CONT';
  347.    WABD_MT_IMG_MINUS_END='MT_MINUS_END';
  348.    WABD_MT_IMG_PLUS_CONT='MT_PLUS_CONT';
  349.    WABD_MT_IMG_PLUS_END='MT_PLUS_END';
  350.    WABD_MT_IMG_VERT_LINE='MT_VERT_LINE';
  351.    WABD_MT_FRAME='MT_FRAME';
  352.    WABD_MT_FRAME_TARGET='MT_TARGET_FRAME';
  353.    WABD_MT_SIZE_FONT='MT_FONTSIZE';
  354.    WABD_MT_COLOR_FONT='MT_FONTCOLOR';
  355.    WABD_MT_COLOR_LINK='MT_LINKCOLOR';
  356.    WABD_MT_COLOR_ALINK='MT_ALINKCOLOR';
  357.    WABD_MT_COLOR_VLINK='MT_VLINKCOLOR';
  358.    WABD_MT_IMG_BG='MT_BACKGROUND';
  359.    WABD_MT_COLOR_BG='MT_BACKGROUNDCOLOR';
  360.  
  361. type
  362.    // ************************************************************************
  363.    // "Base" Level objects
  364.  
  365.    TWABD_Session = class;
  366.    TWABD_Setup = class;
  367.    TWABD_Body = class;
  368.    TWABD_Form = class;
  369.    TWABD_HTML = class;
  370.    TWABD_Base_Frame = class;
  371.    TWABD_Frame = class;
  372.    TWABD_Frameset = class;
  373.    TWABD_ExternalFrame = class;
  374.    TWABD_Parent = class;
  375.    TWABD_Admin = class;
  376.    TWABD_SessionMgr = class;
  377.    TWABD_Base_Image = class;
  378.    TWABD_Image = class;
  379.    TWABD_SectionObject = class;
  380.    TWABD_Button = class;
  381.    TWABD_SectionObjectClass = class of TWABD_SectionObject;
  382.    TWABD_Chart = class;
  383.    TWABD_Tree = class;
  384.    TWABD_MenuTree = class;
  385.    TWABD_MenuTreeClass = class of TWABD_MenuTree;
  386.    TWABD_Table = class;
  387.    TWABD_Javascript = class;
  388.    TWABD_JS_Function = class;
  389.  
  390.    TGarbageThread = class(TThread)
  391.    protected
  392.       procedure   DoGarbageCollection;
  393.       procedure   Execute; override;
  394.    public
  395.       SesMgr      : TWABD_SessionMgr;
  396.    end;
  397.  
  398.    TWABD_SequenceRec = record
  399.        Persistent:boolean;
  400.        Name:PChar;
  401.        Value:longint;
  402.    end;
  403.    PWABD_SequenceRec = ^TWABD_SequenceRec;
  404.  
  405.    TWABD_SesStatRec = record
  406.        Stamp:TDateTime;
  407.        Value:double;
  408.        User:PChar; //string[20];
  409.        Info:PChar; //string[100];
  410.    end;
  411.    PWABD_SesStatRec = ^TWABD_SesStatRec;
  412.  
  413.    TWABD_SesSubStatRec = record
  414.        Count:longint;
  415.        Value:double;
  416.        Min:double;
  417.        Max:double;
  418.    end;
  419.    PWABD_SesSubStatRec = ^TWABD_SesSubStatRec;
  420.  
  421.    TWABD_SesSubStat = class(TStringList)
  422.    public
  423.        destructor Destroy; override;
  424.        procedure AddPoint(ID:string; Value:double);
  425.        procedure ClearPoints;
  426.    end;
  427.  
  428.    TWABD_SesStatGroups = (wabdStatGroupTurnAround,wabdStatGroupCount,wabdStatGroupValue);
  429.  
  430.    TWABD_SesStatGroup = class(TThreadList)
  431.    protected
  432.          FName:string;
  433.          FSum:double;
  434.          FCount:integer;
  435.          FMin:double;
  436.          FMax:double;
  437.          FBufferSize:integer;
  438.          FGroupType:TWABD_SesStatGroups;
  439.    public
  440.          HourlyValues:array [0..23] of double;
  441.          HourlyCount:array [0..23] of integer;
  442.          DailyValues:array [1..31] of double;
  443.          DailyCount:array [1..31] of integer;
  444.          MonthlyValues:array [1..12] of double;
  445.          MonthlyCount:array [1..12] of integer;
  446.          DayValues:array [1..7] of double;
  447.          DayCount:array [1..7] of integer;
  448.          SubStat:TWABD_SesSubStat;
  449.  
  450.          constructor Create;
  451.          destructor Destroy; override;
  452.          procedure Clean;
  453.          procedure Zero;
  454.          property Name:string read FName;
  455.          property Sum:double read FSum;
  456.          property TotalCount:integer read FCount;
  457.          property Min:double read FMin;
  458.          property Max:double read FMax;
  459.          property BufferSize:integer read FBufferSize;
  460.          property GroupType:TWABD_SesStatGroups read FGroupType;
  461.    end;
  462.    TWABD_SesStat = class(TThreadList)
  463.    protected
  464.    public
  465.          destructor Destroy; override;
  466.          procedure AddGroup(GrpName:string; GrpType:TWABD_SesStatGroups; BufSize:integer);
  467.          procedure AddPoint(GrpName:string; User,Info:string; Value:double);
  468.          procedure Clean;
  469.          procedure Save(dllname:string);
  470.          procedure Load(dllname:string);
  471.          procedure Zero;
  472.          function IndexOf(GrpName:string):integer;
  473.    end;
  474.  
  475.    TWABD_OnCreateGuestSession = procedure(var NewSession: TWABD_Session; TriedToBeAdmin:boolean; Request:TWABD_CustomRequest) of object;
  476.    TWABD_OnCreateSession = procedure(var NewSession: TWABD_Session; Request:TWABD_CustomRequest) of object;
  477.    TWABD_OnDestroySession = procedure(Session: TWABD_Session) of object;
  478.    TWABD_OnFirstSession = procedure(Session: TWABD_Session) of object;
  479.    TWABD_OnChartPointClick = procedure(Sender: TObject; Index:integer; SerieLabel,SerieValue:double; SerieLabelString:string) of object;
  480.  
  481.    TWABD_Storage = (storeNone,storeIniFile,storeRegistry);
  482.    TWABD_OnStorage = procedure(Sender:TComponent; Section:String; Reg:TRegistry; Ini:TIniFile) of object;
  483.    TWABD_Setup = class(TComponent)
  484.    protected
  485.       FLock : TRTLCriticalSection;
  486.  
  487.       FLocalRootPath   : string;
  488.       FAutoSetGlobalRootPath : boolean;
  489.       FLocalImagePath  : string;
  490.       FImagePath       : string;
  491.       FLocalFilePath   : string;
  492.       FFilePath        : string;
  493.       FStorage    : TWABD_Storage;
  494.       FStoragePath: string;
  495.       FSectionName: string;
  496.       FAutoLoad  : boolean;
  497.       FAutoSave  : boolean;
  498.       FExpandFromRootPath : boolean;
  499.       FExpandFromGlobalRootPath: boolean;
  500.       FOnLoad    : TWABD_OnStorage;
  501.       FOnSave    : TWABD_OnStorage;
  502.       procedure   Loaded; override;
  503.       procedure   SetLocalRootPath(APath:string);
  504.       function    GetLocalRootPath:string;
  505.  
  506.    public
  507.       constructor   Create(AOwner:TComponent); override;
  508.       destructor    Destroy; override;
  509.       procedure     Load;
  510.       procedure     Save;
  511.       function      GetImagePath:string;
  512.       function      GetLocalImagePath:string;
  513.       function      GetFilePath:string;
  514.       function      GetLocalFilePath:string;
  515.       procedure     Lock;
  516.       procedure     Unlock;
  517.    published
  518.       property      LocalImagePath : string read FLocalImagePath write FLocalImagePath;
  519.       property      ImagePath : string read FImagePath write FImagePath;
  520.       property      LocalFilePath : string read FLocalFilePath write FLocalFilePath;
  521.       property      FilePath : string read FFilePath write FFilePath;
  522.       property      Storage   : TWABD_Storage read FStorage write FStorage;
  523.       property      StoragePath:string read FStoragePath write FStoragePath;
  524.       property      SectionName:string read FSectionName write FSectionName;
  525.       property      AutoLoad:boolean read FAutoLoad write FAutoLoad;
  526.       property      AutoSave:boolean read FAutoSave write FAutoSave;
  527.       property      OnLoad:TWABD_OnStorage read FOnLoad write FOnLoad;
  528.       property      OnSave:TWABD_OnStorage read FOnSave write FOnSave;
  529.       property      ExpandFromRootPath:boolean read FExpandFromRootPath write FExpandFromRootPath;
  530.       property      ExpandFromGlobalRootPath:boolean read FExpandFromGlobalRootPath write FExpandFromGlobalRootPath;
  531.       property      LocalRootPath:string read GetLocalRootPath write SetLocalRootPath;
  532.       property      AutoSetGlobalRootPath:boolean read FAutoSetGlobalRootPath write FAutoSetGlobalRootPath;
  533.    end;
  534.  
  535.    TWABD_RouteWhen = (rwNever, rwWhenFull, rwAllways);
  536.    TWABD_RouteHow = (rhRandom, rhRoundRobin);
  537.    TWABD_OnAuthenticate = procedure(RemoteHost:string; UserName:string; Password:string; var Authenticated:boolean) of object;
  538.    TWABD_OnTerminate = function(Flags:integer):boolean of object;
  539.    TWABD_OnValidateRequest = procedure(Request:TWABD_CustomRequest; Response:TWABD_CustomResponse; var Accept:boolean) of object;
  540.    TWABD_OnGarbageCollection = procedure(SesMgr:TWABD_SessionMgr) of object;
  541.    TWABD_OnException = procedure(Sender:TObject; E: Exception; var Handled: boolean) of object;
  542.    TWABD_SessionMgr = class(TComponent)
  543.    protected
  544.       FAbout      : TWABDAbout;
  545.       FCreate     : TWABD_OnCreateSession;
  546.       FDestroy    : TWABD_OnDestroySession;
  547.       FCreateAdmin: TWABD_OnCreateSession;
  548.       FCreateGuest: TWABD_OnCreateGuestSession;
  549.       FOnFirstSes : TWABD_OnFirstSession;
  550.       FOnValidateRequest : TWABD_OnValidateRequest;
  551.       FOnException: TWABD_OnException;
  552.       FCheck      : integer;        // Interval to perform Garbage Collection (seconds)
  553.       FGarbage    : boolean;        // True = perform Garbage collection
  554.       FWebAdmin   : string;         // Specify string (email, phonenumber or name) for application administrator.
  555.       FSiteName   : string;
  556.       FRouteSites : TStringList;    // Alternative sites to route call to.
  557.       FRouteWhen  : TWABD_RouteWhen;
  558.       FRouteHow   : TWABD_RouteHow;
  559.       FRouteLast  : integer;        // Points into FRouteSites for last one routed to.
  560.       FSiteID     : integer;        // Unique ID of this site. (-1= allocates randomly)
  561.       FGatherStats: boolean;
  562.       FNetWorkStats: boolean;
  563.       FStats      : TWABD_SesStat;
  564.       FOnAuthenticate  : TWABD_OnAuthenticate;
  565.       FAdmin      : TWABD_Admin;
  566.       FDefSesTimeout: integer;
  567.       FMaxSessions: integer;
  568.       FRandomSessionID : boolean;
  569.       FMaxIdenticalUser: integer;
  570.       FOnTerminate: TWABD_OnTerminate;
  571.       FStorage    : TWABD_Storage;
  572.       FStoragePath: string;
  573.       FSectionName: string;
  574.       FAutoLoad  : boolean;
  575.       FAutoSave  : boolean;
  576.       FHTMLTimeOut: TStringList;
  577.       FOnLoad    : TWABD_OnStorage;
  578.       FOnSave    : TWABD_OnStorage;
  579.       FOnGarbageCollection:TWABD_OnGarbageCollection;
  580.       FInfo      : string;
  581.       FVerDummy  : string;
  582.       FMaxRequestSize:integer;
  583.       FTotalSessionCount: longint;        // Number of sessions created totally until now.
  584.  
  585.       FUniqueList: TThreadList;     // List containing unique counters.
  586.  
  587.       GarbageThrd : TGarbageThread;
  588.       StopEvent   : THandle;
  589.       SesMgrCSCreate  : TRTLCriticalSection;
  590.       SesMgrCSDestroy  : TRTLCriticalSection;
  591.       SesMgrCSAuth : TRTLCriticalSection;
  592.       CreateTime  : TDateTime;
  593.       FVariables  : TStrings;
  594.  
  595.       FRequest    : TWABD_CustomRequest;
  596.       FResponse   : TWABD_CustomResponse;
  597.  
  598.       function    CreateNewSession(Request:TWABD_CustomRequest; Response:TWABD_CustomResponse):TWABD_Session;
  599.       function    RunExistingSession(const IdStr,BodyName:string;
  600.                                      Request:TWABD_CustomRequest; Response:TWABD_CustomResponse):TWABD_Session;
  601.       procedure   DoDestroySession(Ses: TWABD_Session);
  602.       function    Authenticate(Request:TWABD_CustomRequest; Response:TWABD_CustomResponse;
  603.                         LikeToBeAdmin:boolean; var IsAdmin:boolean):boolean;
  604.       procedure   SetGatherStats(b:boolean);
  605.       function    GetSessionCount:integer;
  606.       procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
  607.       procedure   Loaded; override;
  608.       procedure   SetSiteID(id:integer);
  609.       function    GetRoute:string;
  610.       function    CountIdenticalUser(UserName:string):integer;
  611.  
  612.       procedure   SetVariables(NewVariables: TStrings);
  613.       procedure   SetVariableByName(AName:string; AValue:string);
  614.       function    GetVariableByName(AName:string):string;
  615.       function    GetVersion:string;
  616.    public
  617.       SessionList : TThreadList;
  618.  
  619.       function    LocateSessionByID(ASiteID:integer; ASessionID:longint):TWABD_Session;
  620.       procedure   CheckLogOff(Ses: TWABD_Session);
  621.       constructor Create(AOwner: TComponent); override;
  622.       destructor  Destroy; override;
  623.       procedure   ClientRequest(Request:TWABD_CustomRequest; Response:TWABD_CustomResponse);
  624.       function    OnTerminateCallback(Flags:longint):boolean;
  625.       function    ProcessVariables(HTML:string):string;
  626.       property    Stats:TWABD_SesStat read FStats;
  627.       property    SessionCount:integer read GetSessionCount;
  628.       property    TotalSessionCount:longint read FTotalSessionCount;
  629.       procedure   Load;
  630.       procedure   Save;
  631.       procedure   CreateSequence(ID:string; StartValue:longint; Persistent:boolean);
  632.       function    DrawSequenceValue(ID:string):longint;
  633.       procedure   DeleteSequence(ID:string);
  634.       procedure   DeleteAllSequences;
  635.       property    VariableByName[s:string]:string read GetVariableByName write SetVariableByName;
  636.       property    Request:TWABD_CustomRequest read FRequest;
  637.       property    Response:TWABD_CustomResponse read FResponse;
  638.    published
  639.       property    GatherStatistics:boolean read FGatherStats write SetGatherStats;
  640.       property    NetworkStatistics:boolean read FNetworkStats write FNetworkStats;
  641.       property    MaxRequestSize:integer read FMaxRequestSize write FMaxRequestSize;
  642.       property    CheckTimeoutInterval: integer read FCheck write FCheck;
  643.       property    GarbageCollection: boolean read FGarbage write FGarbage;
  644.       property    OnTerminate: TWABD_OnTerminate read FOnTerminate write FOnTerminate;
  645.       property    OnFirstSession: TWABD_OnFirstSession read FOnFirstSes write FOnFirstSes;
  646.       property    OnCreateSession: TWABD_OnCreateSession read FCreate write FCreate;
  647.       property    OnCreateAdminSession: TWABD_OnCreateSession read FCreateAdmin write FCreateAdmin;
  648.       property    OnCreateGuestSession: TWABD_OnCreateGuestSession read FCreateGuest write FCreateGuest;
  649.       property    OnDestroySession: TWABD_OnDestroySession read FDestroy write FDestroy;
  650.       property    OnAuthenticate: TWABD_OnAuthenticate read FOnAuthenticate write FOnAuthenticate;
  651.       property    OnValidateRequest: TWABD_OnValidateRequest read FOnValidateRequest write FOnValidateRequest;
  652.       property    OnException: TWABD_OnException read FOnException write FOnException;
  653.       property    About: TWABDAbout read FAbout write FAbout;
  654.       property    Variables: TStrings read FVariables write SetVariables;
  655.       property    WebAdministrator: string read FWebAdmin write FWebAdmin;
  656.       property    SiteName: string read FSiteName write FSiteName;
  657.       property    SiteID:integer read FSiteID write SetSiteID;
  658.       property    Admin:TWABD_Admin read FAdmin write FAdmin;
  659.       property    DefaultSessionTimeout:integer read FDefSesTimeout write FDefSesTimeout;
  660.       property    MaxConcurrentSessions:integer read FMaxSessions write FMaxSessions;
  661.       property    MaxIdenticalUser:integer read FMaxIdenticalUser write FMaxIdenticalUser;
  662.       property    RandomSessionID:boolean read FRandomSessionID write FRandomSessionID;
  663.       property    RouteSites:TStringList read FRouteSites write FRouteSites;
  664.       property    RouteHow:TWABD_RouteHow read FRouteHow write FRouteHow;
  665.       property    RouteWhen:TWABD_RouteWhen read FRouteWhen write FRouteWhen;
  666.       property    Storage   : TWABD_Storage read FStorage write FStorage;
  667.       property    StoragePath:string read FStoragePath write FStoragePath;
  668.       property    SectionName:string read FSectionName write FSectionName;
  669.       property    AutoLoad:boolean read FAutoLoad write FAutoLoad;
  670.       property    AutoSave:boolean read FAutoSave write FAutoSave;
  671.       property    OnLoad:TWABD_OnStorage read FOnLoad write FOnLoad;
  672.       property    OnSave:TWABD_OnStorage read FOnSave write FOnSave;
  673.       property    OnGarbageCollection:TWABD_OnGarbageCollection read FOnGarbageCollection write FOnGarbageCollection;
  674.       property    HTMLTimeOut: TStringList read FHTMLTimeOut write FHTMLTimeOut;
  675.       property    Info:string read FInfo write FInfo;
  676.       property    Version:string read GetVersion write FVerDummy;
  677.    end;
  678.  
  679.    TWABD_OnTimeOut = procedure(SesMgr:TWABD_SessionMgr; ElapsedTime:longint; var AcceptTimeout:boolean) of object;
  680.    TWABD_OnLogon = procedure(RemoteHost:string) of object;
  681.    TWABD_OnLogoff = procedure of object;
  682.    TWABD_BeforeProcessRequest = procedure(Session:TWABD_Session) of object;
  683.    TWABD_AfterProcessRequest = procedure(Session:TWABD_Session) of object;
  684.    TWABD_OnRequest = procedure(Session:TWABD_Session; First:boolean) of object;
  685.  
  686.    TWABD_Produce = (prodAuto,prodHTML,prodWML);
  687.    
  688.    TWABD_Session = class(TComponent)
  689.    protected
  690.       FAbout      : TWABDAbout;
  691.       FMainBody   : TWABD_Body;
  692.       FAuthBody   : TWABD_Body;
  693.       FCurBody    : TWABD_Body;
  694.       FNewBody    : TWABD_Body;     // To "Show" new body
  695.       FLogon      : TWABD_OnLogon;
  696.       FLogoff     : TWABD_OnLogoff;
  697.       FTimeOut    : TWABD_OnTimeOut;
  698.       FGarbageCollection : TWABD_OnGarbageCollection;
  699.       DidLogOff   : boolean;
  700.       FTimeLen    : integer;
  701.       FSessionID  : longint;
  702.       FCreateTime : TDateTime;
  703.       FLastAccess : TDateTime;
  704.       FUserName:string;
  705.       FPassword:string;
  706.       FQueryFields:TStrings;
  707.       FHitCount:integer;            // Number of hits on this session.
  708.       FExcept     : TWABD_OnException;
  709.       FVariables  : TStrings;
  710.       FSessionMgr : TWABD_SessionMgr;
  711.       FDetermineBrowser : boolean;
  712.       FBeforeProcessRequest : TWABD_BeforeProcessRequest;
  713.       FAfterProcessRequest : TWABD_AfterProcessRequest;
  714.       FOnRequest  : TWABD_OnRequest;
  715.       FInfo       : string;
  716.       FSemaphore  : THandle;        // Used to serialize requests for this session. (Frames could async. do requests)
  717.       FLockCount  : integer;
  718.       FStateless  : boolean;
  719.       FEnableCookies:boolean;
  720.       FVerDummy   : string;
  721.       FProduce    : TWABD_Produce;
  722.  
  723.       FRequest    : TWABD_CustomRequest;
  724.       FResponse   : TWABD_CustomResponse;
  725.  
  726.       procedure   SetVariables(NewVariables: TStrings);
  727.       procedure   SetQueryFields(NewQueryFields:TStrings);
  728.       procedure   SetCookies(NewCookies:TWABD_Cookies);
  729.       procedure   SetVariableByName(AName:string; AValue:string);
  730.       procedure   SetCookieByName(AName:string; AValue:string);
  731.       procedure   SetQueryFieldByName(AName:string; AValue:string);
  732.       function    GetVariableByName(AName:string):string;
  733.       function    GetCookieByName(AName:string):string;
  734.       function    GetQueryFieldByName(AName:string):string;
  735.       function    GetCookies:TWABD_Cookies;
  736.  
  737.       function    ProcessRequest(BodyName:string; Request:TWABD_CustomRequest): string;
  738.       // procedure   Lock;
  739.       // procedure   Unlock;
  740.       procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
  741.       procedure   Loaded; override;
  742.       function    Authenticate:boolean;
  743.       function    GetSesUserName:string;
  744.       function    GetSesPassword:string;
  745.       function    GetVersion:string;
  746.    public
  747.       constructor Create(AOwner: TComponent); override;
  748.       destructor  Destroy; override;
  749.       procedure   LogOff;
  750.       function    ProcessVariables(HTML:string):string;
  751.       procedure   SendFile(ContentType,FileName,AsFileName:string);
  752.       procedure   LockSession;
  753.       procedure   UnlockSession;
  754.       property    SessionID:longint read FSessionID;
  755.       property    CurBody: TWABD_Body read FCurBody;
  756.       property    NewBody: TWABD_Body read FNewBody write FNewBody;
  757.       property    SessionMgr: TWABD_SessionMgr read FSessionMgr;
  758.       property    UserName:string read GetSesUserName;
  759.       property    Password:string read GetSesPassword;
  760.       property    LastAccess:TDateTime read FLastAccess;
  761.       property    CreateTime:TDateTime read FCreateTime;
  762.       property    HitCount:integer read FHitCount;
  763.       property    VariableByName[s:string]:string read GetVariableByName write SetVariableByName;
  764.       property    CookieByName[s:string]:string read GetCookieByName write SetCookieByName;
  765.       property    QueryFieldByName[s:string]:string read GetQueryFieldByName write SetQueryFieldByName;
  766.       property    Cookies:TWABD_Cookies read GetCookies write SetCookies;
  767.       property    QueryFields:TStrings read FQueryFields write SetQueryFields;
  768.       property    Response:TWABD_CustomResponse read FResponse;
  769.       property    Request:TWABD_CustomRequest read FRequest;
  770.    published
  771.       property    MainBody: TWABD_Body read FMainBody write FMainBody;
  772.       property    AuthBody: TWABD_Body read FAuthBody write FAuthBody;
  773.       property    Variables: TStrings read FVariables write SetVariables;
  774.       property    TimeOutLength: integer read FTimeLen write FTimeLen;
  775.       property    OnFirstLogon: TWABD_OnLogon read FLogon write FLogon;
  776.       property    OnLogoff: TWABD_OnLogoff read FLogoff write FLogoff;
  777.       property    OnTimeOut: TWABD_OnTimeOut read FTimeOut write FTimeOut;
  778.       property    OnGarbageCollection: TWABD_OnGarbageCollection read FGarbageCollection write FGarbageCollection;
  779.       property    OnException: TWABD_OnException read FExcept write FExcept;
  780.       property    About: TWABDAbout read FAbout write FAbout;
  781.       property    DoDetermineBrowser: boolean read FDetermineBrowser write FDetermineBrowser;
  782.       property    BeforeProcessRequest : TWABD_BeforeProcessRequest read FBeforeProcessRequest write FBeforeProcessRequest;
  783.       property    AfterProcessRequest : TWABD_AfterProcessRequest read FAfterProcessRequest write FAfterProcessRequest;
  784.       property    OnRequest : TWABD_OnRequest read FOnRequest write FOnRequest;
  785.       property    Info:string read FInfo write FInfo;
  786.       property    Stateless:boolean read FStateless write FStateless;
  787.       property    EnableCookies:boolean read FEnableCookies write FEnableCookies;
  788.       property    Version:string read GetVersion write FVerDummy;
  789.       property    Produce:TWABD_Produce read FProduce write FProduce;
  790.    end;
  791.  
  792.    TWABD_Logging = (logNothing,logLevel1,logLevel2,logAll);
  793.    TWABD_Admin = class(TComponent)
  794.    protected
  795.       FAdminUser:string;
  796.       FAdminPassword:string;
  797.       FLogoutHTML:string;
  798.       LogCS      : TRTLCriticalSection;
  799.       FLogging:boolean;
  800.       FLogFile:string;
  801.       FStorage    : TWABD_Storage;
  802.       FStoragePath: string;
  803.       FSectionName: string;
  804.       FAutoLoad  : boolean;
  805.       FAutoSave  : boolean;
  806.       FLogWhat   : TWABD_Logging;
  807.       FOnLoad    : TWABD_OnStorage;
  808.       FOnSave    : TWABD_OnStorage;
  809.  
  810.       procedure   Loaded; override;
  811.       function    GetLogging:boolean;
  812.    public
  813.       constructor Create(AOwner:TComponent); override;
  814.       destructor Destroy; override;
  815.       procedure LogFmt(fmt:string; args:array of const);
  816.       procedure Log(Text:string);
  817.       procedure Load;
  818.       procedure Save;
  819.    published
  820.       property AdminUser:string read FAdminUser write FAdminUser;
  821.       property AdminPassword:string read FAdminPassword write FAdminPassword;
  822.       property LogoutHTML:string read FLogoutHTML write FLogoutHTML;
  823.       property Logging:boolean read GetLogging write FLogging;
  824.       property LogFile:string read FLogFile write FLogFile;
  825.       property AutoLog:TWABD_Logging read FLogWhat write FLogWhat;
  826.       property Storage   : TWABD_Storage read FStorage write FStorage;
  827.       property StoragePath:string read FStoragePath write FStoragePath;
  828.       property SectionName:string read FSectionName write FSectionName;
  829.       property AutoLoad:boolean read FAutoLoad write FAutoLoad;
  830.       property AutoSave:boolean read FAutoSave write FAutoSave;
  831.       property OnLoad:TWABD_OnStorage read FOnLoad write FOnLoad;
  832.       property OnSave:TWABD_OnStorage read FOnSave write FOnSave;
  833.    end;
  834.  
  835.    TWABD_ObjectClass = class of TWABD_Object;
  836.    TWABD_Object = class(TComponent)
  837.    protected
  838.       FAbout      : TWABDAbout;
  839.       FParent     : TWABD_Parent;
  840.       FParentName : string;      // tmp to hold name before all components are loaded
  841.       FOnChange   : TNotifyEvent;
  842.       FVisible    : boolean;
  843.       FPathInfo   : string;
  844.       FOrder      : integer;     // Only used on loading
  845.       InLoaded    : boolean;
  846.       FDependingOn: TWABD_Object;
  847.  
  848.       procedure   SetParent(NewParent: TWABD_Parent);
  849.       procedure   SetVisible(b: boolean);
  850.       function    GetVisible:boolean;
  851.       procedure   Changed;
  852.       procedure   DefineProperties(Filer: TFiler); override;
  853.       procedure   Loaded; override;
  854.       procedure   ReadParentName(Reader: TReader);
  855.       procedure   WriteParentName(Writer: TWriter);
  856.       function    GetOrder: integer;
  857.       procedure   SetOrder(NewOrder: integer);
  858.       procedure   SetName(const Value: TComponentName); override;
  859.       procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
  860.       function    GetSession: TWABD_Session;
  861.       function    GetSessionID: longint;
  862.       function    GetDLLName: string;
  863.  
  864.       property    PathInfo:string read FPathInfo write FPathInfo;
  865.    public
  866.       constructor Create(AOwner: TComponent); override;
  867.       destructor  Destroy; override;
  868.  
  869.       function    GetHRef(Body:TWABD_Body; Component:TWABD_Object; WabdType,Data:string):string;
  870.       function    Object_To_HTML: string; virtual; abstract;
  871.       function    Object_To_WML: string; virtual;
  872.       function    Object_To_WML_Postfield: string; virtual;
  873.       function    Object_To_Control(AOwner: TWinControl): TControl; virtual; abstract;
  874.       procedure   HTML_To_Object(FormVal: string); virtual; abstract;
  875.       function    GetParentForm: TWABD_Form;
  876.       procedure   SaveHTMLToFile(AFile:string);
  877.       procedure   SaveWMLToFile(AFile:string);
  878.       property    OnChange: TNotifyEvent read FOnChange write FOnChange;
  879.       property    Parent: TWABD_Parent read FParent write SetParent;
  880.       property    Order: integer read GetOrder write SetOrder;
  881.       property    Session:TWABD_Session read GetSession;
  882.       property    SessionID:longint read GetSessionID;
  883.       property    DLLName:string read GetDLLName;
  884.    published
  885.       property    Visible: boolean read GetVisible write SetVisible;
  886.       property    About: TWABDAbout read FAbout write FAbout;
  887.       property    DependingOn: TWABD_Object read FDependingOn write FDependingOn;
  888.    end;
  889.  
  890.    TWABD_ForEach = procedure(Child: TWABD_Object; var Stop: boolean; UserData: pointer) of object;
  891.  
  892.    TWABD_Parent = class(TWABD_Object)
  893.    protected
  894.       FWABD_Objs  : TList;
  895.       tmp         : string;
  896.       TheChild    : TWABD_Object;
  897.       function    GetWABDObjects(i: integer): TWABD_Object;
  898.       function    GetWABDObjCount: integer;
  899.       function    ButtonByCaption(Caption: string): TWABD_Button;
  900.       function    GetDefaultButton: TWABD_Button;
  901.       procedure   DefButProc(Child: TWABD_Object; var Stop: boolean; UserData: pointer);
  902.       procedure   ChildNameProc(Child: TWABD_Object; var Stop: boolean; UserData: pointer);
  903.       procedure   ButCapProc(Child: TWABD_Object; var Stop: boolean; UserData: pointer);
  904.       procedure   ChildChanged(Sender: TObject); virtual;
  905.       procedure   Loaded; override;
  906.    public
  907.       constructor Create(AOwner: TComponent); override;
  908.       destructor  Destroy; override;
  909.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  910.       function    ForEachChild(ForEachProc: TWABD_ForEach; UserData: pointer): boolean;
  911.       property    Children[i: integer] : TWABD_Object read GetWABDObjects;
  912.       property    ChildCount: integer read GetWABDObjCount;
  913.       function    ChildByName(ChildName: string): TWABD_Object;
  914.    end;
  915.  
  916.  
  917.    // ************************************************************************
  918.    // "Top" Level objects
  919.  
  920.    TWABD_ReflectNotify = procedure(Sender: TObject; AComponent: TComponent; Operation: TOperation) of object;
  921.    TChildNameChangedProc = procedure(Sender: TObject; const OldName, NewName: string) of object;
  922.  
  923.    TWABDEditForm = class(TPersistent)
  924.    public
  925.       ParForm     : TWABD_Form;
  926.    end;
  927.    TWABDEditFrameset = class(TPersistent)
  928.    public
  929.       ParFrameset : TWABD_Frameset;
  930.    end;
  931.  
  932.    TFrameDivision = (fdHorizontal, fdVertical);
  933.    TFrameScroll = (fsAuto,fsYes,fsNo);
  934.    TWABD_Base_Frame=class(TWABD_Object)
  935.    protected
  936.       FFrameName:string;
  937.    end;
  938.  
  939.    TWABD_ExternalFrameType = (eftOther,eftBlank,eftTop,eftParent,eftSearch,eftSelf);
  940.    TWABD_ExternalFrame = class(TWABD_Base_Frame)
  941.    protected
  942.       FType:TWABD_ExternalFrameType;
  943.       procedure SetFrameType(AType:TWABD_ExternalFrameType);
  944.       procedure SetFrameName(AName:string);
  945.    public
  946.       constructor Create(AOwner:TComponent); override;
  947.       function    Object_To_HTML: string; override;
  948.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  949.       procedure   HTML_To_Object(FormVal: string); override;
  950.    published
  951.       property FrameType:TWABD_ExternalFrameType read FType write SetFrameType;
  952.       property FrameName:string read FFrameName write SetFrameName;
  953.    end;
  954.  
  955.    TWABD_Frame = class(TWABD_Base_Frame)
  956.    protected
  957.       FSize:integer;
  958.       FVisible:boolean;
  959.       FLinkBody:TWABD_Body;
  960.       FFrameBorder:boolean;
  961.       FBorderColor:TColor;
  962.       FResize:boolean;
  963.       FScrolling:TFrameScroll;
  964.       FMarginHeight:integer;
  965.       FMarginWidth:integer;
  966.       procedure   SetFrameset(frameset:TWABD_Frameset);
  967.       function    GetFrameset:TWABD_Frameset;
  968.       procedure   SetLinkBody(body:TWABD_Body);
  969.       procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
  970.       procedure   SetName(const Value: TComponentName); override;
  971.    public
  972.       constructor Create(AOwner: TComponent); override;
  973.       property FrameName:string read FFrameName;
  974.    published
  975.       property Size:integer read FSize write FSize;
  976.       property Visible:boolean read FVisible write FVisible;
  977.       property LinkBody:TWABD_Body read FLinkBody write SetLinkBody;
  978.       property Frameset:TWABD_Frameset read GetFrameset write SetFrameset;
  979.       property FrameBorder:boolean read FFrameBorder write FFrameBorder;
  980.       property BorderColor:TColor read FBorderColor write FBorderColor;
  981.       property Resize:boolean read FResize write FResize;
  982.       property Scrolling:TFrameScroll read FScrolling write FScrolling;
  983.       property MarginHeight:integer read FMarginHeight write FMarginHeight;
  984.       property MarginWidth:integer read FMarginWidth write FMarginWidth;
  985.    end;
  986.  
  987.    TWABD_OnSubmit = procedure(Sender: TObject; Request:TWABD_CustomRequest) of object;
  988.    TWABD_Body = class(TWABD_Parent)
  989.    protected
  990.       FFrame      : TWABD_Frame;
  991.       FOnCreate   : TNotifyEvent;
  992.       FOnShow     : TNotifyEvent;
  993.       FOnSubmit   : TWABD_OnSubmit;
  994.       FJavascript : TWABD_Javascript;
  995.       FJS_OnUserLoad: TWABD_JS_Function;
  996.       FJS_OnUserUnload: TWABD_JS_Function;
  997.       FJS_OnUserEvent: TWABD_JS_Function;
  998.       FJS_OnUserSubmit: TWABD_JS_Function;
  999.       FWSession   : TWABD_Session;
  1000.       FNameChge   : TChildNameChangedProc;
  1001.       FCloseOpener: boolean;
  1002.       FClientSubmitTimeStamp: double;
  1003.       FClientLoadTimeStamp: double;
  1004.       FClientProcessTime: double;
  1005.  
  1006.       FFieldValues: TStrings;
  1007.  
  1008.       FIsReload   : boolean;
  1009.       FUseSessionCookie:boolean;
  1010.       FEncType    : string;
  1011.  
  1012.       procedure   ProcessRequest(Request:TWABD_CustomRequest); virtual;
  1013.       procedure   DoShow; virtual;
  1014.       property    JS_OnUserEvent:TWABD_JS_Function read FJS_OnUserEvent write FJS_OnUserEvent;
  1015.       property    JS_OnUserLoad:TWABD_JS_Function read FJS_OnUserLoad write FJS_OnUserLoad;
  1016.       property    JS_OnUserUnload:TWABD_JS_Function read FJS_OnUserUnload write FJS_OnUserUnload;
  1017.       property    JS_OnUserSubmit:TWABD_JS_Function read FJS_OnUserSubmit write FJS_OnUserSubmit;
  1018.       property    EncType:string read FEncType write FEncType;
  1019.  
  1020.       function GetFieldValueCount:integer;
  1021.       function GetFieldValue(i:integer):string;
  1022.       function GetFieldValueByName(s:string):string;
  1023.       procedure SetFieldValue(i:integer; Value:string);
  1024.       procedure SetFieldValueByName(s:string; Value:string);
  1025.    public
  1026.       RefNotify   : TWABD_ReflectNotify;                    // No one should use this but it's Component Editor
  1027.       procedure   CreateSessionCookie;
  1028.       property    Session: TWABD_Session read FWSession write FWSession;
  1029.       property    OnChildNameChanged: TChildNameChangedProc read FNameChge write FNameChge;
  1030.       property    CloseOpener:boolean read FCloseOpener write FCloseOpener;
  1031.       property    Frame:TWABD_Frame read FFrame;
  1032.       property    ClientSubmitTimeStamp:double read FClientSubmitTimeStamp;
  1033.       property    ClientLoadTimeStamp:double read FClientLoadTimeStamp;
  1034.       property    ClientProcessTime:double read FClientProcessTime;
  1035.       property    IsReload:boolean read FIsReload;
  1036.       property    ValueCount:integer read GetFieldValueCount;
  1037.       property    Values[i:integer]:string read GetFieldValue write SetFieldValue;
  1038.       property    ValueByName[s:string]:string read GetFieldValueByName write SetFieldValueByName;
  1039.  
  1040.       constructor Create(AOwner:TComponent); override;
  1041.       destructor Destroy; override;
  1042.    published
  1043.       property    OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
  1044.       property    OnShow: TNotifyEvent read FOnShow write FOnShow;
  1045.       property    OnSubmit:TWABD_OnSubmit read FOnSubmit write FOnSubmit;
  1046.       property    Javascript:TWABD_Javascript read FJavascript write FJavascript;
  1047.       property    UseSessionCookie:boolean read FUseSessionCookie write FUseSessionCookie;
  1048.    end;
  1049.  
  1050.    TWABD_Base_HTML = class(TWABD_Body)
  1051.    protected
  1052.       FOnSubmit:TWABD_OnSubmit;
  1053.       FHTML       : TStrings;
  1054.       property    HTML:TStrings read FHTML write FHTML;
  1055.    public
  1056.       constructor Create(AOwner:TComponent); override;
  1057.       destructor  Destroy; override;
  1058.       procedure   Show;
  1059.    end;
  1060.  
  1061.    TWABD_HTML = class(TWABD_Base_HTML)
  1062.    protected
  1063.    public
  1064.       function    Object_To_HTML: string; override;
  1065.       function    Object_To_WML:string; override;
  1066.       procedure   HTML_To_Object(FormVal: string); override;
  1067.    published
  1068.       property    HTML;
  1069.       property    JS_OnUserLoad;
  1070.       property    JS_OnUserUnload;
  1071.       property    EncType;
  1072.    end;
  1073.  
  1074.    TWABD_HTMLFile = class(TWABD_Base_HTML)
  1075.    protected
  1076.       FFileName         : TFileName;
  1077.       FSetup            : TWABD_Setup;
  1078.       FLoadedWhen       : TDateTime;
  1079.       FSecsBeforeReload : integer;
  1080.       FCached           : boolean;
  1081.       procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
  1082.    public
  1083.       constructor Create(AOwner:TComponent); override;
  1084.       destructor  Destroy; override;
  1085.       function    Object_To_HTML: string; override;
  1086.       function    Object_To_WML:string; override;
  1087.       procedure   HTML_To_Object(FormVal: string); override;
  1088.       procedure   Reload;
  1089.       property    LoadedWhen:TDateTime read FLoadedWhen;
  1090.       property    HTML;
  1091.    published
  1092.       property    FileName:TFileName read FFileName write FFileName;
  1093.       property    SecsBeforeReload:integer read FSecsBeforeReload write FSecsBeforeReload;
  1094.       property    Cached:boolean read FCached write FCached;
  1095.       property    Setup:TWABD_Setup read FSetup write FSetup;
  1096.       property    JS_OnUserLoad;
  1097.       property    JS_OnUserUnload;
  1098.       property    EncType;
  1099.    end;
  1100.  
  1101.  
  1102.    TWABD_Frameset = class(TWABD_Body)
  1103.    protected
  1104.       FFramesetTitle: string;
  1105.       FDivision   : TFrameDivision;
  1106.       FBorderWidth: integer;
  1107.       FBorderColor: TColor;
  1108.       FFrameBorder: boolean;
  1109.       FParentFrame: TWABD_Frame;
  1110.       FEdFrameset : TWABDEditFrameset;
  1111.  
  1112.       procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
  1113.       procedure   SetEdFrameset(NewEdFrameset: TWABDEditFrameset);
  1114.    public
  1115.       constructor Create(AOwner: TComponent); override;
  1116.       destructor  Destroy; override;
  1117.       function    Object_To_HTML: string; override;
  1118.       procedure   Loaded; override;
  1119.       procedure   Show;
  1120.       function    DoPostScript: string;
  1121.       function    DoPreScript: string;
  1122.    published
  1123.       property    Division:TFrameDivision read FDivision write FDivision;
  1124.       property    BorderWidth:integer read FBorderWidth write FBorderWidth;
  1125.       property    BorderColor:TColor read FBorderColor write FBorderColor;
  1126.       property    FrameBorder:boolean read FFrameBorder write FFrameBorder;
  1127.       property    Title:string read FFramesetTitle write FFramesetTitle;
  1128.       property    EditFrameset: TWABDEditFrameset read FEdFrameset write SetEdFrameset;
  1129.       property    JS_OnUserLoad;
  1130.       property    JS_OnUserUnload;
  1131.    end;
  1132.  
  1133.    TWABD_HorzAlignment = (alhNone,alhLeft,alhCenter,alhRight);
  1134.    TWABD_VertAlignment = (alvNone,alvTop,alvMiddle,alvBottom,alvBaseline);
  1135.  
  1136.    TWABD_OnUserCallback = procedure(Sender: TObject; Data:string) of object;
  1137.    TWABD_OnSubmitForm = procedure(Sender: TObject; Request:TWABD_CustomRequest; var ProcessEvents:boolean) of object;
  1138.    TWABD_OnOutOfOrder = procedure(Sender: TObject; Request:TWABD_CustomRequest; var DoSetProperties,DoProcessEvents:boolean) of object;
  1139.    TWABD_Form = class(TWABD_Body)
  1140.    private
  1141.       function  GetEventID(var str:string):string;
  1142.       procedure SplitEventID(str:string;var EventID:integer; var CtrlName:string; var Data:string);
  1143.    protected
  1144.       FCheckOutOfOrder:boolean;
  1145.       FOutOfOrder : boolean;
  1146.       FOnOutOfOrder:TWABD_OnOutOfOrder;
  1147.       FSubmitCount  : longint;
  1148.       FOnSubmitForm : TWABD_OnSubmitForm;
  1149.       FOnUserCallback: TWABD_OnUserCallback;
  1150.       FJS_OnUserEventSubmit: TWABD_JS_Function;
  1151.       FEdForm     : TWABDEditForm;
  1152.       FSubmitTo   : TWABD_Base_Frame;
  1153.       FSesID      : longint;
  1154.       FTextColor  : TColor;
  1155.       FLinkColor  : TColor;
  1156.       FVLinkColor : TColor;
  1157.       FALinkColor : TColor;
  1158.       FBgndColor  : TColor;
  1159.       FBgrdImage  : TWABD_Image;
  1160.       FTitle      : string;
  1161.       FMarginTop  :integer;
  1162.       FMarginBottom:integer;
  1163.       FMarginLeft  :integer;
  1164.       FMarginRight :integer;
  1165.       FHeight     : integer;
  1166.       FWidth      : integer;
  1167.       FEventHandlersOnForm : boolean;
  1168.       FUploadFileOnForm : boolean;
  1169.       function    GetFormBody: string;
  1170.       function    FormSections_To_HTML: string; virtual;
  1171.       function    FormSections_To_WML: string; virtual;
  1172.       function    FormSections_To_WML_Postfield: string; virtual;
  1173.       function    DoPreScript: string;
  1174.       function    DoPostScript: string;
  1175.       procedure   ClearControl(Child: TWABD_Object; var Stop: boolean; UserData: pointer);
  1176.       procedure   ParseImageParams(Request: TWABD_CustomRequest; var ImageName: string; var x,y: integer);
  1177.       procedure   SetProperties(Request:TWABD_CustomRequest);
  1178.       procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
  1179.       procedure   SetName(const Value: TComponentName); override;
  1180.       procedure   SetEdForm(NewEdForm: TWABDEditForm);
  1181.       procedure   Call_Handler(Request:TWABD_CustomRequest);
  1182.       procedure   ProcessRequest(Request:TWABD_CustomRequest); override;
  1183.       function    OutOfOrder(Request:TWABD_CustomRequest):boolean;
  1184.    public
  1185.       constructor Create(AOwner: TComponent); override;
  1186.       destructor  Destroy; override;
  1187.       procedure   ChildChanged(Sender: TObject); override;
  1188.       function    Object_To_HTML: string; override;
  1189.       function    Object_To_WML:string; override;
  1190.       procedure   HTML_To_Object(FormVal: string); override;
  1191.       procedure   Show;
  1192.       procedure   Loaded; override;
  1193.       property    IsOutOfOrder:boolean read FOutOfOrder;
  1194.    published
  1195.       property    EncType;
  1196.       property    TextColor: TColor read FTextColor write FTextColor;
  1197.       property    LinkColor: TColor read FLinkColor write FLinkColor;
  1198.       property    VLinkColor: TColor read FVLinkColor write FVLinkColor;
  1199.       property    ALinkColor: TColor read FALinkColor write FALinkColor;
  1200.       property    BgndColor: TColor read FBgndColor write FBgndColor;
  1201.       property    CheckOutOfOrder:boolean read FCheckOutOfOrder write FCheckOutOfOrder;
  1202.       property    OnOutOfOrder: TWABD_OnOutOfOrder read FOnOutOfOrder write FOnOutOfOrder;
  1203.       property    OnSubmitForm: TWABD_OnSubmitForm read FOnSubmitForm write FOnSubmitForm;
  1204.       property    OnUserCallback: TWABD_OnUserCallBack read FOnUserCallback write FOnUserCallback;
  1205.       property    BgrdImage: TWABD_Image read FBgrdImage write FBgrdImage;
  1206.       property    FormTitle: string read FTitle write FTitle;
  1207.       property    EditForm: TWABDEditForm read FEdForm write SetEdForm;
  1208.       property    SubmitToFrame: TWABD_Base_Frame read FSubmitTo write FSubmitTo;
  1209.       property    MarginTop:integer read FMarginTop write FMarginTop;
  1210.       property    MarginBottom:integer read FMarginBottom write FMarginBottom;
  1211.       property    MarginLeft:integer read FMarginLeft write FMarginLeft;
  1212.       property    MarginRight:integer read FMarginRight write FMarginRight;
  1213.       property    Width:integer read FWidth write FWidth;
  1214.       property    Height:integer read FHeight write FHeight;
  1215.       property    JS_OnUserEventSubmit:TWABD_JS_Function read FJS_OnUserEventSubmit write FJS_OnUserEventSubmit;
  1216.       property    JS_OnUserSubmit;
  1217.       property    JS_OnUserEvent;
  1218.       property    JS_OnUserLoad;
  1219.       property    JS_OnUserUnload;
  1220.    end;
  1221.  
  1222.    TWABD_FormSection_Base = class(TWABD_Parent)
  1223.    private
  1224.       FWidth      : integer;
  1225.       FHeight     : integer;
  1226.       FHorzAlign  : TWABD_HorzAlignment;
  1227.       FVertAlign  : TWABD_VertAlignment;
  1228.       FEventHandlersOnFormSection : boolean;
  1229.       FTitle      : string;
  1230.    published
  1231.       property    Width: integer read FWidth write FWidth default 0;
  1232.       property    Height: integer read FHeight write FHeight default 0;
  1233.       property    HorzAlign:TWABD_HorzAlignment read FHorzAlign write FHorzAlign;
  1234.       property    VertAlign:TWABD_VertAlignment read FVertAlign write FVertAlign;
  1235.       property    Title:string read FTitle write FTitle;
  1236.    end;
  1237.  
  1238.    TWABD_FormSection_Grid = class(TWABD_FormSection_Base)
  1239.    private
  1240.       NumRow      : integer;
  1241.       NumCol      : integer;
  1242.       ColSizes    : array[0..255] of integer;   // eg 5,5,6,6
  1243.       RowSizes    : array[0..255] of integer;
  1244.       ColTot      : array[0..255] of integer;   // eg 5,10,16,22
  1245.       RowTot      : array[0..255] of integer;
  1246.       FindCol     : integer;                    // Used by ControlAtFunc
  1247.       FindRow     : integer;
  1248.       FindCon     : TWABD_SectionObject;
  1249.    protected
  1250.       FGridX      : integer;
  1251.       FGridY      : integer;
  1252.       FCellBorder : integer;
  1253.       FCellSpace  : integer;
  1254.       FCellPad    : integer;
  1255.       FNoWrap     : boolean;
  1256.       function    FormSection_To_HTML: string; virtual;
  1257.       function    FormSection_To_WML: string; virtual;
  1258.       function    FormSection_To_WML_Postfield: string; virtual;
  1259.       procedure   SetGridX(NewX: integer);
  1260.       procedure   SetGridY(NewY: integer);
  1261.       procedure   AutoSizeRowCol;
  1262.       procedure   ControlAtFunc(Child: TWABD_Object; var Stop: boolean; UserData: pointer);
  1263.    public
  1264.       constructor Create(AOwner: TComponent); override;
  1265.       function    Object_To_HTML: string; override;
  1266.       function    Object_To_WML:string; override;
  1267.       function    Object_To_WML_Postfield:string; override;
  1268.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  1269.       procedure   HTML_To_Object(FormVal: string); override;
  1270.       function    AddControl(ControlClass: TWABD_SectionObjectClass; Col, Row: integer): TWABD_SectionObject;
  1271.       function    ControlAtPos(Col, Row: integer): TWABD_SectionObject;
  1272.    published
  1273.       property    GridX: integer read FGridX write SetGridX default 16;
  1274.       property    GridY: integer read FGridY write SetGridY default 16;
  1275.       property    CellBorder: integer read FCellBorder write FCellBorder;
  1276.       property    CellSpacing: integer read FCellSpace write FCellSpace;
  1277.       property    CellPadding: integer read FCellPad write FCellPad;
  1278.       property    NoWrap:boolean read FNoWrap write FNoWrap;
  1279.    end;
  1280.  
  1281.    TWABD_FormSection = class(TWABD_FormSection_Grid)
  1282.    published
  1283.    end;
  1284.  
  1285.    TWABD_Header = class(TWABD_FormSection_Base)
  1286.    protected
  1287.       FNum        : integer;
  1288.       FCaption    : string;
  1289.       procedure   SetNum(NewNum: integer);
  1290.       procedure   SetName(const Value: TComponentName); override;
  1291.    public
  1292.       constructor Create(AOwner: TComponent); override;
  1293.       function    Object_To_HTML: string; override;
  1294.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  1295.       procedure   HTML_To_Object(FormVal: string); override;
  1296.    published
  1297.       property    HeaderNum: integer read FNum write SetNum;
  1298.       property    Caption: string read FCaption write FCaption;
  1299.    end;
  1300.  
  1301.    TWABDEditTree = class(TPersistent)
  1302.    public
  1303.       ParTree     : TWABD_Tree;
  1304.    end;
  1305.  
  1306.    TWABD_TreeNode = class(TWABD_Object)
  1307.    private
  1308.       FCaption    : string;
  1309.       FLevel      : integer;
  1310.       FHint       : string;
  1311.       FImgIconLink   : TWABD_Image;
  1312.       FSubmitTo   : TWABD_Base_Frame;
  1313.       FDefaultOpen: boolean;
  1314.       FOnUserClick: TNotifyEvent;
  1315.       FJS_OnUserClick: TWABD_JS_Function;
  1316.       procedure SetCaption(s:string);
  1317.    protected
  1318.       procedure DefineProperties(Filer: TFiler); override;
  1319.       procedure WriteLevel(Writer: TWriter);
  1320.       procedure ReadLevel(Reader: TReader);
  1321.       procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  1322.    public
  1323.       constructor Create(AOwner: TComponent); override;
  1324.       destructor Destroy; override;
  1325.       function  Object_To_HTML: string; override;
  1326.       function  Object_To_Control(AOwner: TWinControl): TControl; override;
  1327.       procedure HTML_To_Object(FormVal: string); override;
  1328.       property  Level:integer read FLevel write FLevel stored true;
  1329.    published
  1330.       property SubmitToFrame:TWABD_Base_Frame read FSubmitTo write FSubmitTo;
  1331.       property Caption:string read FCaption write SetCaption;
  1332.       property Hint:string read FHint write FHint;
  1333.       property Icon:TWABD_Image read FImgIconLink write FImgIconLink;
  1334.       property DefaultOpen:boolean read FDefaultOpen write FDefaultOpen;
  1335.       property OnUserClick:TNotifyEvent read FOnUserClick write FOnUserClick;
  1336.       property JS_OnUserClick:TWABD_JS_Function read FJS_OnUserClick write FJS_OnUserClick;
  1337.    end;
  1338.  
  1339.    TWABD_AddTreeNodeFlag = (atnFirst,atnLast,atnAfter,atnBefore,atnChild);
  1340.    TWABD_AddTreeNodeFlags = set of TWABD_AddTreeNodeFlag;
  1341.  
  1342.    TWABD_TreeClick = procedure(Sender: TObject; Node:TWABD_TreeNode) of object;
  1343.    TWABD_Tree = class(TWABD_Body)
  1344.    protected
  1345.       FEdTree     : TWABDEditTree;  // Dummy for getting property editor up and running.
  1346.       FOnUserClick: TNotifyEvent;
  1347.       FJS_OnUserClick: TWABD_JS_Function;
  1348.       procedure   SetEdTree(NewEdTree: TWABDEditTree);
  1349.       procedure   ProcessRequest(Request:TWABD_CustomRequest); override;
  1350.    public
  1351.       constructor Create(AOwner: TComponent); override;
  1352.       destructor  Destroy; override;
  1353.       function    Object_To_HTML: string; override;
  1354.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  1355.       procedure   HTML_To_Object(FormVal: string); override;
  1356.       function    NodeByName(NodeName:string):TWABD_TreeNode;
  1357.       function    AddNode(Name:string; RefNode:TWABD_TreeNode; Flags:TWABD_AddTreeNodeFlags):TWABD_TreeNode;
  1358.       procedure   DeleteNode(ANode:TWABD_TreeNode; FreeNode:boolean);
  1359.       procedure   Clear(FreeNodes:boolean);
  1360.    published
  1361.       property    Tree: TWABDEditTree read FEdTree write SetEdTree;
  1362.       property    OnUserClick:TNotifyEvent read FOnUserClick write FOnUserClick;
  1363.       property    JS_OnUserClick:TWABD_JS_Function read FJS_OnUserClick write FJS_OnUserClick;
  1364.       property    JS_OnUserEvent;
  1365.    end;
  1366.    TWABD_MenuTree = class(TWABD_Tree)
  1367.    protected
  1368.       FCaption    : string;
  1369.       FJavascript : TWABD_Javascript;
  1370.       FImages     : TStrings;
  1371.       FVariables  : TStrings;
  1372.       FFontColor  : TColor;
  1373.       FFontSize   : integer;
  1374.       FLinkColor  : TColor;
  1375.       FVLinkColor : TColor;
  1376.       FALinkColor : TColor;
  1377.       FBGColor    : TColor;
  1378.       FSubmitTo   : TWABD_Base_Frame;
  1379.       FImgIconBlank             : TWABD_Image;
  1380.       FImgIconBranchCont        : TWABD_Image;
  1381.       FImgIconBranchEnd         : TWABD_Image;
  1382.       FImgIconFolderClosed      : TWABD_Image;
  1383.       FImgIconFolderOpen        : TWABD_Image;
  1384.       FImgIconRoot              : TWABD_Image;
  1385.       FImgIconMinusCont         : TWABD_Image;
  1386.       FImgIconMinusEnd          : TWABD_Image;
  1387.       FImgIconPlusCont          : TWABD_Image;
  1388.       FImgIconPlusEnd           : TWABD_Image;
  1389.       FImgIconVertLine          : TWABD_Image;
  1390.       FImgIconLink              : TWABD_Image;
  1391.       FBgrdImage                : TWABD_Image;
  1392.  
  1393.       procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
  1394.  
  1395.    public
  1396.       constructor Create(AOwner: TComponent); override;
  1397.       destructor  Destroy; override;
  1398.  
  1399.       function    Object_To_HTML: string; override;
  1400.       function    Object_To_Top_HTML: string;
  1401.       procedure   HTML_To_Object(FormVal: string); override;
  1402.       procedure   SetupVariables;
  1403.       function    GenMenuTreeJSSetup:string;
  1404.    published
  1405.       property    Caption:string read FCaption write FCaption;
  1406.       property    Images:TStrings read FImages write FImages;
  1407.       property    Javascript:TWABD_Javascript read FJavascript write FJavascript;
  1408.       property    TextColor:TColor read FFontColor write FFontColor;
  1409.       property    TextSize:integer read FFontSize write FFontSize;
  1410.       property    BgndColor:TColor read FBGColor write FBGColor;
  1411.       property    SubmitToFrame: TWABD_Base_Frame read FSubmitTo write FSubmitTo;
  1412.       property    LinkColor: TColor read FLinkColor write FLinkColor;
  1413.       property    VLinkColor: TColor read FVLinkColor write FVLinkColor;
  1414.       property    ALinkColor: TColor read FALinkColor write FALinkColor;
  1415.       property    IconBlank        : TWABD_Image read FImgIconBlank write FImgIconBlank;
  1416.       property    IconBranchCont   : TWABD_Image read FImgIconBranchCont write FImgIconBranchCont;
  1417.       property    IconBranchEnd    : TWABD_Image read FImgIconBranchEnd write FImgIconBranchEnd;
  1418.       property    IconFolderClosed : TWABD_Image read FImgIconFolderClosed write FImgIconFolderClosed;
  1419.       property    IconFolderOpen   : TWABD_Image read FImgIconFolderOpen write FImgIconFolderOpen;
  1420.       property    IconRoot         : TWABD_Image read FImgIconRoot write FImgIconRoot;
  1421.       property    IconMinusCont    : TWABD_Image read FImgIconMinusCont write FImgIconMinusCont;
  1422.       property    IconMinusEnd     : TWABD_Image read FImgIconMinusEnd write FImgIconMinusEnd;
  1423.       property    IconPlusCont     : TWABD_Image read FImgIconPlusCont write FImgIconPlusCont;
  1424.       property    IconPlusEnd      : TWABD_Image read FImgIconPlusEnd write FImgIconPlusEnd;
  1425.       property    IconVertLine     : TWABD_Image read FImgIconVertLine write FImgIconVertLine;
  1426.       property    IconLink         : TWABD_Image read FImgIconLink write FImgIconLink;
  1427.       property    BgrdImage        : TWABD_Image read FBgrdImage write FBgrdImage;
  1428.    end;
  1429.  
  1430.    TWABD_HTMLSection = class(TWABD_FormSection_Base)
  1431.    protected
  1432.       FHTML      : TStrings;
  1433.       procedure   SetHTML(NewHTML: TStrings);
  1434.       procedure   SetName(const Value: TComponentName); override;
  1435.    public
  1436.       constructor Create(AOwner: TComponent); override;
  1437.       destructor  Destroy; override;
  1438.       function    Object_To_HTML: string; override;
  1439.       function    Object_To_WML: string; override;
  1440.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  1441.       procedure   HTML_To_Object(FormVal: string); override;
  1442.    published
  1443.       property    HTML: TStrings read FHTML write SetHTML;
  1444.    end;
  1445.  
  1446.    TWABD_HTMLFileSection = class(TWABD_HTMLSection)
  1447.    protected
  1448.       FFileName         : TFileName;
  1449.       FSetup            : TWABD_Setup;
  1450.       FLoadedWhen       : TDateTime;
  1451.       FSecsBeforeReload : integer;
  1452.       FCached           : boolean;
  1453.       procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
  1454.    public
  1455.       procedure   Reload;
  1456.       property    LoadedWhen:TDateTime read FLoadedWhen;
  1457.       constructor Create(AOwner: TComponent); override;
  1458.       destructor  Destroy; override;
  1459.       function    Object_To_HTML: string; override;
  1460.       function    Object_To_WML: string; override;
  1461.    published
  1462.       property    FileName:TFileName read FFileName write FFileName;
  1463.       property    SecsBeforeReload:integer read FSecsBeforeReload write FSecsBeforeReload;
  1464.       property    Cached:boolean read FCached write FCached;
  1465.       property    Setup:TWABD_Setup read FSetup write FSetup;
  1466.    end;
  1467.  
  1468.    TWABD_JS_Function_Placement = (jsfFirst,jsfLast);
  1469.    TWABD_JS_Function_Type = (jsOnEvent,
  1470.                              jsOnClick,jsOnDblClick,
  1471.                              jsOnChange,
  1472.                              jsOnFocus,jsOnBlur,
  1473.                              jsOnLoad,jsOnUnload,
  1474.                              jsOnSubmit,
  1475.                              jsOnMouseDown,jsOnMouseUp,jsOnMouseOver,jsOnMouseOut,jsOnMouseMove,
  1476.                              jsOnKeyPress,jsOnKeyDown,jsOnKeyUp);
  1477.    TWABD_JS_Function = class(TPersistent)
  1478.    protected
  1479.       FParams:TStringList;
  1480.       FScript:string;
  1481.       FPlacement:TWABD_JS_Function_Placement;
  1482.       FType:TWABD_JS_Function_Type;
  1483.       procedure SetScript(scr:string);
  1484.    public
  1485.       constructor Create(jsType:TWABD_JS_Function_Type);
  1486.       destructor Destroy; override;
  1487.    published
  1488.       property Params:TStringList read FParams write FParams;
  1489.       property Script:string read FScript write SetScript;
  1490.       property Placement:TWABD_JS_Function_Placement read FPlacement write FPlacement;
  1491.       property FunctionType:TWABD_JS_Function_Type read FType;
  1492.    end;
  1493.  
  1494.    TWABD_JS_Placement = (jsFirst,jsLast);
  1495.    TWABD_Javascript = class(TWABD_Object)
  1496.    protected
  1497.       FPlacement  : TWABD_JS_Placement;
  1498.       FLines      : TStrings;
  1499.       FSetup      : TWABD_Setup;
  1500.       FWSession   : TWABD_Session;
  1501.       procedure   SetLines(NewLines: TStrings);
  1502.       procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
  1503.    public
  1504.       constructor Create(AOwner: TComponent); override;
  1505.       destructor  Destroy; override;
  1506.       function    ProcessMacros(JS:string):string;
  1507.       property    Session: TWABD_Session read FWSession write FWSession;
  1508.    published
  1509.       property    Setup: TWABD_Setup read FSetup write FSetup;
  1510.       property    Placement:TWABD_JS_Placement read FPlacement write FPlacement;
  1511.       property    Lines:TStrings read FLines write FLines;
  1512.    end;
  1513.  
  1514.    TWABD_Autorefresh = class(TWABD_Object)
  1515.    private
  1516.       FInterval   : integer;
  1517.       FNewSession : boolean;
  1518.       FURL        : string;
  1519.    public
  1520.       function    Object_To_HTML: string; override;
  1521.       function    Object_To_WML: string; override;
  1522.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  1523.       procedure   HTML_To_Object(FormVal: string); override;
  1524.    published
  1525.       property    NewSession:boolean read FNewSession write FNewSession;
  1526.       property    Interval: integer read FInterval write FInterval;
  1527.       property    URL:string read FURL write FURL;
  1528.    end;
  1529.  
  1530.    TWABD_Expires = class(TWABD_Object)
  1531.    private
  1532.       FExpires    : TDatetime;
  1533.       FMaxAge     : integer;
  1534.       FAlwaysReload : boolean;
  1535.    public
  1536.       constructor Create(AOwner:TComponent); override;
  1537.       function    Object_To_HTML: string; override;
  1538.       function    Object_To_WML: string; override;
  1539.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  1540.       procedure   HTML_To_Object(FormVal: string); override;
  1541.    published
  1542.       property    Expires: TDatetime read FExpires write FExpires;
  1543.       property    MaxAge:integer read FMaxAge write FMaxAge;
  1544.       property    AlwaysReload: boolean read FAlwaysReload write FAlwaysReload;
  1545.    end;
  1546.  
  1547.  
  1548.    TWABDTableClick = procedure(Sender: TObject; RowIndex: integer) of object;
  1549.  
  1550.    TWABD_BaseTable = class(TWABD_FormSection_Base)
  1551.    protected
  1552.       FCellBorder : integer;
  1553.       FCellSpace  : integer;
  1554.       FCanClick   : boolean;
  1555.       FClickText  : string;
  1556.       FOnUserClick: TWABDTableClick;
  1557.    published
  1558.       constructor Create(AOwner: TComponent); override;
  1559.       property    CellBorder: integer read FCellBorder write FCellBorder;
  1560.       property    CellSpacing: integer read FCellSpace write FCellSpace;
  1561.       property    CanClick: boolean read FCanClick write FCanClick;
  1562.       property    ClickText: string read FClickText write FClickText;
  1563.       property    OnUserClick: TWABDTableClick read FOnUserClick write FOnUserClick;
  1564.    end;
  1565.  
  1566.  
  1567.    TStringArray = array[0..0] of PChar;
  1568.    PStringArray = ^TStringArray;
  1569.  
  1570.    TWABD_Table_Strings = class(TPersistent)
  1571.    protected
  1572.       XSize       : integer;
  1573.       YSize       : integer;
  1574.       FData       : PStringArray;
  1575.       function    GetString(x,y: integer): string;
  1576.       procedure   SetString(x,y: integer; NewString: string);
  1577.       procedure   DefineProperties(Filer: TFiler); override;
  1578.       procedure   WriteProps(Writer: TWriter);
  1579.       procedure   ReadProps(Reader: TReader);
  1580.       procedure   SetSize(x,y: integer);
  1581.       procedure   FreeData;
  1582.    public
  1583.       constructor Create;
  1584.       destructor  Destroy; override;
  1585.       procedure   Assign(Source: TPersistent); override;
  1586.       procedure   SafeSetSize(x,y: integer);
  1587.       property    Strings[x,y: integer]: string read GetString write SetString; default;
  1588.       property    Cols: integer read XSize;
  1589.       property    Rows: integer read YSize;
  1590.    end;
  1591.  
  1592.    TStringGridEx = class(TStringGrid)
  1593.    public
  1594.       ClickText   : string;
  1595.       CanClick    : boolean;
  1596.    end;
  1597.  
  1598.    TWABD_OnSetupJavascriptEvent = procedure(Sender:TWABD_Table; Row,Col:integer;
  1599.       var ID,OnMouseDown,OnMouseUp,OnMouseOver,OnMouseOut,OnClick,OnDblClick,OnKeyPress,OnKeyDown,OnKeyUp:string; var Target:TWABD_Base_Frame) of object;
  1600.    TWABD_OnRenderCellEvent = procedure(Sender: TWABD_Table; Row,Col:integer;
  1601.       var Text:string; var HAlign:TWABD_HorzAlignment; var VAlign:TWABD_VertAlignment; var Color,BGColor:TColor;
  1602.       var Size:integer; var Bold,Italic,Underline,Fixed,Strike:boolean;
  1603.       var Width,Height:integer; var AllowWordWrap:boolean) of object;
  1604.    TWABD_OnSetupClickableCellEvent = procedure(Sender:TWABD_Table; Row,Col:integer;
  1605.       var Clickable:boolean; var Target:TWABD_Base_Frame) of object;
  1606.  
  1607.    TWABD_OnUserClickCellEvent = procedure(Sender:TWABD_Object; Row,Col:integer) of object;
  1608.    TWABD_Table = class(TWABD_BaseTable)
  1609.    protected
  1610.       // CellData
  1611.       FFixCol     : integer;
  1612.       FFixRow     : integer;
  1613.       FStrings    : TWABD_Table_Strings;
  1614.       FColWid     : array[0..255] of integer;
  1615.       FColAlign   : array[0..255] of TWABD_HorzAlignment;
  1616.       FColWrap    : array[0..255] of boolean;
  1617.       FColClickable: array[0..255] of boolean;
  1618.       FRenderCell : TWABD_OnRenderCellEvent;
  1619.       FSetupClickableCell : TWABD_OnSetupClickableCellEvent;
  1620.       FSetupCellJavascript : TWABD_OnSetupJavascriptEvent;
  1621.       FSetupRowJavascript : TWABD_OnSetupJavascriptEvent;
  1622.       FUserClickCell  : TWABD_OnUserClickCellEvent;
  1623.       FBGColor    : TColor;
  1624.       FFontSize   : integer;
  1625.       FFontColor  : TColor;
  1626.       FWidth      : integer;
  1627.       FHeight     : integer;
  1628.       FShowEmptyRows : boolean;
  1629.       FOptimize   : boolean;
  1630.       FLiteral    : boolean;
  1631.       FSubmitTo   : TWABD_Base_Frame;
  1632.       FJS_OnUserKeyPress:TWABD_JS_Function;
  1633.       FJS_OnUserKeyDown:TWABD_JS_Function;
  1634.       FJS_OnUserKeyUp:TWABD_JS_Function;
  1635.       FJS_OnUserClick:TWABD_JS_Function;
  1636.       FJS_OnUserDblClick:TWABD_JS_Function;
  1637.       FJS_OnUserMouseMove:TWABD_JS_Function;
  1638.       FJS_OnUserMouseOver:TWABD_JS_Function;
  1639.       FJS_OnUserMouseOut:TWABD_JS_Function;
  1640.       FJS_OnUserMouseDown:TWABD_JS_Function;
  1641.       FJS_OnUserMouseUp:TWABD_JS_Function;
  1642.  
  1643.       procedure   SetStrings(NewStrings: TWABD_Table_Strings);
  1644.       function    GetBut(Row: integer): string;
  1645.       function    GetColWidth(i: integer): integer;
  1646.       procedure   SetColWidth(i: integer; v: integer);
  1647.       function    GetColAlign(i: integer): TWABD_HorzAlignment;
  1648.       procedure   SetColAlign(i: integer; v: TWABD_HorzAlignment);
  1649.       function    GetColWrap(i: integer): boolean;
  1650.       procedure   SetColWrap(i: integer; v: boolean);
  1651.       function    GetColClickable(i: integer): boolean;
  1652.       procedure   SetColClickable(i: integer; v: boolean);
  1653.    public
  1654.       constructor Create(AOwner: TComponent); override;
  1655.       destructor  Destroy; override;
  1656.       function    Object_To_HTML: string; override;
  1657.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  1658.       procedure   HTML_To_Object(FormVal: string); override;
  1659.       property    ColWidth[i: integer]: integer read GetColWidth write SetColWidth;
  1660.       property    ColAlign[i: integer]: TWABD_HorzAlignment read GetColAlign write SetColAlign;
  1661.       property    ColWrap[i: integer]: boolean read GetColWrap write SetColWrap;
  1662.       property    ColClickable[i: integer]: boolean read GetColClickable write SetColClickable;
  1663.    published
  1664.       property    FixedCols: integer read FFixCol write FFixCol;
  1665.       property    FixedRows: integer read FFixRow write FFixRow;
  1666.       property    FontSize: integer read FFontSize write FFontSize;
  1667.       property    FontColor: TColor read FFontColor write FFontColor;
  1668.       property    Cells: TWABD_Table_Strings read FStrings write SetStrings;
  1669.       property    OnRenderCell:TWABD_OnRenderCellEvent read FRenderCell write FRenderCell;
  1670.       property    OnSetupClickableCell:TWABD_OnSetupClickableCellEvent read FSetupClickableCell write FSetupClickableCell;
  1671.       property    OnSetupCellJavascript:TWABD_OnSetupJavascriptEvent read FSetupCellJavascript write FSetupCellJavascript;
  1672.       property    OnSetupRowJavascript:TWABD_OnSetupJavascriptEvent read FSetupRowJavascript write FSetupRowJavascript;
  1673.       property    OnUserClickCell:TWABD_OnUserClickCellEvent read FUserClickCell write FUserClickCell;
  1674.       property    Width: integer read FWidth write FWidth;
  1675.       property    Height: integer read FHeight write FHeight;
  1676.       property    ShowEmptyRows:boolean read FShowEmptyRows write FShowEmptyRows;
  1677.       property    BGColor:TColor read FBGColor write FBGColor;
  1678.       property    Optimize:boolean read FOptimize write FOptimize;
  1679.       property    Literal:boolean read FLiteral write FLiteral;
  1680.       property    SubmitToFrame: TWABD_Base_Frame read FSubmitTo write FSubmitTo;
  1681.       property    JS_OnUserKeyPress:TWABD_JS_Function read FJS_OnUserKeyPress write FJS_OnUserKeyPress;
  1682.       property    JS_OnUserKeyUp:TWABD_JS_Function read FJS_OnUserKeyUp write FJS_OnUserKeyUp;
  1683.       property    JS_OnUserKeyDown:TWABD_JS_Function read FJS_OnUserKeyDown write FJS_OnUserKeyDown;
  1684.       property    JS_OnUserClick:TWABD_JS_Function read FJS_OnUserClick write FJS_OnUserClick;
  1685.       property    JS_OnUserDblClick:TWABD_JS_Function read FJS_OnUserDblClick write FJS_OnUserDblClick;
  1686.       property    JS_OnUserMouseMove:TWABD_JS_Function read FJS_OnUserMouseMove write FJS_OnUserMouseMove;
  1687.       property    JS_OnUserMouseOver:TWABD_JS_Function read FJS_OnUserMouseOver write FJS_OnUserMouseOver;
  1688.       property    JS_OnUserMouseOut:TWABD_JS_Function read FJS_OnUserMouseOut write FJS_OnUserMouseOut;
  1689.       property    JS_OnUserMouseDown:TWABD_JS_Function read FJS_OnUserMouseDown write FJS_OnUserMouseDown;
  1690.       property    JS_OnUserMouseUp:TWABD_JS_Function read FJS_OnUserMouseUp write FJS_OnUserMouseUp;
  1691.    end;
  1692.  
  1693.    TWABD_DataTable = class;
  1694.    TRecClickEvent = procedure(Sender: TWABD_DataTable; RowIndex: integer; var MoveToRecord: boolean) of object;
  1695.  
  1696.    TWABD_DataLink = class(TDataLink)
  1697.    private
  1698.       FOnActiveChanged:TNotifyEvent;
  1699.       FOnDatasetChanged:TNotifyEvent;
  1700.    protected
  1701.       procedure DatasetChanged; override;
  1702.       procedure ActiveChanged; override;
  1703.    published
  1704.       property OnActiveChanged:TNotifyEvent read FOnActiveChanged write FOnActiveChanged;
  1705.       property OnDatasetChanged:TNotifyEvent read FOnDatasetChanged write FOnDatasetChanged;
  1706.    end;
  1707.  
  1708.    TWABD_DataTable = class(TWABD_FormSection_Base)
  1709.    protected
  1710.       FDataLink   : TWABD_DataLink;
  1711.       FFormSec    : TWABD_FormSection;
  1712.       FNavForm    : TWABD_FormSection;
  1713.       FTable      : TWABD_Table;
  1714.       FShowForm   : boolean;
  1715.       FShowTable  : boolean;
  1716.       FNavButs    : boolean;
  1717.       FMaxRows    : integer;
  1718.       FColWidth   : integer;
  1719.       FNumCol     : integer;
  1720.       FAutoWid    : boolean;
  1721.       FRecClick   : TRecClickEvent;
  1722.       FReadOnly   : boolean;
  1723.       FCanSelectRecord:boolean;
  1724.       FCalcPages  : boolean;
  1725.       FRecordCount: longint;
  1726.       FActiveRec  : longint;
  1727.       FBGColor    : TColor;
  1728.       FFontSize   : integer;
  1729.       FFontColor  : TColor;
  1730.       Stat        : string;
  1731.       DidAppend   : boolean;
  1732.       procedure   InitForm;
  1733.       procedure   InitTable;
  1734.       procedure   InitNavButs;
  1735.       procedure   CreateNavBut(x, y : integer; ButCap: string; OnUserClick: TNotifyEvent);
  1736.       procedure   FirstClick(Sender: TObject);
  1737.       procedure   LastClick(Sender: TObject);
  1738.       procedure   NextClick(Sender: TObject);
  1739.       procedure   PrevClick(Sender: TObject);
  1740.       procedure   NextPgClick(Sender: TObject);
  1741.       procedure   PrevPgClick(Sender: TObject);
  1742.       procedure   AddClick(Sender: TObject);
  1743.       procedure   EditClick(Sender: TObject);
  1744.       procedure   DeleteClick(Sender: TObject);
  1745.       function    GetDataSource: TDataSource;
  1746.       procedure   SetDataSource(NewDataSource: TDataSource);
  1747.       procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
  1748.       procedure   SetName(const NewName: TComponentName); override;
  1749.       procedure   TableClick(Sender: TObject; RowIndex: integer);
  1750.       function    GetRenderCell:TWABD_OnRenderCellEvent;
  1751.       procedure   SetRenderCell(Event:TWABD_OnRenderCellEvent);
  1752.       function    GetUserClickCell:TWABD_OnUserClickCellEvent;
  1753.       procedure   SetUserClickCell(Event:TWABD_OnUserClickCellEvent);
  1754.       function    GetSetupClickableCell:TWABD_OnSetupClickableCellEvent;
  1755.       procedure   SetSetupClickableCell(Event:TWABD_OnSetupClickableCellEvent);
  1756.       function    GetSetupCellJavascript:TWABD_OnSetupJavascriptEvent;
  1757.       procedure   SetSetupCellJavascript(Event:TWABD_OnSetupJavascriptEvent);
  1758.       function    GetSetupRowJavascript:TWABD_OnSetupJavascriptEvent;
  1759.       procedure   SetSetupRowJavascript(Event:TWABD_OnSetupJavascriptEvent);
  1760.       function    GetLiteral:boolean;
  1761.       procedure   SetLiteral(Value:boolean);
  1762.       function    GetPage:integer;
  1763.       function    GetNumPages:integer;
  1764.       procedure   RecountRecords(Sender:TObject);
  1765.       function    GetCellBorder:integer;
  1766.       function    GetCellSpacing:integer;
  1767.       procedure   SetCellBorder(i:integer);
  1768.       procedure   SetCellSpacing(i:integer);
  1769.       function    GetWidth:integer;
  1770.       procedure   SetWidth(w:integer);
  1771.       function    GetShowEmptyRows:boolean;
  1772.       procedure   SetShowEmptyRows(s:boolean);
  1773.       function    GetBGColor:TColor;
  1774.       procedure   SetBGColor(c:TColor);
  1775.       function    GetOptimize:boolean;
  1776.       procedure   SetOptimize(o:boolean);
  1777.       function    GetFontColor:TColor;
  1778.       procedure   SetFontColor(c:TColor);
  1779.       function    GetFontSize:integer;
  1780.       procedure   SetFontSize(sz:integer);
  1781.       function    GetSubmitTo:TWABD_Base_Frame;
  1782.       procedure   SetSubmitTo(fr:TWABD_Base_Frame);
  1783.       function    GetJSOnUserKeyPress:TWABD_JS_Function;
  1784.       procedure   SetJSOnUserKeyPress(Value:TWABD_JS_Function);
  1785.       function    GetJSOnUserKeyDown:TWABD_JS_Function;
  1786.       procedure   SetJSOnUserKeyDown(Value:TWABD_JS_Function);
  1787.       function    GetJSOnUserKeyUp:TWABD_JS_Function;
  1788.       procedure   SetJSOnUserKeyUp(Value:TWABD_JS_Function);
  1789.       function    GetJSOnUserClick:TWABD_JS_Function;
  1790.       procedure   SetJSOnUserClick(Value:TWABD_JS_Function);
  1791.       function    GetJSOnUserDblClick:TWABD_JS_Function;
  1792.       procedure   SetJSOnUserDblClick(Value:TWABD_JS_Function);
  1793.       function    GetJSOnUserMouseOver:TWABD_JS_Function;
  1794.       procedure   SetJSOnUserMouseOver(Value:TWABD_JS_Function);
  1795.       function    GetJSOnUserMouseDown:TWABD_JS_Function;
  1796.       procedure   SetJSOnUserMouseDown(Value:TWABD_JS_Function);
  1797.       function    GetJSOnUserMouseMove:TWABD_JS_Function;
  1798.       procedure   SetJSOnUserMouseMove(Value:TWABD_JS_Function);
  1799.       function    GetJSOnUserMouseUp:TWABD_JS_Function;
  1800.       procedure   SetJSOnUserMouseUp(Value:TWABD_JS_Function);
  1801.       function    GetJSOnUserMouseOut:TWABD_JS_Function;
  1802.       procedure   SetJSOnUserMouseOut(Value:TWABD_JS_Function);
  1803.    public
  1804.       constructor Create(AOwner: TComponent); override;
  1805.       destructor  Destroy; override;
  1806.       procedure   JumpToTableRecord(RowIndex: integer);
  1807.       function    Object_To_HTML: string; override;
  1808.       procedure   HTML_To_Object(FormVal: string); override;
  1809.       property    FormSection: TWABD_FormSection read FFormSec;
  1810.       property    NavSection: TWABD_FormSection read FNavForm;
  1811.       property    Table: TWABD_Table read FTable;
  1812.       procedure   NextPage;
  1813.       procedure   PrevPage;
  1814.       procedure   LastPage;
  1815.       procedure   FirstPage;
  1816.    published
  1817.       property    FontSize: integer read GetFontSize write SetFontSize;
  1818.       property    FontColor: TColor read GetFontColor write SetFontColor;
  1819.       property    DataSource: TDataSource read GetDataSource write SetDataSource;
  1820.       property    ShowEditForm: boolean read FShowForm write FShowForm;
  1821.       property    ShowTable: boolean read FShowTable write FShowTable;
  1822.       property    ShowNavButs: boolean read FNavButs write FNavButs;
  1823.       property    MaxRows: integer read FMaxRows write FMaxRows;
  1824.       property    FormColWidth: integer read FColWidth write FColWidth;
  1825.       property    NumCols: integer read FNumCol write FNumCol;
  1826.       property    AutoWidth: boolean read FAutoWid write FAutoWid default True;
  1827.       property    ReadOnly: boolean read FReadOnly write FReadOnly;
  1828.       property    ShowRecordButton: boolean read FCanSelectRecord write FCanSelectRecord;
  1829.       property    OnRecordClick: TRecClickEvent read FRecClick write FRecClick;
  1830.       property    OnRenderCell: TWABD_OnRenderCellEvent read GetRenderCell write SetRenderCell;
  1831.       property    OnUserClickCell: TWABD_OnUserClickCellEvent read GetUserClickCell write SetUserClickCell;
  1832.       property    OnSetupClickableCell: TWABD_OnSetupClickableCellEvent read GetSetupClickableCell write SetSetupClickableCell;
  1833.       property    OnSetupCellJavascript: TWABD_OnSetupJavascriptEvent read GetSetupCellJavascript write SetSetupCellJavascript;
  1834.       property    OnSetupRowJavascript: TWABD_OnSetupJavascriptEvent read GetSetupRowJavascript write SetSetupRowJavascript;
  1835.       property    Page:integer read GetPage;
  1836.       property    NumPages:integer read GetNumPages;
  1837.       property    CalcPages:boolean read FCalcPages write FCalcPages;
  1838.       property    Literal:boolean read GetLiteral write SetLiteral;
  1839.       property    CellBorder:integer read GetCellBorder write SetCellBorder;
  1840.       property    CellSpacing:integer read GetCellSpacing write SetCellSpacing;
  1841.       property    Width: integer read GetWidth write SetWidth;
  1842.       property    ShowEmptyRows: boolean read GetShowEmptyRows write SetShowEmptyRows;
  1843.       property    BGColor:TColor read GetBGColor write SetBGColor;
  1844.       property    Optimize:boolean read GetOptimize write SetOptimize;
  1845.       property    SubmitToFrame: TWABD_Base_Frame read GetSubmitTo write SetSubmitTo;
  1846.       property    JS_OnUserKeyPress:TWABD_JS_Function read GetJSOnUserKeyPress write SetJSOnUserKeyPress;
  1847.       property    JS_OnUserKeyUp:TWABD_JS_Function read GetJSOnUserKeyUp write SetJSOnUserKeyUp;
  1848.       property    JS_OnUserKeyDown:TWABD_JS_Function read GetJSOnUserKeyDown write SetJSOnUserKeyDown;
  1849.       property    JS_OnUserClick:TWABD_JS_Function read GetJSOnUserClick write SetJSOnUserClick;
  1850.       property    JS_OnUserDblClick:TWABD_JS_Function read GetJSOnUserDblClick write SetJSOnUserDblClick;
  1851.       property    JS_OnUserMouseMove:TWABD_JS_Function read GetJSOnUserMouseMove write SetJSOnUserMouseMove;
  1852.       property    JS_OnUserMouseOver:TWABD_JS_Function read GetJSOnUserMouseOver write SetJSOnUserMouseOver;
  1853.       property    JS_OnUserMouseOut:TWABD_JS_Function read GetJSOnUserMouseOut write SetJSOnUserMouseOut;
  1854.       property    JS_OnUserMouseDown:TWABD_JS_Function read GetJSOnUserMouseDown write SetJSOnUserMouseDown;
  1855.       property    JS_OnUserMouseUp:TWABD_JS_Function read GetJSOnUserMouseUp write SetJSOnUserMouseUp;
  1856.    end;
  1857.  
  1858.  
  1859.    TWABD_Hidden = class(TWABD_Object)
  1860.    protected
  1861.       FValue      : string;
  1862.    public
  1863.       function    Object_To_HTML: string; override;
  1864.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  1865.       procedure   HTML_To_Object(FormVal: string); override;
  1866.    published
  1867.       property    Value: string read FValue write FValue;
  1868.    end;
  1869.  
  1870.  
  1871.    TWABD_BlankLines = class(TWABD_FormSection_Base)
  1872.    protected
  1873.       FNumLines   : integer;
  1874.    public
  1875.       constructor Create(AOwner: TComponent); override;
  1876.       function    Object_To_HTML: string; override;
  1877.       function    Object_To_WML: string; override;
  1878.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  1879.       procedure   HTML_To_Object(FormVal: string); override;
  1880.    published
  1881.       property    NumLines: integer read FNumLines write FNumLines;
  1882.    end;
  1883.  
  1884.  
  1885.    // ************************************************************************
  1886.    // "Form" Level objects (Buttons, Labels, Edit boxes, etc)
  1887.  
  1888.    TWABD_SectionObject = class(TWABD_Object)
  1889.    private
  1890.       Row, Col    : integer;  // Used by FormSection_Grid's AutoSizeRowCol function
  1891.       OrigLeft    : integer;
  1892.       OrigTop     : integer;
  1893.    protected
  1894.       FVertAlign  : TWABD_VertAlignment;
  1895.       FHorzAlign  : TWABD_HorzAlignment;
  1896.       FLeftPos    : integer;  // Table start Pos (Left, Top)
  1897.       FTopPos     : integer;
  1898.       FWidth      : integer;  // Table Span Col & Row (Width, Height)
  1899.       FHeight     : integer;
  1900.       FColSpan    : integer;  // if -1, uses Width/GridX for ColSpan, else this number
  1901.       FRowSpan    : integer;
  1902.       FTabIndex   : integer;
  1903.       FDisabled   : boolean;
  1904.       FNoWrap     : boolean;
  1905.       FAccessKey  : string;
  1906.       FTitle      : string;
  1907.  
  1908.       procedure   SetLeft(NewLeft: integer);
  1909.       procedure   SetTop(NewTop: integer);
  1910.       function    GenerateOptionHTML:string;
  1911.       property    TabIndex: integer read FTabIndex write FTabIndex;
  1912.       property    Disabled: boolean read FDisabled write FDisabled default false;
  1913.       property    AccessKey: string read FAccessKey write FAccessKey;
  1914.       property    Title: string read FTitle write FTitle;
  1915.    published
  1916.       constructor Create(AOwner: TComponent); override;
  1917.       destructor  Destroy; override;
  1918.       property    VertAlign:TWABD_VertAlignment read FVertAlign write FVertAlign;
  1919.       property    HorzAlign:TWABD_HorzAlignment read FHorzAlign write FHorzAlign;
  1920.       property    LeftPos: integer read FLeftPos write SetLeft;
  1921.       property    TopPos: integer read FTopPos write SetTop;
  1922.       property    ColSpan: integer read FColSpan write FColSpan default -1;
  1923.       property    RowSpan: integer read FRowSpan write FRowSpan default -1;
  1924.       property    Width: integer read FWidth write FWidth;
  1925.       property    Height: integer read FHeight write FHeight;
  1926.       property    NoWrap:boolean read FNoWrap write FNoWrap;
  1927.    end;
  1928.  
  1929.    TWABD_BaseEventSectionObject = class(TWABD_SectionObject)
  1930.    protected
  1931.       FOnUserChange: TNotifyEvent;
  1932.       FOnUserClick: TNotifyEvent;
  1933.       FOnUserGotFocus: TNotifyEvent;
  1934.       FOnUserLostFocus: TNotifyEvent;
  1935.  
  1936.       FJS_OnUserClick:TWABD_JS_Function;
  1937.       FJS_OnUserGotFocus:TWABD_JS_Function;
  1938.       FJS_OnUserLostFocus:TWABD_JS_Function;
  1939.       FJS_OnUserDblClick:TWABD_JS_Function;
  1940.       FJS_OnUserMouseMove:TWABD_JS_Function;
  1941.       FJS_OnUserMouseOver:TWABD_JS_Function;
  1942.       FJS_OnUserMouseOut:TWABD_JS_Function;
  1943.       FJS_OnUserMouseDown:TWABD_JS_Function;
  1944.       FJS_OnUserMouseUp:TWABD_JS_Function;
  1945.       FJS_OnUserKeyPress:TWABD_JS_Function;
  1946.       FJS_OnUserKeyDown:TWABD_JS_Function;
  1947.       FJS_OnUserKeyUp:TWABD_JS_Function;
  1948.       FJS_OnUserChange:TWABD_JS_Function;
  1949.  
  1950.       property    JS_OnUserChange:TWABD_JS_Function read FJS_OnUserChange write FJS_OnUserChange;
  1951.       property    OnUserChange: TNotifyEvent read FOnUserChange write FOnUserChange;
  1952.    public
  1953.       constructor Create(AOwner: TComponent); override;
  1954.       destructor  Destroy; override;
  1955.       function    GenerateEventScript:string;
  1956.    published
  1957.       property    JS_OnUserGotFocus:TWABD_JS_Function read FJS_OnUserGotFocus write FJS_OnUserGotFocus;
  1958.       property    JS_OnUserLostFocus:TWABD_JS_Function read FJS_OnUserLostFocus write FJS_OnUserLostFocus;
  1959.       property    JS_OnUserClick:TWABD_JS_Function read FJS_OnUserClick write FJS_OnUserClick;
  1960.       property    JS_OnUserDblClick:TWABD_JS_Function read FJS_OnUserDblClick write FJS_OnUserDblClick;
  1961.       property    JS_OnUserMouseMove:TWABD_JS_Function read FJS_OnUserMouseMove write FJS_OnUserMouseMove;
  1962.       property    JS_OnUserMouseOver:TWABD_JS_Function read FJS_OnUserMouseOver write FJS_OnUserMouseOver;
  1963.       property    JS_OnUserMouseOut:TWABD_JS_Function read FJS_OnUserMouseOut write FJS_OnUserMouseOut;
  1964.       property    JS_OnUserMouseDown:TWABD_JS_Function read FJS_OnUserMouseDown write FJS_OnUserMouseDown;
  1965.       property    JS_OnUserMouseUp:TWABD_JS_Function read FJS_OnUserMouseUp write FJS_OnUserMouseUp;
  1966.       property    JS_OnUserKeyPress:TWABD_JS_Function read FJS_OnUserKeyPress write FJS_OnUserKeyPress;
  1967.       property    JS_OnUserKeyDown:TWABD_JS_Function read FJS_OnUserKeyDown write FJS_OnUserKeyDown;
  1968.       property    JS_OnUserKeyUp:TWABD_JS_Function read FJS_OnUserKeyUp write FJS_OnUserKeyUp;
  1969.  
  1970.       property    OnUserClick: TNotifyEvent read FOnUserClick write FOnUserClick;
  1971.       property    OnUserGotFocus: TNotifyEvent read FOnUserGotFocus write FOnUserGotFocus;
  1972.       property    OnUserLostFocus: TNotifyEvent read FOnUserLostFocus write FOnUserLostFocus;
  1973.    end;
  1974.  
  1975.    TWABD_HTMLEmbed = class(TWABD_SectionObject)
  1976.    protected
  1977.       FHTML       : TStrings;
  1978.       procedure   SetHTML(NewHTML:TStrings);
  1979.       procedure   SetName(const Value: TComponentName); override;
  1980.       procedure   SetWidth(w:integer);
  1981.       procedure   SetHeight(h:integer);
  1982.       function    GetWidth:integer;
  1983.       function    GetHeight:integer;
  1984.    public
  1985.       constructor Create(AOwner: TComponent); override;
  1986.       destructor  Destroy; override;
  1987.       function    Object_To_HTML: string; override;
  1988.       function    Object_To_WML: string; override;
  1989.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  1990.       procedure   HTML_To_Object(FormVal: string); override;
  1991.    published
  1992.       property    HTML: TStrings read FHTML write SetHTML;
  1993.       property    Width: integer read GetWidth write SetWidth;
  1994.       property    Height: integer read GetHeight write SetHeight;
  1995.    end;
  1996.  
  1997.    TWABD_HTMLFileEmbed = class(TWABD_HTMLEmbed)
  1998.    protected
  1999.       FFileName         : TFileName;
  2000.       FSetup            : TWABD_Setup;
  2001.       FLoadedWhen       : TDateTime;
  2002.       FSecsBeforeReload : integer;
  2003.       FCached           : boolean;
  2004.       procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
  2005.    public
  2006.       procedure   Reload;
  2007.       property    LoadedWhen:TDateTime read FLoadedWhen;
  2008.       constructor Create(AOwner: TComponent); override;
  2009.       destructor  Destroy; override;
  2010.       function    Object_To_HTML: string; override;
  2011.       function    Object_To_WML: string; override;
  2012.    published
  2013.       property    FileName:TFileName read FFileName write FFileName;
  2014.       property    SecsBeforeReload:integer read FSecsBeforeReload write FSecsBeforeReload;
  2015.       property    Cached:boolean read FCached write FCached;
  2016.       property    Setup:TWABD_Setup read FSetup write FSetup;
  2017.    end;
  2018.  
  2019.    TWABD_LinesObject = class(TWABD_BaseEventSectionObject)
  2020.    protected
  2021.       FLines      : TStringList;
  2022.       procedure   SetLines(NewLines: TStringList);
  2023.       procedure   SetName(const Value: TComponentName); override;
  2024.    public
  2025.       constructor Create(AOwner: TComponent); override;
  2026.       destructor  Destroy; override;
  2027.    published
  2028.       property    Lines: TStringList read FLines write SetLines;
  2029.       property    JS_OnUserChange;
  2030.       property    OnUserChange;
  2031.    end;
  2032.  
  2033.    TWABD_SelLinesObject = class(TWABD_LinesObject)
  2034.    protected
  2035.       FSelList    : TList;
  2036.       FOldSelList : TList;
  2037.       FAutoButton : boolean;
  2038.       FButton     : TWABD_Object;
  2039.       FOnChange   : TNotifyEvent;
  2040.       procedure   SetListSelected(AList:TList; Index:integer; Value:boolean);
  2041.       function    GetListSelected(AList:TList; Index:integer):boolean;
  2042.       procedure   SetSelected(Index:integer; Value:boolean);
  2043.       function    GetSelected(Index:integer):boolean;
  2044.       procedure   SetOldSelected(Index:integer; Value:boolean);
  2045.       function    GetOldSelected(Index:integer):boolean;
  2046.       procedure   ClearListSelected(AList:TList);
  2047.       procedure   CopyListSelected(Src,Dst:TList);
  2048.       function    EqualListSelected(AList1,AList2:TList):boolean;
  2049.       function    GetText(Index:integer):string;
  2050.       function    GetDesc(Index:integer):string;
  2051.       function    GetSelText:string;
  2052.       procedure   SetSelText(s:string);
  2053.       function    GetSelDesc:string;
  2054.       function    GetOldSelText:string;
  2055.       function    GetOldSelDesc:string;
  2056.       procedure   SetSelIndex(i:integer);
  2057.       function    GetSelIndex:integer;
  2058.       procedure   SetOldSelIndex(i:integer);
  2059.       function    GetOldSelIndex:integer;
  2060.       procedure   OnChangeHandler(Sender:TObject);
  2061.       function    GetChanged:boolean;
  2062.  
  2063.       property    OldText : string read GetOldSelText;
  2064.       property    OldDesc : string read GetOldSelDesc;
  2065.       property    Text : string read GetSelText write SetSelText;
  2066.       property    Desc : string read GetSelDesc;
  2067.       property    Texts[Index:integer]:string read GetText;
  2068.       property    Descs[Index:integer]:string read GetDesc;
  2069.       property    Selected[Index:integer] : boolean read GetSelected write SetSelected;
  2070.       property    OldSelected[Index:integer] : boolean read GetOldSelected write SetOldSelected;
  2071.       property    SelIndex:integer read GetSelIndex write SetSelIndex;
  2072.       property    OldSelIndex:integer read GetOldSelIndex write SetOldSelIndex;
  2073.       property    Button:TWABD_Object read FButton write FButton;
  2074.       property    SelectionChanged:boolean read GetChanged;
  2075.    public
  2076.       constructor Create(AOwner: TComponent); override;
  2077.       destructor  Destroy; override;
  2078.       procedure   Clear;
  2079.    published
  2080.       property AutoButton:boolean read FAutoButton write FAutoButton default true;
  2081.       property OnChange:TNotifyEvent read FOnChange write FOnChange;
  2082.    end;
  2083.  
  2084.    TWABD_Anchor = class(TWABD_BaseEventSectionObject)
  2085.    protected
  2086.       FDest       : string;
  2087.       FCaption    : string;
  2088.       FBold       : boolean;
  2089.       FItalic     : boolean;
  2090.       FUnderline  : boolean;
  2091.       FSubmitTo   : TWABD_Base_Frame;
  2092.       procedure   SetName(const Value: TComponentName); override;
  2093.       procedure   SetCaption(NewCaption: string);
  2094.       procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
  2095.    public
  2096.       constructor Create(AOwner: TComponent); override;
  2097.       function    Object_To_HTML: string; override;
  2098.       function    Object_To_WML: string; override;
  2099.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  2100.       procedure   HTML_To_Object(FormVal: string); override;
  2101.    published
  2102.       property    Caption: string read FCaption write SetCaption;
  2103.       property    Destination: string read FDest write FDest;
  2104.       property    Bold: boolean read FBold write FBold;
  2105.       property    Italic: boolean read FItalic write FItalic;
  2106.       property    Underline: boolean read FUnderline write FUnderline;
  2107.       property    SubmitToFrame: TWABD_Base_Frame read FSubmitTo write FSubmitTo;
  2108.    end;
  2109.  
  2110.    TWABD_Autoload = class(TWABD_Object)
  2111.    protected
  2112.       FForm       : TWABD_Form;
  2113.       FFrameset   : TWABD_Frameset;
  2114.       FDelay      : integer;
  2115.       FMenubar    : boolean;
  2116.       FToolbar    : boolean;
  2117.       FReplace    : boolean;
  2118.       FScrollbars : boolean;
  2119.       FStatusbar  : boolean;
  2120.       FTitlebar   : boolean;
  2121.       FResizable  : boolean;
  2122.       FLocationbar: boolean;
  2123.  
  2124.       procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
  2125.    public
  2126.       constructor Create(AOwner: TComponent); override;
  2127.       function    Object_To_HTML: string; override;
  2128.       function    Object_To_WML: string; override;
  2129.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  2130.       procedure   HTML_To_Object(FormVal: string); override;
  2131.    published
  2132.       property    Form:TWABD_Form read FForm write FForm;
  2133.       property    Frameset:TWABD_Frameset read FFrameset write FFrameset;
  2134.       property    Delay:integer read FDelay write FDelay;
  2135.       property    Menubar:boolean read FMenubar write FMenubar default true;
  2136.       property    Toolbar:boolean read FToolbar write FToolbar default true;
  2137.       property    Replace:boolean read FReplace write FReplace default false;
  2138.       property    Scrollbars:boolean read FScrollbars write FScrollbars default true;
  2139.       property    Statusbar:boolean read FStatusbar write FStatusbar default true;
  2140.       property    Titlebar:boolean read FTitlebar write FTitlebar default true;
  2141.       property    Resizable:boolean read FResizable write FResizable default true;
  2142.       property    Locationbar:boolean read FLocationbar write FLocationbar default true;
  2143.    end;
  2144.  
  2145.  
  2146.    TWABD_MouseDown = procedure(Sender: TObject; X, Y: integer) of object;
  2147.  
  2148.    TWABD_HotSpot = class(TWABD_Object)
  2149.    protected
  2150.       FAbout      : TWABDAbout;
  2151.       FX1         : integer;
  2152.       FY1         : integer;
  2153.       FX2         : integer;
  2154.       FY2         : integer;
  2155.       FImParent   : TWABD_Base_Image;
  2156.       FChange     : TNotifyEvent;
  2157.       FOnUserClick: TNotifyEvent;
  2158.       procedure   SetX1(i: integer);
  2159.       procedure   SetY1(i: integer);
  2160.       procedure   SetX2(i: integer);
  2161.       procedure   SetY2(i: integer);
  2162.       procedure   SetName(const Value: TComponentName); override;
  2163.       procedure   Changed; virtual;
  2164.    public
  2165.       destructor  Destroy; override;
  2166.       property    OnChange: TNotifyEvent read FChange write FChange;
  2167.    published
  2168.       property    X1: integer read FX1 write SetX1;
  2169.       property    Y1: integer read FY1 write SetY1;
  2170.       property    X2: integer read FX2 write SetX2;
  2171.       property    Y2: integer read FY2 write SetY2;
  2172.       property    ImageParent: TWABD_Base_Image read FImParent write FImParent;
  2173.       property    About: TWABDAbout read FAbout write FAbout;
  2174.       property    OnUserClick:TNotifyEvent read FOnUserClick write FOnUserClick;
  2175.    end;
  2176.  
  2177.    TWABD_HotSpots = class(TPersistent)
  2178.    public
  2179.       ParImage    : TWABD_Base_Image;
  2180.    end;
  2181.  
  2182.    TWABD_Base_Image = class(TWABD_BaseEventSectionObject)
  2183.    protected
  2184.       FAltText    : string;
  2185.       FAutoSize   : boolean;
  2186.       FMouseDown  : TWABD_MouseDown;
  2187.       FHotSpots   : TWABD_HotSpots;
  2188.       FImgWidth   : integer;
  2189.       FImgHeight  : integer;
  2190.       FImageFile  : TFileName;
  2191.       FClickable  : boolean;
  2192.       FSubmitTo   : TWABD_Base_Frame;
  2193.       FDest       : string;
  2194.       FSetup      : TWABD_Setup;
  2195.  
  2196.       procedure   SetName(const Value: TComponentName); override;
  2197.       procedure   UpdateImageSize;
  2198.       procedure   SetImgWidth(w: integer); virtual;
  2199.       procedure   SetImgHeight(h: integer); virtual;
  2200.       procedure   MouseDown(x, y: integer); virtual;
  2201.       procedure   SetHotSpots(HS: TWABD_HotSpots);
  2202.       procedure   SetImageFile(filename:TFileName);
  2203.       procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
  2204.    public
  2205.       constructor Create(AOwner: TComponent); override;
  2206.       destructor  Destroy; override;
  2207.       function    Object_To_HTML: string; override;
  2208.       function    Object_To_WML: string; override;
  2209.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  2210.       procedure   HTML_To_Object(FormVal: string); override;
  2211.       property    ImageFile:TFileName read FImageFile write SetImageFile;
  2212.       procedure   UpdateImage; virtual;
  2213.       function    LocalImagePath:string;
  2214.       function    ImagePath:string;
  2215.    published
  2216.       property    AutoSize:boolean read FAutoSize write FAutoSize;
  2217.       property    Clickable: boolean read FClickable write FClickable;
  2218.       property    AltText: string read FAltText write FAltText;
  2219.       property    OnMouseDown: TWABD_MouseDown read FMouseDown write FMouseDown;
  2220.       property    ImageWidth: integer read FImgWidth write SetImgWidth;
  2221.       property    ImageHeight: integer read FImgHeight write SetImgHeight;
  2222.       property    HotSpots: TWABD_HotSpots read FHotSpots write SetHotSpots;
  2223.       property    SubmitToFrame: TWABD_Base_Frame read FSubmitTo write FSubmitTo;
  2224.       property    Setup: TWABD_Setup read FSetup write FSetup;
  2225.       property    Destination:string read FDest write FDest;
  2226.       property    OnUserClick;
  2227.       property    Title;
  2228.    end;
  2229.  
  2230.    TWABD_Image = class(TWABD_Base_Image)
  2231.    published
  2232.       property    ImageFile;
  2233.    end;
  2234.  
  2235.    TLiveImageType = (liAuto, liBMP, liJPEG, liGIF, liWBMP);
  2236.  
  2237.    TWABD_LiveImage = class(TWABD_Base_Image)
  2238.    protected
  2239.       FSafeBmp    : TBitmap;
  2240.       FDirty      : boolean;
  2241.       FFileName   : string;
  2242.       WroteFile   : boolean;
  2243.       FImgType    : TLiveImageType;
  2244.       FInterlaced : boolean;
  2245.       procedure   SetImgWidth(w: integer); override;
  2246.       procedure   SetImgHeight(h: integer); override;
  2247.       function    GetSafeBitmap: TBitmap;
  2248.       function    GetCanvas: TCanvas;
  2249.       procedure   Loaded; override;
  2250.       function    GetFileName: string;
  2251.       function    DetermineImageType:TLiveImageType;
  2252.       function    GetNewName: string;
  2253.       function    GetTransColor:TColor;
  2254.       function    GetTransMode:TTransparentMode;
  2255.       function    GetPixelFormat:TPixelFormat;
  2256.       procedure   SetTransColor(color:TColor);
  2257.       procedure   SetTransMode(mode:TTransparentMode);
  2258.       procedure   SetPixelFormat(pf:TPixelFormat);
  2259.    public
  2260.       constructor Create(AOwner: TComponent); override;
  2261.       destructor  Destroy; override;
  2262.       function    Object_To_HTML: string; override;
  2263.       function    Object_To_WML: string; override;
  2264.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  2265.       property    SafeBitmap: TBitmap read GetSafeBitmap;
  2266.       property    Dirty: boolean read FDirty;
  2267.       property    Canvas: TCanvas read GetCanvas;
  2268.       property    FileName: string read GetFileName;
  2269.       procedure   UpdateImage; override;
  2270.    published
  2271.       property    ImageType: TLiveImageType read FImgType write FImgType default liGIF;
  2272.       property    TransparentColor:TColor read GetTransColor write SetTransColor;
  2273.       property    TransparentMode:TTransparentMode read GetTransMode write SetTransMode;
  2274.       property    Interlaced:boolean read FInterlaced write FInterlaced;
  2275.       property    PixelFormat:TPixelFormat read GetPixelFormat write SetPixelFormat;
  2276.    end;
  2277.  
  2278.    TWABD_Chart     = class(TWABD_LiveImage)
  2279.    protected
  2280.       FChart      : TCustomChart;
  2281.       FOnChartPointClick : TWABD_OnChartPointClick;
  2282.       procedure   Loaded; override;
  2283.       procedure   SetChart(Chart: TCustomChart);
  2284.       procedure   MouseDown(x, y: integer); override;
  2285.       procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
  2286.    public
  2287.       constructor Create(AOwner: TComponent); override;
  2288.       destructor  Destroy; override;
  2289.       function    Object_To_HTML: string; override;
  2290.       function    Object_To_WML: string; override;
  2291.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  2292.       procedure   HTML_To_Object(FormVal: string); override;
  2293.    published
  2294.       property    Chart : TCustomChart read FChart write SetChart;
  2295.       property    OnChartPointClick: TWABD_OnChartPointClick read FOnChartPointClick write FOnChartPointClick;
  2296.    end;
  2297.  
  2298.    TWABD_Label = class(TWABD_BaseEventSectionObject)
  2299.    protected
  2300.       FCaption    : string;
  2301.       FBold       : boolean;
  2302.       FItalic     : boolean;
  2303.       FUnderline  : boolean;
  2304.       FFontColor  : TColor;
  2305.       FFontSize   : integer;
  2306.       FCanClick   : boolean;
  2307.       FSubmitTo   : TWABD_Base_Frame;
  2308.       procedure   SetName(const Value: TComponentName); override;
  2309.       procedure   SetCaption(NewCaption: string);
  2310.       procedure   SetFontSize(NewSize: integer);
  2311.       procedure   UpdateWidHgt;
  2312.       procedure   SetBold(NewBold: boolean);
  2313.       procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
  2314.    public
  2315.       constructor Create(AOwner: TComponent); override;
  2316.       destructor  Destroy; override;
  2317.       function    Object_To_HTML: string; override;
  2318.       function    Object_To_WML: string; override;
  2319.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  2320.       procedure   HTML_To_Object(FormVal: string); override;
  2321.    published
  2322.       property    Caption: string read FCaption write SetCaption;
  2323.       property    FontColor: TColor read FFontColor write FFontColor default clNone;
  2324.       property    Bold: boolean read FBold write SetBold default False;
  2325.       property    Italic: boolean read FItalic write FItalic default False;
  2326.       property    Underline: boolean read FUnderline write FUnderline default False;
  2327.       property    FontSize: integer read FFontSize write SetFontSize default 3;
  2328.       property    CanClick: boolean read FCanClick write FCanClick;
  2329.       property    SubmitToFrame: TWABD_Base_Frame read FSubmitTo write FSubmitTo;
  2330.       property    OnUserClick;
  2331.    end;
  2332.  
  2333.  
  2334.    TWABD_TextAreaWrap = (taOff,taOut,taInOut);
  2335.    TWABD_Memo = class(TWABD_LinesObject)
  2336.    protected
  2337.       FCols       : integer;
  2338.       FRows       : integer;
  2339.       FWrap       : TWABD_TextAreaWrap;
  2340.       procedure   SetCols(NewCols: integer);
  2341.       procedure   SetRows(NewRows: integer);
  2342.    public
  2343.       constructor Create(AOwner: TComponent); override;
  2344.       function    Object_To_HTML: string; override;
  2345.       function    Object_To_WML: string; override;
  2346.       function    Object_To_WML_Postfield: string; override;
  2347.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  2348.       procedure   HTML_To_Object(FormVal: string); override;
  2349.    published
  2350.       property    Cols: integer read FCols write SetCols;
  2351.       property    Rows: integer read FRows write SetRows;
  2352.       property    TabIndex: integer read FTabIndex write FTabIndex;
  2353.       property    Disabled;
  2354.       property    AccessKey;
  2355.       property    Title;
  2356.       property    WordWrap:TwABD_TextAreaWrap read FWrap write FWrap default taOff;
  2357.    end;
  2358.  
  2359.  
  2360.    TWABD_Button = class(TWABD_BaseEventSectionObject)
  2361.    protected
  2362.       FCaption    : string;
  2363.       FDefault    : boolean;
  2364.       procedure   SetName(const Value: TComponentName); override;
  2365.       procedure   SetCaption(NewCaption: string);
  2366.    public
  2367.       constructor Create(AOwner:TComponent); override;
  2368.       destructor  Destroy; override;
  2369.       function    Object_To_HTML: string; override;
  2370.       function    Object_To_WML: string; override;
  2371.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  2372.       procedure   HTML_To_Object(FormVal: string); override;
  2373.    published
  2374.       property    Caption: string read FCaption write SetCaption;
  2375.       property    Default: boolean read FDefault write FDefault default False;
  2376.       property    TabIndex;
  2377.       property    Disabled;
  2378.       property    AccessKey;
  2379.       property    OnUserClick;
  2380.       property    PathInfo;
  2381.       property    Title;
  2382.    end;
  2383.  
  2384.    TWABD_Edit = class(TWABD_BaseEventSectionObject)
  2385.    protected
  2386.       FOldText    : string;
  2387.       FText       : string;
  2388.       FPass       : boolean;
  2389.       FSize       : integer;
  2390.       FMax        : integer;
  2391.       FReadOnly   : boolean;
  2392.       FFormat     : string;
  2393.       FEmptyOK    : boolean;
  2394.  
  2395.       procedure   SetName(const Value: TComponentName); override;
  2396.       procedure   SetSize(NewSize: integer);
  2397.       procedure   SetText(s:string);
  2398.    public
  2399.       constructor Create(AOwner: TComponent); override;
  2400.       destructor  Destroy; override;
  2401.       function    Object_To_HTML: string; override;
  2402.       function    Object_To_WML: string; override;
  2403.       function    Object_To_WML_Postfield: string; override;
  2404.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  2405.       procedure   HTML_To_Object(FormVal: string); override;
  2406.    published
  2407.       property    OldText: string read FOldText;
  2408.       property    Text: string read FText write SetText;
  2409.       property    IsPassword: boolean read FPass write FPass;
  2410.       property    Size: integer read FSize write SetSize;
  2411.       property    MaxLength: integer read FMax write FMax;
  2412.       property    ReadOnly:boolean read FReadOnly write FReadOnly;
  2413.       property    Format:string read FFormat write FFormat;
  2414.       property    EmptyOK:boolean read FEmptyOK write FEmptyOK;
  2415.       property    TabIndex;
  2416.       property    Disabled;
  2417.       property    AccessKey;
  2418.       property    OnUserChange;
  2419.       property    JS_OnUserChange;
  2420.       property    Title;
  2421.    end;
  2422.  
  2423.    TWABD_UploadFile = class(TWABD_BaseEventSectionObject)
  2424.    protected
  2425.       FClientFileName : string;
  2426.       FLocalFileName  : string;
  2427.       FMimeType       : string;
  2428.       FAcceptMimeTypes    : TStringList;
  2429.       FReadOnly   : boolean;
  2430.       FSize       : integer;
  2431.       procedure   SetSize(NewSize: integer);
  2432.    public
  2433.       constructor Create(AOwner: TComponent); override;
  2434.       destructor  Destroy; override;
  2435.       function    Object_To_HTML: string; override;
  2436.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  2437.       procedure   HTML_To_Object(FormVal: string); override;
  2438.       property    LocalFileName:string read FLocalFileName;
  2439.       property    MimeType:string read FMimeType;
  2440.    published
  2441.       property    ClientFileName:string read FClientFileName write FClientFileName;
  2442.       property    ReadOnly:boolean read FReadOnly write FReadOnly;
  2443.       property    Size:integer read FSize write SetSize;
  2444.       property    AcceptMimeTypes:TStringList read FAcceptMimeTypes write FAcceptMimeTypes;
  2445.       property    Title;
  2446.       property    TabIndex;
  2447.       property    Disabled;
  2448.       property    AccessKey;
  2449.       property    OnUserChange;
  2450.       property    JS_OnUserChange;
  2451.    end;
  2452.  
  2453.    TWABD_ComboBox = class(TWABD_SelLinesObject)
  2454.    public
  2455.       constructor Create(AOwner: TComponent); override;
  2456.       destructor  Destroy; override;
  2457.       function    Object_To_HTML: string; override;
  2458.       function    Object_To_WML: string; override;
  2459.       function    Object_To_WML_Postfield: string; override;
  2460.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  2461.       procedure   HTML_To_Object(FormVal: string); override;
  2462.       property    OldText;
  2463.       property    Desc;
  2464.       property    SelectionChanged;
  2465.       property    Selected;
  2466.       property    Texts;
  2467.       property    Descs;
  2468.    published
  2469.       property    TabIndex;
  2470.       property    Disabled;
  2471.       property    AccessKey;
  2472.       property    SelIndex;
  2473.       property    OldSelIndex;
  2474.       property    Button;
  2475.       property    AutoButton;
  2476.       property    Text;
  2477.       property    Title;
  2478.    end;
  2479.  
  2480.  
  2481.    TWABD_RadioButton = class(TWABD_BaseEventSectionObject)
  2482.    protected
  2483.       FCaption    : string;
  2484.       FCheck      : boolean;
  2485.       FGroup      : integer;
  2486.       procedure   SetName(const Value: TComponentName); override;
  2487.       procedure   SetCaption(NewCaption: string);
  2488.       procedure   SetChecked(value:boolean);
  2489.       procedure   ResetCheckedProc(Child: TWABD_Object; var Stop: boolean; UserData: pointer);
  2490.    public
  2491.       constructor Create(AOwner: TComponent); override;
  2492.       destructor  Destroy; override;
  2493.       function    Object_To_HTML: string; override;
  2494.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  2495.       procedure   HTML_To_Object(FormVal: string); override;
  2496.    published
  2497.       property    Caption: string read FCaption write SetCaption;
  2498.       property    Checked: boolean read FCheck write SetChecked;
  2499.       property    Group:integer read FGroup write FGroup;
  2500.       property    TabIndex;
  2501.       property    Disabled;
  2502.       property    AccessKey;
  2503.       property    OnUserChange;
  2504.       property    JS_OnUserChange;
  2505.       property    Title;
  2506.    end;
  2507.  
  2508.  
  2509.    TWABD_ListBox = class(TWABD_SelLinesObject)
  2510.    protected
  2511.       FSize       : integer;
  2512.       FMultiple   : boolean;
  2513.       procedure   SetSize(NewSize: integer);
  2514.    public
  2515.       constructor Create(AOwner: TComponent); override;
  2516.       destructor  Destroy; override;
  2517.       function    Object_To_HTML: string; override;
  2518.       function    Object_To_WML: string; override;
  2519.       function    Object_To_WML_Postfield: string; override;
  2520.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  2521.       procedure   HTML_To_Object(FormVal: string); override;
  2522.       property    OldText;
  2523.       property    Desc;
  2524.       property    SelectionChanged;
  2525.       property    Selected;
  2526.       property    Texts;
  2527.       property    Descs;
  2528.    published
  2529.       property    Size: integer read FSize write SetSize;
  2530.       property    Multiple:boolean read FMultiple write FMultiple;
  2531.       property    TabIndex;
  2532.       property    Disabled;
  2533.       property    AccessKey;
  2534.       property    SelIndex;
  2535.       property    OldSelIndex;
  2536.       property    Button;
  2537.       property    AutoButton;
  2538.       property    Text;
  2539.       property    Title;
  2540.    end;
  2541.  
  2542.  
  2543.    TWABD_CheckBox = class(TWABD_BaseEventSectionObject)
  2544.    protected
  2545.       FCaption    : string;
  2546.       FCheck      : boolean;
  2547.       procedure   SetName(const Value: TComponentName); override;
  2548.       procedure   SetCaption(NewCaption: string);
  2549.       procedure   SetChecked(Check: boolean);
  2550.    public
  2551.       constructor Create(AOwner:TComponent); override;
  2552.       destructor  Destroy; override;
  2553.       function    Object_To_HTML: string; override;
  2554.       function    Object_To_WML: string; override;
  2555.       function    Object_To_WML_Postfield: string; override;
  2556.       function    Object_To_Control(AOwner: TWinControl): TControl; override;
  2557.       procedure   HTML_To_Object(FormVal: string); override;
  2558.    published
  2559.       property    Caption: string read FCaption write SetCaption;
  2560.       property    Checked: boolean read FCheck write SetChecked;
  2561.       property    Title;
  2562.       property    TabIndex;
  2563.       property    Disabled;
  2564.       property    AccessKey;
  2565.       property    OnUserChange;
  2566.       property    JS_OnUserChange;
  2567.    end;
  2568.  
  2569.  
  2570.    // ************************************************************************
  2571.    // Misc. Helper objects
  2572.  
  2573.    TPaintPanel = class(TPanel)
  2574.    protected
  2575.       FFormSec    : TWABD_FormSection_Grid;
  2576.       FDrawPic    : boolean;
  2577.       FCellBord   : integer;
  2578.       FDMode      : boolean;
  2579.       procedure   Paint; override;
  2580.       procedure   SetDrawPic(b: boolean);
  2581.       procedure   SetCellBorder(nb: integer);
  2582.       procedure   SetDesignMode(nm: boolean);
  2583.    public
  2584.       Pic         : TImage;
  2585.       GridX       : integer;
  2586.       GridY       : integer;
  2587.       property    DrawPic: boolean read FDrawPic write SetDrawPic;
  2588.       property    CellBorder: integer read FCellBord write SetCellBorder;
  2589.       property    DesignMode: boolean read FDMode write SetDesignMode;
  2590.    end;
  2591.  
  2592.    TJumpLabel = class(TLabel)
  2593.    protected
  2594.       FCanClick   : boolean;
  2595.       procedure   SetCanClick(b: boolean);
  2596.    public
  2597.       JumpDest    : string;
  2598.       JumpOut     : boolean;
  2599.       constructor Create(AOwner: TComponent); override;
  2600.       property    CanClick: boolean read FCanClick write SetCanClick;
  2601.    end;
  2602.  
  2603. const
  2604.    WABD_JS_Function_TypeText : array [TWABD_JS_Function_Type] of string =
  2605.                             ('OnEvent',
  2606.                              'OnClick','OnDblClick',
  2607.                              'OnChange',
  2608.                              'OnFocus','OnBlur',
  2609.                              'OnLoad','OnUnload',
  2610.                              'OnSubmit',
  2611.                              'OnMouseDown','OnMouseUp','OnMouseOver','OnMouseOut','OnMouseMove',
  2612.                              'OnKeyPress','OnKeyDown','OnKeyUp');
  2613.  
  2614.    WABD_EVENT_USERCHANGE=1;
  2615.    WABD_EVENT_USERCLICK=2;
  2616.    WABD_EVENT_USERGOTFOCUS=3;
  2617.    WABD_EVENT_USERLOSTFOCUS=4;
  2618.    WABD_EVENT_CALLBACK=90;
  2619.    WABD_EVENT_AUTOLOAD=99;
  2620.  
  2621. implementation
  2622.  
  2623. uses GifImage, WABD_Crypt;
  2624.  
  2625.  
  2626.  
  2627. // ************************************************************************
  2628. //    I N T E R F A C E   C U T - O F F
  2629. // ************************************************************************
  2630.  
  2631. // ************************************************************************
  2632. // Helper Objects
  2633. // ************************************************************************
  2634.  
  2635. type
  2636.    TTableCell = record
  2637.       SObj  : TWABD_SectionObject;
  2638.       Skip  : boolean;
  2639.       Width : integer;
  2640.       SpanX : integer;
  2641.       SpanY : integer;
  2642.    end;
  2643.    PTableCell = ^TTableCell;
  2644.    TTableCellArray = array[0..0] of TTableCell;
  2645.    PTableCellArray = ^TTableCellArray;
  2646.  
  2647.    TTableGrid = class
  2648.    protected
  2649.       mx, my      : integer;
  2650.       FData       : PTableCellArray;
  2651.    public
  2652.       constructor Create;
  2653.       destructor  Destroy; override;
  2654.       procedure   SetSize(x,y: integer);
  2655.       function    GetCell(x,y: integer): PTableCell;
  2656.    end;
  2657.  
  2658. // ************************************************************************
  2659. // Utility functions
  2660. // ************************************************************************
  2661.  
  2662. // Generate functioncall code without ending ;.
  2663. function GenJSFunctionCall(jsf:TWABD_JS_Function):string;
  2664. var
  2665.    a:string;
  2666.    s:string;
  2667.    i:integer;
  2668. begin
  2669.      if (jsf.FScript='') then
  2670.      begin
  2671.           Result:='';
  2672.           exit;
  2673.      end;
  2674.  
  2675.      // Check that the script doesnt contain parameter list by itself.
  2676.      a:=copy(jsf.FScript,length(jsf.FScript),1);
  2677.      if (a=')') or (a=';') then
  2678.      begin
  2679.           s:=jsf.FScript;
  2680.           if a=';' then s:=copy(s,1,length(s)-1);
  2681.      end
  2682.      else begin
  2683.           // Build Script + parameterlist.
  2684.           a:='';
  2685.           s:=jsf.FScript+'(';
  2686.           for i:=0 to jsf.FParams.count-1 do
  2687.           begin
  2688.               s:=s+a+jsf.FParams.Strings[i];
  2689.               a:=',';
  2690.           end;
  2691.           s:=s+')';
  2692.      end;
  2693.      Result:=s;
  2694. end;
  2695.  
  2696. // Generate eventcode.
  2697. function GenEventCode(jsf:TWABD_JS_Function; NotifyEvent:TNotifyEvent; EventType:integer; Data:string):string;
  2698. var
  2699.     usercode:string;
  2700.     returnstring:string;
  2701.     handleevent:string;
  2702.     a:string;
  2703. begin
  2704.      // Generate string for userdefined event java script.
  2705.      usercode:=GenJSFunctionCall(jsf);
  2706.      if usercode<>'' then usercode:=usercode+';';
  2707.  
  2708.      // Generate string for emulating serverside javascript eventhandling.
  2709.      if Assigned(NotifyEvent) then
  2710.         handleevent:='HandleEvent('+inttostr(EventType)+',this.form,this,'''');'
  2711.      else
  2712.         handleevent:='';
  2713.  
  2714.      // If its the onsubmit event, there should be a 'return ' before last in event list.
  2715.      if jsf.FType=jsOnSubmit then
  2716.         returnstring:='return '
  2717.      else
  2718.          returnstring:='';
  2719.  
  2720.      // Determine order of code segments in event handler.
  2721.      if (usercode<>'') then
  2722.      begin
  2723.           if jsf.Placement=jsfLast then
  2724.              Result:=Data+HandleEvent+UserCode
  2725.           else if Data<>'' then
  2726.               Result:=UserCode+HandleEvent+ReturnString+Data
  2727.           else
  2728.               Result:=UserCode+HandleEvent;
  2729.      end
  2730.      else if Data<>'' then
  2731.          Result:=HandleEvent+ReturnString+Data
  2732.      else
  2733.          Result:=HandleEvent;
  2734.  
  2735.      if Result<>'' then
  2736.      begin
  2737.           if (length(Result)>0) and (not (Result[1] in ['''','"'])) and (Pos(' ',Result)>0) then
  2738.              a:='"'
  2739.           else
  2740.               a:='';
  2741.           Result:=' '+WABD_JS_Function_TypeText[jsf.FType]+'='+a+Result+a;
  2742.      end;
  2743. end;
  2744.  
  2745. // Generate network timing Javascript.
  2746. function GenNetworkTimingJS:string;     // TODO: Need to finish GenNetworkTimingJS.
  2747. var
  2748.    tsSubmitClient,tsLoadClient,tsServer:string;
  2749.    ptClient,ptServer:string;
  2750. begin
  2751.      tsSubmitClient:='form.'+WABD_CLIENTSUBMITTIMESTAMP_STR+'.value';
  2752.      tsLoadClient:='form.'+WABD_CLIENTLOADTIMESTAMP_STR+'.value';
  2753.      tsServer:='form.'+WABD_SERVERTIMESTAMP_STR+'.value';
  2754.      ptClient:='form.'+WABD_CLIENTPROCESSTIME_STR+'.value';
  2755.      ptServer:='form.'+WABD_SERVERPROCESSTIME_STR+'.value';
  2756.  
  2757.      Result:='function TimeNetworkSubmit(form) {'+CR+
  2758.              ' var Old='+tsSubmitClient+';'+CR+
  2759.              ' var Now=new Date();'+CR+
  2760.              ' '+tsSubmitClient+'=Now.getTime();'+CR+
  2761.              ' if (Old != -1) '+ptClient+'='+tsLoadClient+'-Old'+';'+CR+
  2762.              ' return true'+CR+
  2763.              '};'+CR+CR+
  2764.              'function TimeNetworkLoad(form) {'+CR+
  2765.              ' var Now=new Date();'+CR+
  2766.              ' '+tsLoadClient+'=Now.getTime();'+CR+
  2767.              '};'+CR;
  2768. end;
  2769.  
  2770. // Generate Javascript for handling on.... events on sectionobjects.
  2771. function GenEventHandler(DoTiming:boolean;jsf_OnSubmit,jsf_OnUserEvent:TWABD_JS_Function):string;
  2772. var
  2773.    f1,f2,f3,f4,f5,f6:string;
  2774. begin
  2775.      f1:='function HandleEvent(ev,form,control,data) {'+CR;
  2776.      f2:='if (form.'+WABD_EVENT_ID_STR+'.value!="") form.'+WABD_EVENT_ID_STR+'.value=form.'+WABD_EVENT_ID_STR+'.value+";";'+CR+
  2777.              'form.'+WABD_EVENT_ID_STR+'.value=form.'+WABD_EVENT_ID_STR+'.value+ev+":"+control.name+":"+data;'+CR;
  2778.      f3:='form.submit();'+CR;
  2779.  
  2780.      // Emulate submit event if Javascript given for that purpose.
  2781.      if (Assigned(jsf_OnSubmit)) and (jsf_OnSubmit.FScript<>'') then
  2782.         f4:='if (!'+GenJSFunctionCall(jsf_OnSubmit)+') return;'+CR
  2783.      else
  2784.         f4:='';
  2785.  
  2786.      // Check if user event handler given, build script for that.
  2787.      if (Assigned(jsf_OnUserEvent)) and (jsf_OnUserEvent.FScript<>'') then
  2788.         f5:=jsf_OnUserEvent.FScript+CR
  2789.      else
  2790.         f5:='';
  2791.  
  2792.      // Check if network timing enabled, alter submit request.
  2793.      if DoTiming then
  2794.         f6:='TimeNetworkSubmit(form);'+CR
  2795.      else
  2796.         f6:='';
  2797.  
  2798.      Result:=f1+f5+f4+f2+f6+f3+'};'+CR;
  2799. end;
  2800.  
  2801. procedure SplitSessionID(str:string;var Session,FormName:string);
  2802. var
  2803.    i:integer;
  2804. begin
  2805.      i:=pos(':',str);
  2806.      Session:=copy(str,1,i-1);
  2807.      FormName:=copy(str,i+1,length(str));
  2808. end;
  2809.  
  2810. // Substitute all variables.
  2811. function Process_Variables(HTML:string;FVariables:TStrings):string;
  2812. var
  2813.    s,ss,v:string;
  2814.    j,k:integer;
  2815. begin
  2816.    s:='';
  2817.    ss:=HTML;
  2818.  
  2819.    // Loop while there are variables to setup.
  2820.    while true do
  2821.    begin
  2822.         j:=pos('[!--',ss);    // Look for startermarker for variable.
  2823.         if j>0 then
  2824.         begin
  2825.              s:=s+copy(ss,1,j-1); // Add the raw data before the startermarker as a result.
  2826.  
  2827.              ss:=copy(ss,j,length(ss));
  2828.              k:=pos('--!]',ss);  // Look for the endmarker for variable.
  2829.              if k>0 then
  2830.              begin
  2831.                   v:=copy(ss,5,k-5);  // Extract variablename.
  2832.                   ss:=copy(ss,k+4,length(ss));
  2833.  
  2834.                   k:=FVariables.IndexOfName(v);
  2835.                   if k>=0 then
  2836.                   begin
  2837.                        v:=FVariables.Strings[k];
  2838.                        k:=pos('=',v);
  2839.                        v:=copy(v,k+1,length(v));
  2840.                   end
  2841.                   else v:='[!--'+v+'--!]';
  2842.                   s:=s+v;
  2843.              end
  2844.              else
  2845.                  raise Exception.CreateFmt('Variable endmarker not found %s', [copy(ss,1,30)]);
  2846.         end
  2847.         else                    // No startermarker found, just add the rest of the text to result and break.
  2848.         begin
  2849.              s:=s+ss;
  2850.              break;
  2851.         end;
  2852.    end;
  2853.    Result := s;
  2854. end;
  2855.  
  2856. function FormatFilename(NewImagePath: string):string;
  2857. var
  2858.    s:string;
  2859. begin
  2860.    s:= NewImagePath;
  2861.    if Copy(s, 1, 1)<>'\' then s := '\' + s;
  2862.    Result:=s;
  2863. end;
  2864.  
  2865. function FormatPath(Path:string):string;
  2866. begin
  2867.      Result:=Path;
  2868.      if Copy(Result, Length(Result), 1)<>'/' then Result:=Result+'/';
  2869. end;
  2870.  
  2871. function FormatLocalPath(Path:string):string;
  2872. var
  2873.    s:string;
  2874. begin
  2875.      Result:=Path;
  2876.      if (Result<>'') and (Copy(Result, Length(Result), 1)<>'\') then Result:=Result+'\';
  2877.      if ExtractFileDrive(Result)='' then
  2878.      begin
  2879.           getdir(0,s);
  2880.           if Copy(s,length(s),1)<>'\' then s:=s+'\';
  2881.           if Result<>'' then
  2882.              Result:=s+Result
  2883.           else
  2884.             Result:=s;
  2885.      end;
  2886. end;
  2887.  
  2888. // ************************************************************************
  2889. // TWABD_Setup
  2890. // ************************************************************************
  2891. destructor TWABD_SesSubStat.Destroy;
  2892. begin
  2893.      ClearPoints;
  2894.      inherited;
  2895. end;
  2896.  
  2897. // Add sub stat point.
  2898. procedure TWABD_SesSubStat.AddPoint(ID:string; Value:double);
  2899. var
  2900.    i:integer;
  2901.    p:PWABD_SesSubStatRec;
  2902. begin
  2903.      i:=IndexOf(ID);
  2904.      if i<0 then
  2905.      begin
  2906.           GetMem(p,SizeOf(TWABD_SesSubStatRec));
  2907.           p^.Count:=0;
  2908.           p^.Value:=0.0;
  2909.           p^.Min:=9999999;
  2910.           p^.Max:=0;
  2911.           AddObject(ID,TObject(p));
  2912.      end
  2913.      else
  2914.          p:=PWABD_SesSubStatRec(Objects[i]);
  2915.      inc(p^.Count);
  2916.      p^.Value:=p^.Value+Value;
  2917.      if Value<p^.Min then p^.Min:=Value;
  2918.      if Value>p^.Max then p^.Max:=Value;
  2919. end;
  2920.  
  2921. // Clear all substat points.
  2922. procedure TWABD_SesSubStat.ClearPoints;
  2923. var
  2924.    i:integer;
  2925. begin
  2926.      for i:=0 to Count-1 do
  2927.          FreeMem(Pointer(Objects[i]));
  2928. end;
  2929.  
  2930. constructor TWABD_SesStatGroup.Create;
  2931. begin
  2932.      inherited;
  2933.      SubStat:=TWABD_SesSubStat.create;
  2934. end;
  2935.  
  2936. destructor TWABD_SesStatGroup.Destroy;
  2937. var
  2938.    i:integer;
  2939.    prec:PWABD_SesStatRec;
  2940.    lst:TList;
  2941. begin
  2942.      lst:=LockList;
  2943.      try
  2944.         with lst do
  2945.         begin
  2946.             for i:=0 to lst.count-1 do
  2947.             begin
  2948.                  prec:=PWABD_SesStatRec(Items[i]);
  2949.                  StrDispose(prec^.User);
  2950.                  StrDispose(prec^.Info);
  2951.                  FreeMem(Items[i]);
  2952.             end;
  2953.             Clear;
  2954.         end;
  2955.      finally
  2956.         UnlockList;
  2957.      end;
  2958.  
  2959.      SubStat.free;
  2960.      inherited;
  2961. end;
  2962. // Make sure only FBuffersize records is in the list.
  2963. procedure TWABD_SesStatGroup.Clean;
  2964. var
  2965.    i,n:integer;
  2966.    prec:PWABD_SesStatRec;
  2967.    lst:TList;
  2968. begin
  2969.      lst:=LockList;
  2970.      try
  2971.         with lst do
  2972.         begin
  2973.              n:=count - FBufferSize;
  2974.              for i:=0 to n-1 do
  2975.              begin
  2976.                   prec:=PWABD_SesStatRec(Items[0]);
  2977.                   StrDispose(prec^.User);
  2978.                   StrDispose(prec^.Info);
  2979.                   FreeMem(Items[0]);
  2980.                   Delete(0);
  2981.              end;
  2982.         end;
  2983.      finally
  2984.         UnlockList;
  2985.      end;
  2986. end;
  2987.  
  2988. // Clear stat. values for group.
  2989. procedure TWABD_SesStatGroup.Zero;
  2990. var
  2991.    i:integer;
  2992. begin
  2993.      FSum:=0;
  2994.      FCount:=0;
  2995.      FMin:=999E39;
  2996.      FMax:=0;
  2997.  
  2998.      for i:=0 to 23 do
  2999.      begin
  3000.           HourlyValues[i]:=0;
  3001.           HourlyCount[i]:=0;
  3002.      end;
  3003.      for i:=1 to 31 do
  3004.      begin
  3005.           DailyValues[i]:=0;
  3006.           DailyCount[i]:=0;
  3007.      end;
  3008.      for i:=1 to 12 do
  3009.      begin
  3010.           MonthlyValues[i]:=0;
  3011.           MonthlyCount[i]:=0;
  3012.      end;
  3013.      for i:=1 to 7 do
  3014.      begin
  3015.           DayValues[i]:=0;
  3016.           DayCount[i]:=0;
  3017.      end;
  3018.      SubStat.ClearPoints;
  3019. end;
  3020.  
  3021. // Add stat. group.
  3022. procedure TWABD_SesStat.AddGroup(GrpName:string; GrpType:TWABD_SesStatGroups; BufSize:integer);
  3023. var
  3024.    grp:TWABD_SesStatGroup;
  3025. begin
  3026.      grp:=TWABD_SesStatGroup.Create;
  3027.      grp.FName:=GrpName;
  3028.      grp.FBufferSize:=BufSize;
  3029.      grp.FGroupType:=GrpType;
  3030.      grp.Zero;
  3031.      Add(grp);
  3032. end;
  3033.  
  3034. // Find group by name.
  3035. function TWABD_SesStat.IndexOf(GrpName:string):integer;
  3036. var
  3037.    i:integer;
  3038.    lst:TList;
  3039. begin
  3040.      Result:=-1;
  3041.      lst:=LockList;
  3042.      try
  3043.         with lst do
  3044.         begin
  3045.             for i:=0 to count-1 do
  3046.                 with TWABD_SesStatGroup(Items[i]) do
  3047.                     if Name=GrpName then
  3048.                     begin
  3049.                         Result:=i;
  3050.                         break;
  3051.                     end;
  3052.         end;
  3053.      finally
  3054.         UnlockList;
  3055.      end;
  3056. end;
  3057.  
  3058. // Add meassure to a stat. group.
  3059. procedure TWABD_SesStat.AddPoint(GrpName:string; User,Info:string; Value:double);
  3060. var
  3061.    i:integer;
  3062.    grp:TWABD_SesStatGroup;
  3063.    prec:PWABD_SesStatRec;
  3064.    h,mm,s,ms,d,m,y,dw:word;
  3065.    stamp:TDateTime;
  3066.    lst:TList;
  3067. begin
  3068.      i:=IndexOf(GrpName);
  3069.      if (i<0) then exit;
  3070.  
  3071.      lst:=LockList;
  3072.      try
  3073.          with lst do
  3074.          begin
  3075.              grp:=TWABD_SesStatGroup(Items[i]);
  3076.  
  3077.              // Convert value to correct format.
  3078.              if grp.FGroupType=wabdStatGroupTurnAround then Value:=trunc(MSECS*Value);
  3079.  
  3080.              // Get datetime for record.
  3081.              stamp:=Now;
  3082.              DecodeDate(stamp,y,m,d);
  3083.              DecodeTime(stamp,h,mm,s,ms);
  3084.              dw:=DayOfWeek(stamp);
  3085.  
  3086.              // Allocate room for new stat. record.
  3087.              GetMem(prec,sizeof(TWABD_SesStatRec));
  3088.              prec^.Stamp:=Now;
  3089.              prec^.Value:=Value;
  3090.              prec^.User:=StrNew(PChar(User));
  3091.              prec^.Info:=StrNew(PChar(Info));
  3092.              grp.Add(prec);
  3093.  
  3094.              // Calculate group sums.
  3095.              inc(grp.FCount);
  3096.              grp.FSum:=grp.FSum+Value;
  3097.              if Value<grp.FMin then grp.FMin:=Value;
  3098.              if Value>grp.FMax then grp.FMax:=Value;
  3099.  
  3100.              // Calculate hourly sums.
  3101.              grp.HourlyValues[h]:=grp.HourlyValues[h]+Value;
  3102.              inc(grp.HourlyCount[h]);
  3103.  
  3104.              // Calculate daily sums.
  3105.              grp.DailyValues[d]:=grp.DailyValues[d]+Value;
  3106.              inc(grp.DailyCount[d]);
  3107.  
  3108.              // Calculate monthly sums.
  3109.              grp.MonthlyValues[m]:=grp.MonthlyValues[m]+Value;
  3110.              inc(grp.MonthlyCount[m]);
  3111.  
  3112.              // Calculate day sums.
  3113.              grp.DayValues[dw]:=grp.DayValues[dw]+Value;
  3114.              inc(grp.DayCount[dw]);
  3115.          end;
  3116.     finally
  3117.         UnlockList;
  3118.     end;
  3119. end;
  3120.  
  3121. procedure TWABD_SesStat.Clean;
  3122. var
  3123.    i:integer;
  3124.    lst:TList;
  3125. begin
  3126.      lst:=LockList;
  3127.      try
  3128.         with lst do
  3129.         begin
  3130.              for i:=0 to count-1 do
  3131.                  with TWABD_SesStatGroup(Items[i]) do Clean;
  3132.         end;
  3133.      finally
  3134.         UnlockList;
  3135.      end;
  3136. end;
  3137.  
  3138. // Save stat info.
  3139. procedure TWABD_SesStat.Save(dllname:string);
  3140. var
  3141.    g:integer;
  3142.    grp:TWABD_SesStatGroup;
  3143.    i:integer;
  3144.    s:string;
  3145.    INI:TIniFile;
  3146.    os:char;
  3147.    lst:TList;
  3148. begin
  3149.      // Replace
  3150.      s:=ChangeFileExt(dllname,'.STA');
  3151.      if s=dllname then s:=s+'.STA';          // Dont want to overwrite the dll by accident.
  3152.      if ExtractFilePath(s)='' then s:='.\'+s;
  3153.  
  3154.      os:=Decimalseparator;
  3155.      Decimalseparator:='.';
  3156.      INI:=TInifile.Create(s);
  3157.  
  3158.      lst:=LockList;
  3159.      try
  3160.         with lst do
  3161.         begin
  3162.              // For all groups.
  3163.              for g:=0 to count-1 do
  3164.              begin
  3165.                   grp:=TWABD_SesStatGroup(Items[g]);
  3166.  
  3167.                   // Write group global info.
  3168.                   s:=grp.Name;
  3169.                   INI.writestring(s,'Sum',floattostr(grp.FSum));
  3170.                   INI.writeinteger(s,'Count',grp.FCount);
  3171.                   INI.writestring(s,'Min',floattostr(grp.FMin));
  3172.                   INI.writestring(s,'Min',floattostr(grp.FMax));
  3173.  
  3174.                   // Write hourly info.
  3175.                   s:=grp.Name+' Hourly';
  3176.                   for i:=0 to 23 do
  3177.                   begin
  3178.                        INI.WriteString(s,'Val'+inttostr(i),floattostr(grp.HourlyValues[i]));
  3179.                        INI.Writeinteger(s,'Cnt'+inttostr(i),grp.HourlyCount[i]);
  3180.                   end;
  3181.  
  3182.                   // Write daily info.
  3183.                   s:=grp.Name+' Daily';
  3184.                   for i:=1 to 31 do
  3185.                   begin
  3186.                        INI.WriteString(s,'Val'+inttostr(i),floattostr(grp.DailyValues[i]));
  3187.                        INI.Writeinteger(s,'Cnt'+inttostr(i),grp.DailyCount[i]);
  3188.                   end;
  3189.  
  3190.                   // Write monthly info.
  3191.                   s:=grp.Name+' Monthly';
  3192.                   for i:=1 to 12 do
  3193.                   begin
  3194.                        INI.WriteString(s,'Val'+inttostr(i),floattostr(grp.MonthlyValues[i]));
  3195.                        INI.Writeinteger(s,'Cnt'+inttostr(i),grp.MonthlyCount[i]);
  3196.                   end;
  3197.  
  3198.                   // Write day info.
  3199.                   s:=grp.Name+' Weekday';
  3200.                   for i:=1 to 7 do
  3201.                   begin
  3202.                        INI.WriteString(s,'Val'+inttostr(i),floattostr(grp.DayValues[i]));
  3203.                        INI.Writeinteger(s,'Cnt'+inttostr(i),grp.DayCount[i]);
  3204.                   end;
  3205.              end;
  3206.         end;
  3207.      finally
  3208.         UnlockList;
  3209.      end;
  3210.  
  3211.      INI.free;
  3212.      Decimalseparator:=os;
  3213. end;
  3214.  
  3215. // Load stat info.
  3216. procedure TWABD_SesStat.Load(dllname:string);
  3217. var
  3218.    g:integer;
  3219.    grp:TWABD_SesStatGroup;
  3220.    i,n:integer;
  3221.    s:string;
  3222.    INI:TIniFile;
  3223.    os:char;
  3224.    lst:TList;
  3225. begin
  3226.      // Replace
  3227.      s:=ChangeFileExt(dllname,'.STA');
  3228.      if s=dllname then s:=s+'.STA';          // Dont want to overwrite the dll by accident.
  3229.      if ExtractFilePath(s)='' then s:='.\'+s;
  3230.  
  3231.      os:=Decimalseparator;
  3232.      Decimalseparator:='.';
  3233.      INI:=TInifile.Create(s);
  3234.  
  3235.      lst:=LockList;
  3236.      try
  3237.         with lst do
  3238.         begin
  3239.              // For all groups.
  3240.              for g:=0 to count-1 do
  3241.              begin
  3242.                   grp:=TWABD_SesStatGroup(Items[g]);
  3243.  
  3244.                   // Write group global info.
  3245.                   s:=grp.Name;
  3246.                   n:=INI.readinteger(s,'Count',-1);
  3247.                   if n<0 then continue;
  3248.                   grp.FCount:=n;
  3249.                   grp.FSum:=strtofloat(INI.readstring(s,'Sum','0.0'));
  3250.                   grp.FMin:=strtofloat(INI.readstring(s,'Min','0.0'));
  3251.                   grp.FMax:=strtofloat(INI.readstring(s,'Min','0.0'));
  3252.  
  3253.                   // read hourly info.
  3254.                   s:=grp.Name+' Hourly';
  3255.                   for i:=0 to 23 do
  3256.                   begin
  3257.                        grp.HourlyValues[i]:=strtofloat(INI.readString(s,'Val'+inttostr(i),'0.0'));
  3258.                        grp.HourlyCount[i]:=INI.readinteger(s,'Cnt'+inttostr(i),0);
  3259.                   end;
  3260.  
  3261.                   // read daily info.
  3262.                   s:=grp.Name+' Daily';
  3263.                   for i:=1 to 31 do
  3264.                   begin
  3265.                        grp.DailyValues[i]:=strtofloat(INI.readString(s,'Val'+inttostr(i),'0.0'));
  3266.                        grp.DailyCount[i]:=INI.readinteger(s,'Cnt'+inttostr(i),0);
  3267.                   end;
  3268.  
  3269.                   // read monthly info.
  3270.                   s:=grp.Name+' Monthly';
  3271.                   for i:=1 to 12 do
  3272.                   begin
  3273.                        grp.MonthlyValues[i]:=strtofloat(INI.readString(s,'Val'+inttostr(i),'0.0'));
  3274.                        grp.MonthlyCount[i]:=INI.readinteger(s,'Cnt'+inttostr(i),0);
  3275.                   end;
  3276.  
  3277.                   // read day info.
  3278.                   s:=grp.Name+' Weekday';
  3279.                   for i:=1 to 7 do
  3280.                   begin
  3281.                        grp.DayValues[i]:=strtofloat(INI.readString(s,'Val'+inttostr(i),'0.0'));
  3282.                        grp.DayCount[i]:=INI.readinteger(s,'Cnt'+inttostr(i),0);
  3283.                   end;
  3284.              end;
  3285.         end;
  3286.      finally
  3287.         UnlockList;
  3288.      end;
  3289.  
  3290.      INI.free;
  3291.      Decimalseparator:=os;
  3292. end;
  3293.  
  3294. procedure TWABD_SesStat.Zero;
  3295. var
  3296.    g:integer;
  3297.    grp:TWABD_SesStatGroup;
  3298.    lst:TList;
  3299. begin
  3300.      lst:=LockList;
  3301.      try
  3302.         with lst do
  3303.         begin
  3304.              // For all groups.
  3305.              for g:=0 to count-1 do
  3306.              begin
  3307.                   grp:=TWABD_SesStatGroup(Items[g]);
  3308.                   grp.Zero;
  3309.              end;
  3310.         end;
  3311.      finally
  3312.         UnlockList;
  3313.      end;
  3314. end;
  3315.  
  3316. // Clear all stat.groups and deallocate memory.
  3317. destructor TWABD_SesStat.Destroy;
  3318. var
  3319.    i:integer;
  3320.    lst:TList;
  3321. begin
  3322.      lst:=LockList;
  3323.      try
  3324.         with lst do
  3325.         begin
  3326.              for i:=0 to count-1 do
  3327.                  TWABD_SesStatGroup(Items[i]).free;
  3328.              Clear;
  3329.         end;
  3330.      finally
  3331.         UnlockList;
  3332.      end;
  3333.  
  3334.      inherited;
  3335. end;
  3336.  
  3337. // ************************************************************************
  3338. // TWABD_Setup
  3339. // ************************************************************************
  3340. constructor TWABD_Setup.Create(AOwner:TComponent);
  3341. begin
  3342.     inherited;
  3343.     InitializeCriticalSection(FLock);
  3344.     FAutoSetGlobalRootPath:=false;
  3345.     FExpandFromRootPath:=false;
  3346.     FExpandFromGlobalRootPath:=false;
  3347. end;
  3348.  
  3349. destructor TWABD_Setup.Destroy;
  3350. begin
  3351.     // Before destruction, save info.
  3352.     if FAutoSave then Save;
  3353.     DeleteCriticalSection(FLock);
  3354.     inherited;
  3355. end;
  3356.  
  3357. procedure TWABD_Setup.Save;
  3358. var
  3359.    reg:TRegistry;
  3360.    ini:TIniFile;
  3361. begin
  3362.      Lock;
  3363.      try
  3364.         // Before destruction, save info.
  3365.         case Storage of
  3366.             storeNone: ;
  3367.             storeRegistry:
  3368.               begin
  3369.                 reg:=TRegistry.Create;
  3370.                 if reg.OpenKey('\Software\'+FStoragePath+'\'+FSectionName,true) then
  3371.                 begin
  3372.                     reg.WriteString('ImagePath',ImagePath);
  3373.                     reg.WriteString('LocalImagePath',LocalImagePath);
  3374.                     reg.WriteString('FilePath',FilePath);
  3375.                     reg.WriteString('LocalFilePath',LocalFilePath);
  3376.                     reg.WriteString('LocalRootPath',LocalRootPath);
  3377.                     if assigned(FOnSave) then FOnSave(self,FSectionName,reg,nil);
  3378.                 end;
  3379.                 reg.free;
  3380.               end;
  3381.             storeIniFile:
  3382.               begin
  3383.                 ini:=TIniFile.Create(FStoragePath);
  3384.                 if ini<>nil then
  3385.                 begin
  3386.                     ini.WriteString(FSectionName,'ImagePath',ImagePath);
  3387.                     ini.WriteString(FSectionName,'LocalImagePath',LocalFilePath);
  3388.                     ini.WriteString(FSectionName,'FilePath',ImagePath);
  3389.                     ini.WriteString(FSectionName,'LocalFilePath',LocalFilePath);
  3390.                     ini.WriteString(FSectionName,'LocalRootPath',LocalRootPath);
  3391.                     if assigned(FOnSave) then FOnSave(self,FSectionName,nil,ini);
  3392.                 end;
  3393.                 ini.free;
  3394.               end;
  3395.         end;
  3396.      finally
  3397.         Unlock;
  3398.      end;
  3399. end;
  3400.  
  3401. procedure TWABD_Setup.Load;
  3402. var
  3403.    reg:TRegistry;
  3404.    ini:TIniFile;
  3405. begin
  3406.      Lock;
  3407.      try
  3408.         case Storage of
  3409.             storeNone: ;
  3410.             storeRegistry:
  3411.               begin
  3412.                 reg:=TRegistry.Create;
  3413.                 if reg.OpenKey('\Software\'+FStoragePath+'\'+FSectionName,false) then
  3414.                 begin
  3415.                     ImagePath:=reg.ReadString('ImagePath');
  3416.                     LocalImagePath:=reg.ReadString('LocalImagePath');
  3417.                     FilePath:=reg.ReadString('FilePath');
  3418.                     LocalFilePath:=reg.ReadString('LocalFilePath');
  3419.                     LocalRootPath:=reg.ReadString('LocalRootPath');
  3420.                     if assigned(FOnLoad) then FOnLoad(self,FSectionName,reg,nil);
  3421.                 end;
  3422.                 reg.free;
  3423.               end;
  3424.             storeIniFile:
  3425.               begin
  3426.                 ini:=TIniFile.Create(FStoragePath);
  3427.                 if ini<>nil then
  3428.                 begin
  3429.                     ImagePath:=ini.ReadString(FSectionName,'ImagePath','');
  3430.                     LocalImagePath:=ini.ReadString(FSectionName,'LocalImagePath','');
  3431.                     FilePath:=ini.ReadString(FSectionName,'FilePath','');
  3432.                     LocalFilePath:=ini.ReadString(FSectionName,'LocalFilePath','');
  3433.                     LocalRootPath:=ini.ReadString(FSectionName,'LocalRootPath','');
  3434.                     if assigned(FOnLoad) then FOnLoad(self,FSectionName,nil,ini);
  3435.                 end;
  3436.                 ini.free;
  3437.               end;
  3438.         end;
  3439.      finally
  3440.       Unlock;
  3441.      end;
  3442. end;
  3443.  
  3444. procedure TWABD_Setup.Loaded;
  3445. begin
  3446.     inherited;
  3447.     if FAutoLoad then Load;
  3448. end;
  3449.  
  3450. function TWABD_Setup.GetImagePath:string;
  3451. begin
  3452.      Lock;
  3453.      try
  3454.         Result:=FormatPath(FImagePath);
  3455.      finally
  3456.         Unlock;
  3457.      end;
  3458. end;
  3459.  
  3460. function TWABD_Setup.GetLocalImagePath:string;
  3461. var
  3462.    s:string;
  3463. begin
  3464.      Lock;
  3465.      try
  3466.         if FExpandFromRootPath then
  3467.         begin
  3468.              if FExpandFromGlobalRootPath then
  3469.                 s:=WABD_DefaultRequestLocalFilePath
  3470.              else
  3471.                  s:=LocalRootPath;
  3472.              Result:=FormatLocalPath(ExpandFileName(s+'\'+FLocalImagePath))
  3473.         end
  3474.         else
  3475.             Result:=FormatLocalPath(FLocalImagePath);
  3476.      finally
  3477.         Unlock;
  3478.      end;
  3479. end;
  3480.  
  3481. function TWABD_Setup.GetFilePath:string;
  3482. begin
  3483.      Lock;
  3484.      try
  3485.         Result:=FormatPath(FFilePath);
  3486.      finally
  3487.         Unlock;
  3488.      end;
  3489. end;
  3490.  
  3491. function TWABD_Setup.GetLocalFilePath:string;
  3492. var
  3493.    s:string;
  3494. begin
  3495.      Lock;
  3496.      try
  3497.         if FExpandFromRootPath then
  3498.         begin
  3499.              if FExpandFromGlobalRootPath then
  3500.                 s:=WABD_DefaultRequestLocalFilePath
  3501.              else
  3502.                  s:=LocalRootPath;
  3503.              Result:=FormatLocalPath(ExpandFileName(s+'\'+FLocalFilePath))
  3504.         end
  3505.         else
  3506.              Result:=FormatLocalPath(FLocalFilePath);
  3507.      finally
  3508.         Unlock;
  3509.      end;
  3510. end;
  3511.  
  3512. procedure TWABD_Setup.Lock;
  3513. begin
  3514.      EnterCriticalSection(FLock);
  3515. end;
  3516.  
  3517. procedure TWABD_Setup.Unlock;
  3518. begin
  3519.      LeaveCriticalSection(FLock);
  3520. end;
  3521.  
  3522. procedure TWABD_Setup.SetLocalRootPath(APath:string);
  3523. begin
  3524.      Lock;
  3525.      try
  3526.         if FAutoSetGlobalRootPath then
  3527.            WABD_DefaultRequestLocalFilePath:=APath;
  3528.         FLocalRootPath:=APath;
  3529.      finally
  3530.         Unlock;
  3531.      end;
  3532. end;
  3533.  
  3534. function  TWABD_Setup.GetLocalRootPath:string;
  3535. begin
  3536.      Lock;
  3537.      try
  3538.         if FAutoSetGlobalRootPath then
  3539.            Result:=WABD_DefaultRequestLocalFilePath
  3540.         else
  3541.            Result:=FLocalRootPath;
  3542.      finally
  3543.         Unlock;
  3544.      end;
  3545. end;
  3546.  
  3547. // ************************************************************************
  3548. // TJumpLabel
  3549. // ************************************************************************
  3550.  
  3551. constructor TJumpLabel.Create(AOwner: TComponent);
  3552. begin
  3553.    inherited;
  3554. end;
  3555.  
  3556. procedure TJumpLabel.SetCanClick(b: boolean);
  3557. begin
  3558.    FCanClick := b;
  3559.    if b then begin
  3560.    {$IFDEF VER100}
  3561.       Cursor := crHandPoint;
  3562.    {$ENDIF}
  3563.       Font.Style := Font.Style + [fsUnderline];
  3564.    end else begin
  3565.       Cursor := crDefault;
  3566.    end;
  3567. end;
  3568.  
  3569. // ************************************************************************
  3570. // TTableGrid
  3571. // ************************************************************************
  3572.  
  3573. constructor TTableGrid.Create;
  3574. begin
  3575.    FData := nil;
  3576.    mx := 0;
  3577.    my := 0;
  3578. end;
  3579.  
  3580. destructor TTableGrid.Destroy;
  3581. begin
  3582.    if FData<>nil then FreeMem(FData);
  3583. end;
  3584.  
  3585. procedure TTableGrid.SetSize(x,y: integer);
  3586. begin
  3587.    if FData<>nil then
  3588.    begin
  3589.         FreeMem(FData);
  3590.         FData:=nil;
  3591.    end;
  3592.    mx := x;
  3593.    my := y;
  3594.    if (x*y) = 0 then exit;
  3595.    GetMem(FData, x*y*sizeof(TTableCell));
  3596.    FillChar(FData^, x*y*sizeof(TTableCell), 0);
  3597. end;
  3598.  
  3599. function TTableGrid.GetCell(x,y: integer): PTableCell;
  3600. begin
  3601.    {$R-}
  3602.    if x>=mx then raise Exception.CreateFmt('GetCell: X out of bounds (x=%d, MaxX=%d)',[x,mx]);
  3603.    if y>=my then raise Exception.CreateFmt('GetCell: Y out of bounds (y=%d, MaxY=%d)',[y,my]);
  3604.    Result := @FData^[x * my + y];
  3605. end;
  3606.  
  3607.  
  3608. // ************************************************************************
  3609. // TWABD_Table_Strings
  3610. // ************************************************************************
  3611.  
  3612. constructor TWABD_Table_Strings.Create;
  3613. begin
  3614.    inherited;
  3615.    FData := nil;
  3616.    XSize := 0;
  3617.    YSize := 0;
  3618. end;
  3619.  
  3620. destructor TWABD_Table_Strings.Destroy;
  3621. begin
  3622.     FreeData;
  3623.     inherited;
  3624. end;
  3625.  
  3626. procedure TWABD_Table_Strings.FreeData;
  3627. var
  3628.    i:integer;
  3629. begin
  3630.     if FData<>nil then
  3631.     begin
  3632.          for i:=0 to (XSize*YSize)-1 do
  3633.              if FData[i]<>nil then StrDispose(FData[i]);
  3634.          FreeMem(FData);
  3635.     end;
  3636.     FData:=nil;
  3637. end;
  3638.  
  3639. procedure TWABD_Table_Strings.SetSize(x,y: integer);
  3640. begin
  3641.    if (x=XSize) and (y=YSize) then exit;
  3642.    FreeData;
  3643.    XSize := x;
  3644.    YSize := y;
  3645.    if (XSize = 0) or (YSize = 0) then exit;
  3646.  
  3647.    GetMem(FData, XSize * YSize * sizeof(PChar));
  3648.    FillChar(FData^, XSize * YSize * sizeof(PChar),chr(0));
  3649. end;
  3650.  
  3651. procedure TWABD_Table_Strings.SafeSetSize(x, y: integer);
  3652. var
  3653.    MinX, MinY  : integer;
  3654.    NewData     : PStringArray;
  3655.    xp, yp      : integer;
  3656. begin
  3657.    if XSize < x then MinX := XSize else MinX := x;
  3658.    if YSize < y then MinY := YSize else MinY := y;
  3659.  
  3660.    if (x>0) and (y>0) then
  3661.    begin
  3662.         GetMem(NewData, x * y * sizeof(PChar));
  3663.         FillChar(NewData^, x * y * sizeof(PChar),chr(0));
  3664.  
  3665.         for xp := 0 to MinX-1 do
  3666.             for yp := 0 to MinY-1 do
  3667.                 if FData^[xp * YSize + yp]<>nil then
  3668.                    NewData^[xp * y + yp] := StrNew(FData^[xp * YSize + yp]);
  3669.    end
  3670.    else NewData:=nil;
  3671.  
  3672.    FreeData;
  3673.    XSize := x;
  3674.    YSize := y;
  3675.    FData := NewData;
  3676. end;
  3677.  
  3678. function TWABD_Table_Strings.GetString(x,y: integer): string;
  3679. begin
  3680.    Assert((x < XSize) and (x >= 0), 'GetString: X out of Bounds');
  3681.    Assert((y < YSize) and (y >= 0), 'GetString: Y out of Bounds');
  3682.  
  3683.    Result := StrPas(FData^[x * YSize + y]);
  3684. end;
  3685.  
  3686. procedure TWABD_Table_Strings.SetString(x,y: integer; NewString: string);
  3687. begin
  3688.    Assert((x < XSize) and (x >= 0), 'SetString: X out of Bounds');
  3689.    Assert((y < YSize) and (y >= 0), 'SetString: Y out of Bounds');
  3690.  
  3691.    FData^[x * YSize + y] := StrNew(PChar(NewString));
  3692. end;
  3693.  
  3694. procedure TWABD_Table_Strings.DefineProperties(Filer: TFiler);
  3695. begin
  3696.    Filer.DefineProperty('TableStrings', ReadProps, WriteProps, True);
  3697. end;
  3698.  
  3699. procedure TWABD_Table_Strings.WriteProps(Writer: TWriter);
  3700. var
  3701.    x, y : integer;
  3702. begin
  3703.    Writer.WriteListBegin;
  3704.    Writer.WriteInteger(XSize);
  3705.    Writer.WriteInteger(YSize);
  3706.    for x := 0 to XSize-1 do
  3707.       for y := 0 to YSize-1 do
  3708.          Writer.WriteString(Strings[x,y]);
  3709.    Writer.WriteListEnd;
  3710. end;
  3711.  
  3712. procedure TWABD_Table_Strings.ReadProps(Reader: TReader);
  3713. var
  3714.    x, y : integer;
  3715. begin
  3716.    Reader.ReadListBegin;
  3717.    x := Reader.ReadInteger;
  3718.    y := Reader.ReadInteger;
  3719.    SetSize(x,y);
  3720.    for x := 0 to XSize-1 do
  3721.       for y := 0 to YSize-1 do
  3722.          Strings[x,y] := Reader.ReadString;
  3723.    Reader.ReadListEnd;
  3724. end;
  3725.  
  3726. procedure TWABD_Table_Strings.Assign(Source: TPersistent);
  3727. var
  3728.    t     : TWABD_Table_Strings;
  3729.    x, y  : integer;
  3730. begin
  3731.    if Source=Self then exit;
  3732.    t := Source as TWABD_Table_Strings;
  3733.    SetSize(t.XSize, t.YSize);
  3734.    for x := 0 to XSize-1 do
  3735.       for y := 0 to YSize-1 do
  3736.          Strings[x,y] := t.Strings[x,y];
  3737. end;
  3738.  
  3739.  
  3740. // ************************************************************************
  3741. // TPaintPanel
  3742. // ************************************************************************
  3743.  
  3744. procedure TPaintPanel.Paint;
  3745. var
  3746.    x, y     : integer;
  3747.    mx, my   : integer;
  3748.    ox, oy   : integer;
  3749. begin
  3750.    inherited;
  3751.    if FDMode then begin
  3752.       for x := 0 to Width div GridX do
  3753.          for y := 0 to Height div GridY do
  3754.             Canvas.Pixels[x * GridX, y * GridY] := clBlack;
  3755.    end;
  3756.  
  3757.    if FDrawPic and not FDMode then begin
  3758.       mx := Width div Pic.Width + 1;
  3759.       my := Height div Pic.Height + 1;
  3760.  
  3761.       ox := Left mod Pic.Width;     // To line up with everyone else
  3762.       oy := Top mod Pic.Height;
  3763.  
  3764.       for x := 0 to mx do begin
  3765.          for y := 0 to my do begin
  3766.             Canvas.Draw(x * Pic.Width - ox, y * Pic.Height - oy, Pic.Picture.Graphic);
  3767.          end;
  3768.       end;
  3769.    end;
  3770.  
  3771.    if FCellBord > 0 then begin
  3772.  
  3773.       if FFormSec<>nil then begin
  3774.          for x := 0 to FFormSec.NumCol do begin
  3775.             Canvas.MoveTo(FFormSec.ColTot[x], 0);
  3776.             Canvas.LineTo(FFormSec.ColTot[x], Height);
  3777.          end;
  3778.          for y := 0 to FFormSec.NumRow do begin
  3779.             Canvas.MoveTo(0, FFormSec.RowTot[y]);
  3780.             Canvas.LineTo(Width, FFormSec.RowTot[y]);
  3781.          end;
  3782.       end else begin
  3783.          for x := 0 to Width div GridX do begin
  3784.             Canvas.MoveTo(x * GridX, 0);
  3785.             Canvas.LineTo(x * GridX, Height);
  3786.          end;
  3787.          for y := 0 to Height div GridY do begin
  3788.             Canvas.MoveTo(0, y * GridY);
  3789.             Canvas.LineTo(Width, y * GridY);
  3790.          end;
  3791.       end;
  3792.  
  3793.    end;
  3794. end;
  3795.  
  3796. procedure TPaintPanel.SetDrawPic(b: boolean);
  3797. begin
  3798.    FDrawPic := b;
  3799.    Invalidate;
  3800. end;
  3801.  
  3802. procedure TPaintPanel.SetCellBorder(nb: integer);
  3803. begin
  3804.    FCellBord := nb;
  3805.    Invalidate;
  3806. end;
  3807.  
  3808. procedure TPaintPanel.SetDesignMode(nm: boolean);
  3809. begin
  3810.    FDMode := nm;
  3811.    Invalidate;
  3812. end;
  3813.  
  3814.  
  3815. // ************************************************************************
  3816. // TWABD_SessionMgr
  3817. // ************************************************************************
  3818.  
  3819. constructor TWABD_SessionMgr.Create(AOwner: TComponent);
  3820. begin
  3821.    inherited;
  3822.    CreateTime  := Now;
  3823.    SessionList := TThreadList.Create;
  3824.    FUniqueList := TThreadList.create;
  3825.    FRouteSites := TStringList.create;
  3826.    FRouteWhen  := rwNever;
  3827.    FGarbage    := True;
  3828.    FCheck      := 60;                     // Run the check every 60 seconds
  3829.    FVariables  := TStringList.create;
  3830.    FHTMLTimeOut := TStringList.create;
  3831.    FWebAdmin   := 'the WEB administrator';
  3832.    FSiteName   := 'kbmWABD';
  3833.    FDefSesTimeout:=600;                   // 10 minutes.
  3834.    FMaxSessions:=-1;
  3835.    FRouteLast  :=-1;
  3836.    FMaxIdenticalUser:=-1;
  3837.    FMaxRequestSize:=-1;                   // Request size not limited.
  3838.    FRandomSessionID:=false;
  3839.    FTotalSessionCount:=0;
  3840.  
  3841.    Register_WABD_Callback(ClientRequest);  // The interface between ISAPI and WABD on requests.
  3842.    Register_WABD_Term_Callback(OnTerminateCallback);  // The interface between ISAPI and WABD on termination.
  3843.    InitializeCriticalSection(SesMgrCSCreate);
  3844.    InitializeCriticalSection(SesMgrCSDestroy);
  3845.    InitializeCriticalSection(SesMgrCSAuth);
  3846.    GatherStatistics:=false;
  3847.  
  3848.    // Add an image number sequence.
  3849.    CreateSequence(WABD_IMAGE_SEQUENCE,0,false);
  3850.  
  3851.    StopEvent   := CreateEvent(nil, False, False, nil);
  3852.    GarbageThrd := TGarbageThread.Create(True);
  3853.    GarbageThrd.SesMgr := self;
  3854.    GarbageThrd.FreeOnTerminate := False;
  3855.    GarbageThrd.Resume;
  3856. end;
  3857.  
  3858. destructor TWABD_SessionMgr.Destroy;
  3859. var
  3860.    i:integer;
  3861.    lst:TList;
  3862. begin
  3863.    // Before destruction, save info.
  3864.    if FAutoSave then Save;
  3865.  
  3866.    SetEvent(StopEvent);
  3867.    // TRACE0('Waiting for Garbage Thread');
  3868.    GarbageThrd.WaitFor;
  3869.    // TRACE0('Garbage Thread terminated');
  3870.    CloseHandle(StopEvent);
  3871.  
  3872.    // Free stats.
  3873.    if FStats<>nil then FStats.Free;
  3874.  
  3875.    // Free all sessions.
  3876.    lst:=SessionList.LockList;
  3877.    try
  3878.       for i:=0 to lst.count-1 do
  3879.           DoDestroySession(TWABD_Session(lst.Items[i]));
  3880.       lst.clear;
  3881.    finally
  3882.       SessionList.UnLockList;
  3883.    end;
  3884.  
  3885.    // Delete all global sequences.
  3886.    DeleteAllSequences;
  3887.  
  3888.    // Free remaining variables.
  3889.    FRouteSites.Free;
  3890.    SessionList.Free;
  3891.    GarbageThrd.Free;
  3892.    FVariables.free;
  3893.    FHTMLTimeOut.free;
  3894.    FUniqueList.free;
  3895.    DeleteCriticalSection(SesMgrCSCreate);
  3896.    DeleteCriticalSection(SesMgrCSDestroy);
  3897.    DeleteCriticalSection(SesMgrCSAuth);
  3898.    inherited;
  3899. end;
  3900.  
  3901. function TWABD_SessionMgr.GetVersion:string;
  3902. begin
  3903.      Result:=WABD_VERSION_STR;
  3904. end;
  3905.  
  3906. procedure TWABD_SessionMgr.Save;
  3907. var
  3908.    reg:TRegistry;
  3909.    ini:TIniFile;
  3910.    i,j:integer;
  3911.    s:string;
  3912.    lst:TList;
  3913. begin
  3914.     case Storage of
  3915.         storeNone: ;
  3916.         storeRegistry:
  3917.           begin
  3918.             reg:=TRegistry.Create;
  3919.             if reg.OpenKey('\Software\'+FStoragePath+'\'+FSectionName,true) then
  3920.             begin
  3921.                 reg.WriteInteger('MaxSessions',FMaxSessions);
  3922.                 reg.WriteInteger('MaxIdenticalUser',FMaxIdenticalUser);
  3923.                 reg.WriteBool('GatherStatistics',FGatherStats);
  3924.                 reg.WriteBool('NetworkStatistics',FNetworkStats);
  3925.                 reg.WriteInteger('CheckTimeOutInterval',FCheck);
  3926.                 reg.WriteBool('GarbageCollection',FGarbage);
  3927.                 reg.WriteString('WebAdmin',FWebAdmin);
  3928.                 reg.WriteString('SiteName',FSiteName);
  3929.                 reg.WriteInteger('SiteID',FSiteID);
  3930.                 reg.WriteString('RouteSites',FRouteSites.CommaText);
  3931.                 reg.WriteInteger('RouteWhen',ord(FRouteWhen));
  3932.                 reg.WriteInteger('RouteHow',ord(FRouteHow));
  3933.                 reg.WriteInteger('DefaultSessionTimeout',FDefSesTimeout);
  3934.                 if assigned(FOnSave) then FOnSave(self,FSectionName,reg,nil);
  3935.             end;
  3936.  
  3937.             // Save persistent sequences.
  3938.             if reg.OpenKey('\Software\'+FStoragePath+'\'+FSectionName+'\Sequences',true) then
  3939.             begin
  3940.                  j:=0;
  3941.                  lst:=FUniqueList.LockList;
  3942.                  try
  3943.                     for i:=0 to lst.count-1 do
  3944.                     begin
  3945.                          with PWABD_SequenceRec(lst.Items[i])^ do
  3946.                          begin
  3947.                               if Persistent then
  3948.                               begin
  3949.                                    reg.WriteString(inttostr(j),Name+':'+inttostr(Value));
  3950.                                    inc(j);
  3951.                               end;
  3952.                          end;
  3953.                     end;
  3954.                  finally
  3955.                     FUniqueList.UnlockList;
  3956.                     reg.WriteInteger('Sequences',j);
  3957.                  end;
  3958.             end;
  3959.             reg.free;
  3960.           end;
  3961.         storeIniFile:
  3962.           begin
  3963.             ini:=TIniFile.Create(FStoragePath);
  3964.             if ini<>nil then
  3965.             begin
  3966.                 ini.WriteInteger(FSectionName,'MaxSessions',FMaxSessions);
  3967.                 ini.WriteInteger(FSectionName,'MaxIdenticalUser',FMaxIdenticalUser);
  3968.                 ini.WriteBool(FSectionName,'GatherStatistics',FGatherStats);
  3969.                 ini.WriteBool(FSectionName,'NetworkStatistics',FNetworkStats);
  3970.                 ini.WriteInteger(FSectionName,'CheckTimeOutInterval',FCheck);
  3971.                 ini.WriteBool(FSectionName,'GarbageCollection',FGarbage);
  3972.                 ini.WriteString(FSectionName,'WebAdmin',FWebAdmin);
  3973.                 ini.WriteString(FSectionName,'SiteName',FSiteName);
  3974.                 ini.WriteInteger(FSectionName,'SiteID',FSiteID);
  3975.                 ini.WriteString(FSectionName,'RouteSites',FRouteSites.CommaText);
  3976.                 ini.WriteInteger(FSectionName,'RouteWhen',ord(FRouteWhen));
  3977.                 ini.WriteInteger(FSectionName,'RouteHow',ord(FRouteHow));
  3978.                 ini.WriteInteger(FSectionName,'DefaultSessionTimeout',FDefSesTimeout);
  3979.                 if assigned(FOnSave) then FOnSave(self,FSectionName,nil,ini);
  3980.             end;
  3981.  
  3982.             // Save persistent sequences.
  3983.             s:=FSectionName+' Sequences';
  3984.             j:=0;
  3985.             lst:=FUniqueList.LockList;
  3986.             try
  3987.                for i:=0 to lst.count-1 do
  3988.                begin
  3989.                     with PWABD_SequenceRec(lst.Items[i])^ do
  3990.                     begin
  3991.                          if Persistent then
  3992.                          begin
  3993.                               ini.WriteString(s,inttostr(j),Name+':'+inttostr(Value));
  3994.                               inc(j);
  3995.                          end;
  3996.                     end;
  3997.                end;
  3998.             finally
  3999.                FUniqueList.UnlockList;
  4000.                ini.WriteInteger(s,'Sequences',j);
  4001.             end;
  4002.             ini.free;
  4003.           end;
  4004.     end;
  4005. end;
  4006.  
  4007. procedure TWABD_SessionMgr.Load;
  4008. var
  4009.    reg:TRegistry;
  4010.    ini:TIniFile;
  4011.    s,s1:string;
  4012.    i,j,k:integer;
  4013. begin
  4014.     case Storage of
  4015.         storeNone: ;
  4016.         storeRegistry:
  4017.           begin
  4018.             reg:=TRegistry.Create;
  4019.             if reg.OpenKey('\Software\'+FStoragePath+'\'+FSectionName,false) then
  4020.             begin
  4021.                 FMaxSessions:=reg.ReadInteger('MaxSessions');
  4022.                 FMaxIdenticalUser:=reg.ReadInteger('MaxIdenticalUser');
  4023.                 GatherStatistics:=reg.ReadBool('GatherStatistics');
  4024.                 FNetworkStats:=reg.ReadBool('NetworkStatistics');
  4025.                 FCheck:=reg.ReadInteger('CheckTimeOutInterval');
  4026.                 FGarbage:=reg.ReadBool('GarbageCollection');
  4027.                 FWebAdmin:=reg.ReadString('WebAdmin');
  4028.                 FSiteName:=reg.ReadString('SiteName');
  4029.                 FSiteID:=reg.ReadInteger('SiteID');
  4030.                 FRouteSites.CommaText:=reg.ReadString('RouteSites');
  4031.                 FRouteWhen:=TWABD_RouteWhen(reg.ReadInteger('RouteWhen'));
  4032.                 FRouteHow:=TWABD_RouteHow(reg.ReadInteger('RouteHow'));
  4033.                 FDefSesTimeout:=reg.ReadInteger('DefaultSessionTimeout');
  4034.                 if assigned(FOnLoad) then FOnLoad(self,FSectionName,reg,nil);
  4035.             end;
  4036.  
  4037.             // Load persistent sequences.
  4038.             if reg.OpenKey('\Software\'+FStoragePath+'\'+FSectionName+'\Sequences',false) then
  4039.             begin
  4040.                  j:=reg.ReadInteger('Sequences');
  4041.                  for i:=0 to j-1 do
  4042.                  begin
  4043.                       s1:=reg.ReadString(inttostr(i));
  4044.                       k:=pos(':',s1);
  4045.                       CreateSequence(copy(s1,1,k-1),strtoint(copy(s1,k+1,length(s1))),true);
  4046.                  end;
  4047.             end;
  4048.             reg.free;
  4049.           end;
  4050.         storeIniFile:
  4051.           begin
  4052.             ini:=TIniFile.Create(FStoragePath);
  4053.             if ini<>nil then
  4054.             begin
  4055.                 FMaxSessions:=ini.ReadInteger(FSectionName,'MaxSessions',-1);
  4056.                 FMaxIdenticalUser:=ini.ReadInteger(FSectionName,'MaxIdenticalUser',-1);
  4057.                 GatherStatistics:=ini.ReadBool(FSectionName,'GatherStatistics',true);
  4058.                 FNetworkStats:=ini.ReadBool(FSectionName,'NetworkStatistics',false);
  4059.                 FCheck:=ini.ReadInteger(FSectionName,'CheckTimeOutInterval',60);
  4060.                 FGarbage:=ini.ReadBool(FSectionName,'GarbageCollection',true);
  4061.                 FWebAdmin:=ini.ReadString(FSectionName,'WebAdmin','the Web administrator');
  4062.                 FSiteName:=ini.ReadString(FSectionName,'SiteName','-');
  4063.                 FSiteID:=ini.ReadInteger(FSectionName,'SiteID',0);
  4064.                 FRouteSites.CommaText:=ini.ReadString(FSectionName,'RouteSites','');
  4065.                 FRouteWhen:=TWABD_RouteWhen(ini.ReadInteger(FSectionName,'RouteWhen',0));
  4066.                 FRouteHow:=TWABD_RouteHow(ini.ReadInteger(FSectionName,'RouteHow',0));
  4067.                 FDefSesTimeout:=ini.ReadInteger(FSectionName,'DefaultSessionTimeout',600);
  4068.                 if assigned(FOnLoad) then FOnLoad(self,FSectionName,nil,ini);
  4069.             end;
  4070.  
  4071.             // Load persistent sequences.
  4072.             s:=FSectionName+' Sequences';
  4073.             j:=ini.ReadInteger(s,'Sequences',0);
  4074.             for i:=0 to j-1 do
  4075.             begin
  4076.                  s1:=ini.ReadString(s,inttostr(i),'');
  4077.                  k:=pos(':',s);
  4078.                  if k<=0 then continue;
  4079.                  CreateSequence(copy(s,1,k-1),strtoint(copy(s,k+1,length(s))),true);
  4080.             end;
  4081.             ini.free;
  4082.           end;
  4083.     end;
  4084. end;
  4085.  
  4086. procedure TWABD_SessionMgr.Loaded;
  4087. begin
  4088.     inherited;
  4089.     if SiteID<0 then SiteID:=Random(255); // Max. 256 unique sites.
  4090.     if FAutoLoad then Load;
  4091. end;
  4092.  
  4093. procedure TWABD_SessionMgr.Notification(AComponent: TComponent; Operation: TOperation);
  4094. begin
  4095.      inherited;
  4096.      if (Operation=opRemove) and (AComponent = FAdmin) then FAdmin:=nil;
  4097. end;
  4098.  
  4099. procedure TWABD_SessionMgr.SetSiteID(id:integer);
  4100. begin
  4101.      if (id<-1) or (id>=256) then
  4102.         raise ERangeError.Create('SiteID must be between -1 to 255.');
  4103.      FSiteID:=id;
  4104. end;
  4105.  
  4106. // Called by ISAPI when webserver want to shutdown the DLL.
  4107. function TWABD_SessionMgr.OnTerminateCallback(Flags:longint):boolean;
  4108. begin
  4109.      if Assigned(FOnTerminate) then Result:=FOnTerminate(Flags)
  4110.      else Result:=true;
  4111.      free;
  4112. end;
  4113.  
  4114. // Create a unique global sequence.
  4115. procedure TWABD_SessionMgr.CreateSequence(ID:string; StartValue:longint; Persistent:boolean);
  4116. var
  4117.    p:PWABD_SequenceRec;
  4118.    i:integer;
  4119.    lst:TList;
  4120. begin
  4121.      // Check if its there allready, dont recreate it but adjust startvalue if > old value.
  4122.      lst:=FUniqueList.LockList;
  4123.      try
  4124.         for i:=0 to lst.count-1 do
  4125.         begin
  4126.              with PWABD_SequenceRec(lst.Items[i])^ do
  4127.              begin
  4128.                   if Name=ID then
  4129.                   begin
  4130.                        if StartValue>Value then Value:=StartValue;
  4131.                        exit;
  4132.                   end;
  4133.              end;
  4134.         end;
  4135.      finally
  4136.         FUniqueList.UnlockList;
  4137.      end;
  4138.  
  4139.      // Add new member to the list.
  4140.      GetMem(p,sizeof(TWABD_SequenceRec));
  4141.      p^.Persistent:=Persistent;
  4142.      p^.Name:=StrNew(PChar(ID));
  4143.      p^.Value:=StartValue;
  4144.      FUniqueList.Add(p);
  4145. end;
  4146.  
  4147. // Draw a sequence number from a specified global sequence.
  4148. // Return -1 if sequence not found.
  4149. function TWABD_SessionMgr.DrawSequenceValue(ID:string):longint;
  4150. var
  4151.    i:integer;
  4152.    lst:TList;
  4153. begin
  4154.      Result:=-1;
  4155.      lst:=FUniqueList.LockList;
  4156.      try
  4157.         for i:=0 to lst.count-1 do
  4158.         begin
  4159.              with PWABD_SequenceRec(lst.Items[i])^ do
  4160.              begin
  4161.                   if Name=ID then
  4162.                   begin
  4163.                        Result:=Value;
  4164.                        inc(Value);
  4165.                   end;
  4166.              end;
  4167.         end;
  4168.      finally
  4169.         FUniqueList.UnlockList;
  4170.      end;
  4171. end;
  4172.  
  4173. // Remove global sequence.
  4174. procedure TWABD_SessionMgr.DeleteSequence(ID:string);
  4175. var
  4176.    i:integer;
  4177.    lst:TList;
  4178. begin
  4179.      lst:=FUniqueList.LockList;
  4180.      try
  4181.         for i:=0 to lst.count-1 do
  4182.         begin
  4183.              with PWABD_SequenceRec(lst.Items[i])^ do
  4184.              begin
  4185.                   if Name=ID then
  4186.                   begin
  4187.                        StrDispose(PChar(Name));
  4188.                        FreeMem(lst.Items[i]);
  4189.                        lst.Delete(i);
  4190.                        break;
  4191.                   end;
  4192.              end;
  4193.         end;
  4194.      finally
  4195.         FUniqueList.UnlockList;
  4196.      end;
  4197. end;
  4198.  
  4199. // Remove all global sequences.
  4200. procedure TWABD_SessionMgr.DeleteAllSequences;
  4201. var
  4202.    i:integer;
  4203.    lst:TList;
  4204. begin
  4205.      lst:=FUniqueList.LockList;
  4206.      try
  4207.         for i:=lst.count-1 downto 0 do
  4208.         begin
  4209.              with PWABD_SequenceRec(lst.Items[i])^ do
  4210.              begin
  4211.                   StrDispose(PChar(Name));
  4212.                   FreeMem(lst.Items[i]);
  4213.                   lst.Delete(i);
  4214.              end;
  4215.         end;
  4216.      finally
  4217.         FUniqueList.UnlockList;
  4218.      end;
  4219. end;
  4220.  
  4221. // Setup gathering of statistics.
  4222. procedure TWABD_SessionMgr.SetGatherStats(b:boolean);
  4223. begin
  4224.      if b=FGatherStats then exit;
  4225.  
  4226.      if b then
  4227.      begin
  4228.           if FStats=nil then
  4229.           begin
  4230.                FStats:=TWABD_SesStat.create;
  4231.                FStats.AddGroup(WABD_STATGRP_RESPONSE,wabdStatGroupTurnAround,70);
  4232.                FStats.AddGroup(WABD_STATGRP_NETRESPONSE,wabdStatGroupTurnAround,100);
  4233.                FStats.AddGroup(WABD_STATGRP_SENDSIZE,wabdStatGroupValue,50);
  4234.                FStats.AddGroup(WABD_STATGRP_RECVSIZE,wabdStatGroupValue,50);
  4235.           end;
  4236.      end;
  4237.      FGatherStats:=b;
  4238. end;
  4239.  
  4240. procedure TWABD_SessionMgr.DoDestroySession(Ses: TWABD_Session);
  4241. begin
  4242.    if not Assigned(OnDestroySession) then
  4243.       raise Exception.CreateFmt('DestroySession not defined for %s', [Name]);
  4244.  
  4245.    // Trace0('Before Destroy');
  4246.    EnterCriticalSection(SesMgrCSDestroy);
  4247.    try
  4248.       OnDestroySession(Ses);
  4249.    finally
  4250.       LeaveCriticalSection(SesMgrCSDestroy);
  4251.    end;
  4252.    // Trace0('After Destroy');
  4253. end;
  4254.  
  4255. procedure TWABD_SessionMgr.SetVariables(NewVariables: TStrings);
  4256. begin
  4257.      FVariables.Assign(NewVariables);
  4258. end;
  4259.  
  4260. procedure TWABD_SessionMgr.SetVariableByName(AName,AValue:string);
  4261. var
  4262.    i:integer;
  4263.    s:string;
  4264. begin
  4265.      i:=FVariables.IndexOfName(AName);
  4266.      s:=AName+'='+AValue;
  4267.      if i>=0 then FVariables.strings[i]:=s
  4268.      else FVariables.add(s);
  4269. end;
  4270.  
  4271. function TWABD_SessionMgr.GetVariableByName(AName:string):string;
  4272. begin
  4273.      Result:=FVariables.Values[AName];
  4274. end;
  4275.  
  4276. procedure TWABD_SessionMgr.CheckLogOff(Ses: TWABD_Session);
  4277. begin
  4278.    if Ses.DidLogOff then begin
  4279.       if Assigned(Ses.OnLogOff) then Ses.OnLogOff;
  4280.       SessionList.Remove(Ses);
  4281.       DoDestroySession(Ses);
  4282.    end;
  4283. end;
  4284.  
  4285. // Get sessioncount.
  4286. function TWABD_SessionMgr.GetSessionCount:integer;
  4287. var
  4288.    lst:TList;
  4289. begin
  4290.      lst:=SessionList.LockList;
  4291.      try
  4292.         Result:=lst.count;
  4293.      finally
  4294.         SessionList.UnlockList;
  4295.      end;
  4296. end;
  4297.  
  4298. // Get next route according to setup.
  4299. function TWABD_SessionMgr.GetRoute:string;
  4300. var
  4301.    n:integer;
  4302. begin
  4303.      Result:='';
  4304.      n:=FRouteSites.Count;
  4305.      if (FRouteWhen=rwNever) or (n<=0) then exit;
  4306.  
  4307.      // OK, we can route. Determine to which host.
  4308.      case FRouteHow of
  4309.           rhRandom: FRouteLast:=Random(n);
  4310.           rhRoundRobin:
  4311.              begin
  4312.                   inc(FRouteLast);
  4313.                   if FRouteLast>=n then FRouteLast:=0;
  4314.              end;
  4315.      end;
  4316.      Result:=FRouteSites.Strings[FRouteLast];
  4317. end;
  4318.  
  4319. // Substitute all parameters.
  4320. function TWABD_SessionMgr.ProcessVariables(HTML:string):string;
  4321. begin
  4322.      Result:=Process_Variables(HTML,FVariables);
  4323. end;
  4324.  
  4325. // Check if user is authenticated by basic method.
  4326. function TWABD_SessionMgr.Authenticate(Request:TWABD_CustomRequest; Response:TWABD_CustomResponse;
  4327.          LikeToBeAdmin:boolean; var IsAdmin:boolean):boolean;
  4328. var
  4329.    s:string;
  4330.    r:string;
  4331.    i:integer;
  4332.    auth:boolean;
  4333. begin
  4334.      IsAdmin:=false;
  4335.  
  4336.      // Check if authentication info is given.
  4337.      s:=Request.Auth;
  4338.      if s<>'' then
  4339.      begin
  4340.  
  4341.           // Is it basic?
  4342.           i:=pos(' ',s);
  4343.           if i>0 then
  4344.           begin
  4345.                r:=UpperCase(copy(s,1,i-1));
  4346.                if r='BASIC' then
  4347.                begin
  4348.                     s:=WABD_DecodeBase64(copy(s,i+1,length(s)));
  4349.                     i:=pos(':',s);
  4350.                     Request.UserName:=copy(s,1,i-1);
  4351.                     Request.Password:=copy(s,i+1,length(s));
  4352.                     r:=Request.RemoteHost;
  4353.                     auth:=false;
  4354.  
  4355.                     // If user wants to be admin.
  4356.                     if LikeToBeAdmin then
  4357.                     begin
  4358.                          if assigned(FAdmin) and (Admin.AutoLog>=logLevel1) then
  4359.                             Admin.LogFmt('REQ:User %s (%s) like to be administrator',[Request.UserName,r]);
  4360.                          if Assigned(FAdmin) and assigned(FCreateAdmin)
  4361.                             and (lowercase(FAdmin.FAdminUser)=lowercase(Request.UserName))
  4362.                             and (lowercase(FAdmin.FAdminPassword)=lowercase(Request.Password))
  4363.                             then
  4364.                             begin
  4365.                                  auth:=true;
  4366.                                  IsAdmin:=true;
  4367.                             end;
  4368.                     end
  4369.                     else
  4370.                          if Assigned(FOnAuthenticate) then
  4371.                             FOnAuthenticate(r,Request.UserName,Request.Password,auth);
  4372.                     Result:=auth;
  4373.  
  4374.                     if assigned(FAdmin) and (Admin.AutoLog>=logLevel1) then
  4375.                     begin
  4376.                         if Result then
  4377.                             Admin.LogFmt('REQ:User %s (%s) authenticated',[Request.UserName,r])
  4378.                         else
  4379.                             Admin.LogFmt('REQ:User %s (%s) NOT authenticated',[Request.UserName,r]);
  4380.                     end;
  4381.  
  4382.                     if Result then exit;
  4383.                end;
  4384.           end;
  4385.      end;
  4386.  
  4387.      // If application dont want to authenticate, allow normal users to access site.
  4388.      // But potential administrators always have to identify themselfs.
  4389.      if not (LikeToBeAdmin or Assigned(FOnAuthenticate)) then
  4390.      begin
  4391.           if Request.UserName='' then Request.UserName:=Request.RemoteUser;
  4392.           Result:=true;
  4393.           exit;
  4394.      end;
  4395.  
  4396.      // Force authentication dialog.
  4397.      Response.ContentDesc:=SiteName;
  4398.      Response.Status:=WABD_STATUS_AUTH;
  4399.      Result:=false;
  4400. end;
  4401.  
  4402. // Count sessions with this userid.
  4403. function TWABD_SessionMgr.CountIdenticalUser(UserName:string):integer;
  4404. var
  4405.    i:integer;
  4406.    lst:TList;
  4407. begin
  4408.      Result:=0;
  4409.      UserName:=lowercase(trim(UserName));
  4410.  
  4411.      // Look for the username in the list.
  4412.      lst:=SessionList.LockList;
  4413.      try
  4414.         for i:=0 to lst.count-1 do
  4415.             if lowercase(trim(TWABD_Session(lst.Items[i]).UserName)) = UserName then inc(Result);
  4416.      finally
  4417.         SessionList.UnLockList;
  4418.      end;
  4419. end;
  4420.  
  4421. function TWABD_SessionMgr.CreateNewSession(Request:TWABD_CustomRequest; Response:TWABD_CustomResponse):TWABD_Session;
  4422.    procedure DoRoute(UserName:string);
  4423.    var
  4424.       Site:string;
  4425.    begin
  4426.         Site:=GetRoute;
  4427.         if Site<>'' then
  4428.         begin
  4429.              if assigned(FAdmin) and (Admin.AutoLog>=logLevel1) then
  4430.                 Admin.LogFmt('REQ:Redirecting request for user %s to %s',[UserName,Site]);
  4431.              Response.Response.Clear;
  4432.              Response.Status:=WABD_STATUS_REDIRECT;
  4433.              Response.Location:=Site;
  4434.              exit;
  4435.         end
  4436.    end;
  4437.  
  4438.    function GetRandomSessionID:longint;
  4439.    var
  4440.       i:integer;
  4441.       l:longint;
  4442.       lst:TList;
  4443.    begin
  4444.         lst:=SessionList.LockList;
  4445.         try
  4446.            while true do
  4447.            begin
  4448.                 // Draw number,
  4449.                 l:=random(1 shl 23);
  4450.  
  4451.                 // Check if number already used, then draw another.
  4452.                 for i:=0 to lst.count-1 do
  4453.                     if TWABD_Session(lst.Items[i]).SessionID = l then break;
  4454.  
  4455.                 // No conflict, use the one we have drawn.
  4456.                 Result:=l;
  4457.                 exit;
  4458.            end;
  4459.         finally
  4460.            SessionList.UnlockList;
  4461.         end;
  4462.    end;
  4463. var
  4464.    NewSes : TWABD_Session;
  4465.    LikeToBeAdmin,IsAdmin,Authenticated:boolean;
  4466.    stamp:TDateTime;
  4467.    c:integer;
  4468.    s:string;
  4469.    NewSesID:longint;
  4470. label
  4471.    L_Exit;
  4472. begin
  4473.    if not Assigned(OnCreateSession) then
  4474.       raise Exception.CreateFmt('CreateSession not defined for %s', [Name]);
  4475.  
  4476.    stamp:=now;
  4477.  
  4478.    NewSes := nil;
  4479.    Request.UserName:='';
  4480.    Request.Password:='';
  4481.    Result:=nil;
  4482.  
  4483.    Response.Status:=WABD_STATUS_OK;
  4484.  
  4485.    if assigned(FAdmin) and (Admin.AutoLog>=logLevel2) then
  4486.       Admin.LogFmt('REQ:Creating new session for user %s',[Request.UserName]);
  4487.  
  4488.    // Check if to do sessionmanager based (basic) authentication).
  4489.    LikeToBeAdmin:=(Request.Query.Count>0) and (lowercase(Request.Query.Strings[0])='admin');
  4490.    EnterCriticalSection(SesMgrCSAuth);
  4491.    try
  4492.       Authenticated:=Authenticate(Request,Response,LikeToBeAdmin,IsAdmin);
  4493.    finally
  4494.       LeaveCriticalSection(SesMgrCSAuth);
  4495.    end;
  4496.  
  4497.    // Check if to reroute allways for everyone except administrator.
  4498.    if (FRouteWhen=rwAllways) and (not (IsAdmin or LikeToBeAdmin)) then
  4499.    begin
  4500.         DoRoute(Request.UserName);
  4501.         exit;
  4502.    end;
  4503.  
  4504.    // Check if not authenticated and no guest session defined, exit.
  4505.    if (not Authenticated) and ((Request.UserName='') or (not Assigned(OnCreateGuestSession))) then goto L_exit;
  4506.  
  4507.    // Check limits. Doesnt apply to the administrator.
  4508.    if not IsAdmin then
  4509.    begin
  4510.         // Check if not accepting sessions here. Either reroute or give error.
  4511.         if FMaxSessions=0 then
  4512.         begin
  4513.              // Check if to route.
  4514.              if FRouteWhen=rwWhenFull then
  4515.                 DoRoute(Request.UserName)
  4516.              else
  4517.                  Response.Response.Text:='<BODY><P><H1>Welcome</H1></P><P>'+SiteName+'('+inttostr(SiteID)+') is currently not accepting new sessions.</P><P>Please try later.</P></BODY>';
  4518.              exit;
  4519.         end;
  4520.  
  4521.         // Check if full. Either reroute or give error.
  4522.         if FMaxSessions>0 then
  4523.         begin
  4524.              c:=SessionCount;
  4525.              if c>=FMaxSessions then
  4526.              begin
  4527.                   // Check if to route.
  4528.                   if FRouteWhen=rwWhenFull then
  4529.                      DoRoute(Request.UserName)
  4530.                   else
  4531.                       Response.Response.Text:='<BODY><P><H1>Welcome</H1></P><P>'+SiteName+'('+inttostr(SiteID)+') is currently fully booked. ('+inttostr(c)+' active sessions).</P><P>Please try later.</P></BODY>';
  4532.                   exit;
  4533.              end;
  4534.         end;
  4535.  
  4536.         // Check if to many logins from identical user.
  4537.         if (FMaxIdenticalUser>0) and (CountIdenticalUser(Request.UserName)>=FMaxIdenticalUser) then
  4538.         begin
  4539.              Response.Response.Text:='<BODY><P><H1>Welcome</H1></P><P>'+SiteName+'('+inttostr(SiteID)+') only allow you to be logged in '+inttostr(FMaxIdenticalUser)+' times with the same username.</P><P>If you cant do a proper logout at this time then please wait another 10-20 minutes, and try to logon again.</P></BODY>';
  4540.              exit;
  4541.         end;
  4542.    end;
  4543.  
  4544.    EnterCriticalSection(SesMgrCSCreate);
  4545.    try
  4546.       // Check if to show another form if not authenticated.
  4547.       if not Authenticated then
  4548.          OnCreateGuestSession(NewSes,LikeToBeAdmin,Request)
  4549.       // Check if logged in as admin.
  4550.       else if IsAdmin and Assigned(OnCreateAdminSession) then
  4551.          OnCreateAdminSession(NewSes,Request)
  4552.       // Else an ordinary user.
  4553.       else
  4554.          OnCreateSession(NewSes,Request);
  4555.  
  4556.       Inc(FTotalSessionCount);
  4557.  
  4558.       // If to use randomized session ID, get one.
  4559.       if FRandomSessionID then
  4560.          NewSesID:=GetRandomSessionID
  4561.       else
  4562.          NewSesID:=FTotalSessionCount;
  4563.    finally
  4564.       LeaveCriticalSection(SesMgrCSCreate);
  4565.    end;
  4566.  
  4567.    if NewSes=nil then
  4568.       raise Exception.Create('CreateSession Failed');
  4569.  
  4570.    NewSes.LockSession;
  4571.    try
  4572.        NewSes.FRequest:=Request;
  4573.        NewSes.FResponse:=Response;
  4574.        SessionList.Add(NewSes);
  4575.  
  4576.        // Set properties for new session.
  4577.        NewSes.FInfo:=FInfo;
  4578.        NewSes.FSessionID := (SiteID shl 24) + NewSesID;
  4579.        NewSes.FLastAccess := Now;
  4580.        NewSes.FCreateTime := Now;
  4581.        NewSes.FSessionMgr := self;
  4582.  
  4583.        if NewSes.FTimeLen<0 then NewSes.FTimeLen:=DefaultSessionTimeout;
  4584.  
  4585.        Response.Status:=WABD_STATUS_OK;
  4586.        Result:=NewSes;
  4587.  
  4588.        if Assigned(FOnFirstSes) and (FTotalSessionCount=1) then FOnFirstSes(NewSes);
  4589.  
  4590.        if Assigned(NewSes.BeforeProcessRequest) then NewSes.BeforeProcessRequest(NewSes);
  4591.        Response.Response.Text:=NewSes.ProcessVariables(NewSes.ProcessRequest('',Request));
  4592.        if Assigned(NewSes.AfterProcessRequest) then NewSes.AfterProcessRequest(NewSes);
  4593.  
  4594.        // Check if stateless sessiontype. Then clearout session.
  4595.        if NewSes.Stateless then NewSes.LogOff;
  4596.    finally
  4597.        NewSes.UnlockSession;
  4598.    end;
  4599.  
  4600.    CheckLogOff(NewSes);
  4601.  
  4602. L_Exit:
  4603.    if GatherStatistics then
  4604.    begin
  4605.         if NewSes<>nil then
  4606.            s:='Site:'+inttostr(NewSes.SessionID shr 24) + ' Session ID:'+inttostr(NewSes.SessionID and $FFFFFF)+' (New)'
  4607.         else
  4608.             s:='No session';
  4609.         Stats.AddPoint(WABD_STATGRP_RESPONSE,Request.UserName,s,now-stamp);
  4610.         Stats.AddPoint(WABD_STATGRP_SENDSIZE,Request.UserName,s,length(Response.Response.Text));
  4611.         Stats.AddPoint(WABD_STATGRP_RECVSIZE,Request.UserName,s,Request.Size);
  4612.    end;
  4613. end;
  4614.  
  4615. function TWABD_SessionMgr.LocateSessionByID(ASiteID:integer; ASessionID:longint):TWABD_Session;
  4616. var
  4617.    sList    : TList;
  4618.    i        : integer;
  4619.    ts       : TWABD_Session;
  4620.    l        : longint;
  4621. begin
  4622.    // We have an existing session
  4623.    l:=(ASiteID shl 24) + ASessionID;
  4624.    Result:=nil;
  4625.    sList:=SessionList.LockList;
  4626.    try
  4627.       for i:=0 to sList.Count-1 do
  4628.       begin
  4629.            ts := TWABD_Session(sList.Items[i]);
  4630.            if ts.SessionID = l then
  4631.            begin
  4632.                 Result:=ts;
  4633.                 break;
  4634.            end;
  4635.       end;
  4636.    finally
  4637.       SessionList.UnlockList;
  4638.    end;
  4639. end;
  4640.  
  4641. function TWABD_SessionMgr.RunExistingSession(const IdStr,BodyName:string;
  4642.                                              Request:TWABD_CustomRequest; Response:TWABD_CustomResponse):TWABD_Session;
  4643. var
  4644.    stamp    : TDateTime;
  4645.    s        : string;
  4646.    sid,sesid: longint;
  4647.    l        : longint;
  4648. begin
  4649.    stamp:=now;
  4650.  
  4651.    // Find session.
  4652.    l:=strtoint(IdStr);
  4653.    sid:=l shr 24;
  4654.    sesid:=l and $FFFFFF;
  4655.    Result:=LocateSessionByID(sid,sesid);
  4656.  
  4657.    // Check if session timedout.
  4658.    if Result=nil then
  4659.    begin
  4660.         // Check if HTML code defined for this, then show that.
  4661.         if FHTMLTimeOut.count>0 then
  4662.         begin
  4663.              Response.Response.Text:=FHTMLTimeOut.Text;
  4664.              Response.Status:=WABD_STATUS_OK;
  4665.              exit;
  4666.         end
  4667.         else
  4668.            raise Exception.CreateFmt('Session ID not Found:  %s  (Session may have timed out)', [IdStr]);
  4669.    end;
  4670.  
  4671.    Result.FLastAccess:=Now;
  4672.  
  4673.    if assigned(FAdmin) and (Admin.AutoLog>=logLevel2) then
  4674.       Admin.LogFmt('REQ:Request from site %d, session %d. This site is %d',[Result.SessionID shr 24, Result.SessionID and $FFFFFF,SiteID]);
  4675.  
  4676.    Result.LockSession;
  4677.    try
  4678.       Result.FRequest:=Request;
  4679.       Result.FResponse:=Response;
  4680.  
  4681.       Response.Status:=WABD_STATUS_OK;
  4682.       if Assigned(Result.BeforeProcessRequest) then Result.BeforeProcessRequest(Result);
  4683.       Response.Response.Text := Result.ProcessVariables(Result.ProcessRequest(BodyName,Request));
  4684.       if Assigned(Result.AfterProcessRequest) then Result.AfterProcessRequest(Result);
  4685.  
  4686.       // Check if stateless sessiontype. Then clearout session.
  4687.       if Result.Stateless then Result.LogOff;
  4688.    finally
  4689.       Result.UnlockSession;
  4690.    end;
  4691.  
  4692.    if GatherStatistics then
  4693.    begin
  4694.         s:='Site:'+inttostr(Result.SessionID shr 24) + ' Session ID:'+inttostr(Result.SessionID and $FFFFFF)+' Net address:'+Request.RemoteAddr;
  4695.         Stats.AddPoint(WABD_STATGRP_RESPONSE,Result.UserName,s,now-stamp);
  4696.         Stats.AddPoint(WABD_STATGRP_SENDSIZE,Result.UserName,s,length(Response.Response.Text));
  4697.         Stats.AddPoint(WABD_STATGRP_RECVSIZE,Result.UserName,s,Request.Size);
  4698.         if NetworkStatistics and (Result.CurBody.FClientProcessTime>=0) then
  4699.            Stats.AddPoint(WABD_STATGRP_NETRESPONSE,Result.UserName,s+' Input:'+Request.Query.Text,Result.FCurBody.FClientProcessTime/MSECS);
  4700.    end;
  4701.  
  4702.    CheckLogOff(Result);
  4703. end;
  4704.  
  4705. // Called by interface whenever a request is made from a client.
  4706. procedure TWABD_SessionMgr.ClientRequest(Request:TWABD_CustomRequest; Response:TWABD_CustomResponse);
  4707. var
  4708.    s           : string;
  4709.    IdStr       : string;
  4710.    BodyName    : string;
  4711.    ses         : TWABD_Session;
  4712.    ok          : boolean;
  4713.    cookie      : TWABD_Cookie;
  4714.    handled     : boolean;
  4715. begin
  4716.    ses:=nil;
  4717.    FRequest:=Request;
  4718.    FResponse:=Response;
  4719.    try
  4720.       try
  4721.          Request.DetermineRequestType;
  4722.          VariableByName['SERVERAPP']:=Request.DLLName;
  4723.  
  4724.          // Check if to validate contenttype.
  4725.          ok:=true;
  4726.          if Assigned(FOnValidateRequest) then
  4727.             FOnValidateRequest(Request,Response,ok);
  4728.          if not ok then
  4729.          begin
  4730.               if Response.Response.Count=0 then raise Exception.CreateFmt('Content type ''%s'' not accepted.',[Request.ContentType])
  4731.               else exit;
  4732.          end;
  4733.  
  4734.          // Process request.
  4735.          if assigned(Admin) and (Admin.AutoLog=logAll) then Admin.LogFmt('HEADER:%s, QUERY:%s',[Request.Headers.Text,Request.Query.Text]);
  4736.  
  4737.          // Try to find session string in cookies or form values.
  4738.          IdStr:='';
  4739.          cookie:=Request.Cookies.GetCookieByName(WABD_SES_ID_STR);
  4740.          if (cookie<>nil) then IdStr:=cookie.Value;
  4741.          s:=Request.Query.Values[WABD_SES_ID_STR];
  4742.          if s<>'' then IdStr:=s;
  4743.  
  4744.          // Prepare response.
  4745.          case Request.RequestType of
  4746.               WABD_REQUESTTYPE_UNKNOWN,WABD_REQUESTTYPE_HTML:
  4747.                  Response.ContentType:='text/html';
  4748.               WABD_REQUESTTYPE_WML:
  4749.                  Response.ContentType:='text/vnd.wap.wml';
  4750.               else
  4751.                  Response.ContentType:='text/html';
  4752.          end;
  4753.          Response.ContentDesc:='';
  4754.          Response.Location:='';
  4755.          Response.Cookies.Assign(Request.Cookies);
  4756.  
  4757.          // Determine if new or old session.
  4758.          SplitSessionID(IdStr,IdStr,BodyName);
  4759.          if IdStr<>'' then
  4760.             Ses := RunExistingSession(IdStr, BodyName, Request,Response)
  4761.          else
  4762.             Ses := CreateNewSession(Request,Response);
  4763.  
  4764.          // Format result to match HTTP protocol.
  4765.          Response.Response.Text:=ProcessVariables(Response.Response.Text);
  4766.       except
  4767.          on e: Exception do begin
  4768.             Response.Status:=WABD_STATUS_OK;
  4769.             Response.Response.Clear;
  4770.             handled:=false;
  4771.             if Assigned(FOnException) then
  4772.                FOnException(self,e,handled);
  4773.             if not handled then
  4774.             begin
  4775.                  if Request.RequestType = WABD_REQUESTTYPE_WML then
  4776.                  begin
  4777.                       Response.Response.Add('<?xml version="1.0"?>');
  4778.                       Response.Response.Add('<!DOCTYPE wml PUBLIC "-//WAPFORUM//DTD WML 1.1//EN" "http://www.wapforum.org/DTD/wml_1.1.xml">');
  4779.                       Response.Response.Add('<wml>');
  4780.                       Response.Response.Add('<card name"Exception" title="EXCEPTION" newcontext="true">');
  4781.                       Response.Response.Add('<p><u>OOPS.... An error occured.</u></p><br/>');
  4782.                       Response.Response.Add('<p>Please report this message and what happened to '+WebAdministrator+'.<br/>');
  4783.                       Response.Response.Add('  Site........:<b>'+SiteName+'('+inttostr(SiteID)+')</b><br/>');
  4784.                       Response.Response.Add('  Error.......:<b>'+e.Message+'</b><br/>');
  4785.                       Response.Response.Add('  Application.:<b>'+Request.DLLName+'</b>');
  4786.                       if Ses<>nil then
  4787.                       begin
  4788.                            Response.Response.Add('<br/>  Session site:<b>'+inttostr(Ses.SessionID shr 24)+'</b>');
  4789.                            Response.Response.Add('<br/>  Session ID..:<b>'+inttostr(Ses.SessionID and $FFFFFF)+'</b>');
  4790.                            if Ses.NewBody<>nil then Response.Response.Add('<br/>  Body........:<b>'+Ses.NewBody.Name+'</b>');
  4791.                       end;
  4792.                       Response.Response.Add('</p><hr/><i>'+DateTimeToStr(Now)+'</i>');
  4793.                       Response.Response.Add('</card></wml>');
  4794.                       Response.ContentType:='text/vnd.wap.wml';
  4795.                  end
  4796.                  else
  4797.                  begin
  4798.                       Response.Response.Add('<HTML><BODY><tt><font size=5><u>OOPS.... An error occured.</u></font><br>'+
  4799.                          '<br>Please report this message and what happened to '+WebAdministrator+'.<br>'+
  4800.                          '<br>  Site........:<b>'+SiteName+'('+inttostr(SiteID)+')</b>'+
  4801.                          '<br>  Error.......:<b>'+e.Message+'</b>'+
  4802.                          '<br>  Application.:<b>'+Request.DLLName+'</b>');
  4803.                       if Ses<>nil then
  4804.                       begin
  4805.                            Response.Response.Add('<br>  Session site:<b>'+inttostr(Ses.SessionID shr 24)+'</b>');
  4806.                            Response.Response.Add('<br>  Session ID..:<b>'+inttostr(Ses.SessionID and $FFFFFF)+'</b>');
  4807.                            if Ses.NewBody<>nil then Response.Response.Add('<br>  Body........:<b>'+Ses.NewBody.Name+'</b>');
  4808.                       end;
  4809.                       Response.Response.Add('<br><br><hr><i>'+DateTimeToStr(Now)+'</i><br><hr></tt></BODY></HTML>');
  4810.                       Response.ContentType:='text/html';
  4811.                  end;
  4812.             end;
  4813.          end;
  4814.       end;
  4815.    finally
  4816.       FRequest:=nil;
  4817.       FResponse:=nil;
  4818.    end;
  4819. end;
  4820.  
  4821. procedure TGarbageThread.DoGarbageCollection;
  4822. var
  4823.    sList : TList;
  4824.    i     : integer;
  4825.    s     : TWABD_Session;
  4826.    Elap  : integer;
  4827.    AcceptTimeOut: boolean;
  4828.    s1    : string;
  4829. begin
  4830.    if SesMgr.GarbageCollection = False then exit;
  4831.  
  4832.    // Clean up stat. records.
  4833.    if SesMgr.FStats<>nil then SesMgr.FStats.Clean;
  4834.  
  4835.    if Assigned(SesMgr.OnGarbageCollection) then SesMgr.OnGarbageCollection(SesMgr);
  4836.  
  4837.    sList := SesMgr.SessionList.LockList;
  4838.    try
  4839.       for i := sList.Count-1 downto 0 do begin
  4840.          s := TWABD_Session(sList.Items[i]);
  4841.  
  4842.          // If the session want to get a garbagecollection signal whether or not it is due to timeout.
  4843.          if Assigned(s.OnGarbageCollection) then s.OnGarbageCollection(SesMgr);
  4844.  
  4845.          // Calculate elapsed time since last access.
  4846.          Elap := Round((Now - s.FLastAccess) * 24.0 * 3600.0);
  4847.          if Elap > s.TimeOutLength then begin
  4848.  
  4849.             // Ask politely if to accept timeout.
  4850.             AcceptTimeOut:=true;
  4851.             if Assigned(s.OnTimeOut) then s.OnTimeOut(SesMgr,Elap,AcceptTimeOut);
  4852.             if not AcceptTimeOut then
  4853.                s1:='NOT ACCEPTED'
  4854.             else
  4855.                s1:='ACCEPTED';
  4856.  
  4857.             // If session accepts timeout, time it out.
  4858.             if AcceptTimeOut then
  4859.             begin
  4860.                SesMgr.DoDestroySession(s);
  4861.                sList.Delete(i);
  4862.             end;
  4863.          end;
  4864.       end;
  4865.    finally
  4866.       SesMgr.SessionList.UnlockList;
  4867.    end;
  4868. end;
  4869.  
  4870. procedure TGarbageThread.Execute;
  4871. var
  4872.    rc : integer;
  4873. begin
  4874.    repeat
  4875.       rc := WaitForSingleObject(SesMgr.StopEvent, SesMgr.FCheck * 1000);
  4876.       if rc = WAIT_TIMEOUT    then DoGarbageCollection;
  4877.    until rc <> WAIT_TIMEOUT;
  4878. end;
  4879.  
  4880.  
  4881. // ************************************************************************
  4882. // TWABD_Session
  4883. // ************************************************************************
  4884.  
  4885. constructor TWABD_Admin.Create(AOwner: TComponent);
  4886. begin
  4887.    inherited;
  4888.    FAdminUser:='admin';
  4889.    FAdminPassword:='password';
  4890.    FLogoutHTML:='<CENTER><P><FONT SIZE=5><B>Bye. Have a nice day.</B></FONT></P></CENTER>';
  4891.    InitializeCriticalSection(LogCS);
  4892. end;
  4893.  
  4894. destructor TWABD_Admin.Destroy;
  4895. begin
  4896.     // Before destruction, save info.
  4897.     if FAutoSave then Save;
  4898.     DeleteCriticalSection(LogCS);
  4899.     inherited;
  4900. end;
  4901.  
  4902. procedure TWABD_Admin.Save;
  4903. var
  4904.    reg:TRegistry;
  4905.    ini:TIniFile;
  4906. begin
  4907.     // Before destruction, save info.
  4908.     case Storage of
  4909.         storeNone: ;
  4910.         storeRegistry:
  4911.           begin
  4912.             reg:=TRegistry.Create;
  4913.             if reg.OpenKey('\Software\'+FStoragePath+'\'+FSectionName,true) then
  4914.             begin
  4915.                 reg.WriteString('LogFile',LogFile);
  4916.                 reg.WriteString('AdminUser',AdminUser);
  4917.                 reg.WriteString('AdminPassword',AdminPassword);
  4918.                 if assigned(FOnSave) then FOnSave(self,FSectionName,reg,nil);
  4919.             end;
  4920.             reg.free;
  4921.           end;
  4922.         storeIniFile:
  4923.           begin
  4924.             ini:=TIniFile.Create(FStoragePath);
  4925.             if ini<>nil then
  4926.             begin
  4927.                 ini.WriteString(FSectionName,'LogFile',LogFile);
  4928.                 ini.WriteString(FSectionName,'AdminUser',AdminUser);
  4929.                 ini.WriteString(FSectionName,'AdminPassword',AdminPassword);
  4930.                 if assigned(FOnSave) then FOnSave(self,FSectionName,nil,ini);
  4931.             end;
  4932.             ini.free;
  4933.           end;
  4934.     end;
  4935. end;
  4936.  
  4937. procedure TWABD_Admin.Load;
  4938. var
  4939.    reg:TRegistry;
  4940.    ini:TIniFile;
  4941. begin
  4942.     case Storage of
  4943.         storeNone: ;
  4944.         storeRegistry:
  4945.           begin
  4946.             reg:=TRegistry.Create;
  4947.             if reg.OpenKey('\Software\'+FStoragePath+'\'+FSectionName,false) then
  4948.             begin
  4949.                 LogFile:=reg.ReadString('LogFile');
  4950.                 AdminUser:=reg.ReadString('AdminUser');
  4951.                 AdminPassword:=reg.ReadString('AdminPassword');
  4952.                 if assigned(FOnLoad) then FOnLoad(self,FSectionName,reg,nil);
  4953.             end;
  4954.             reg.free;
  4955.           end;
  4956.         storeIniFile:
  4957.           begin
  4958.             ini:=TIniFile.Create(FStoragePath);
  4959.             if ini<>nil then
  4960.             begin
  4961.                 LogFile:=ini.ReadString(FSectionName,'LogFile','');
  4962.                 AdminUser:=ini.ReadString(FSectionName,'AdminUser','admin');
  4963.                 AdminPassword:=ini.ReadString(FSectionName,'AdminPassword','password');
  4964.                 if assigned(FOnLoad) then FOnLoad(self,FSectionName,nil,ini);
  4965.             end;
  4966.             ini.free;
  4967.           end;
  4968.     end;
  4969. end;
  4970.  
  4971. procedure TWABD_Admin.Loaded;
  4972. begin
  4973.     inherited;
  4974.     if FAutoLoad then Load;
  4975. end;
  4976.  
  4977. function TWABD_Admin.GetLogging:boolean;
  4978. begin
  4979.     Result:=FLogging and (LogFile<>'');
  4980. end;
  4981.  
  4982. procedure TWABD_Admin.LogFmt(fmt:string; args:array of const);
  4983. var
  4984.    f:TextFile;
  4985. begin
  4986.    if not Logging then exit;
  4987.  
  4988.    EnterCriticalSection(LogCS);
  4989.    try
  4990.       assignfile(f,LogFile);
  4991.       try
  4992.          append(f);
  4993.       except
  4994.          rewrite(f);
  4995.       end;
  4996.       writeln(f,datetimetostr(Now)+' '+format(fmt,args));
  4997.       CloseFile(f);
  4998.    finally
  4999.       LeaveCriticalSection(LogCS);
  5000.    end;
  5001. end;
  5002.  
  5003. procedure TWABD_Admin.Log(Text:string);
  5004. begin
  5005.      LogFmt('%s',[Text]);
  5006. end;
  5007.  
  5008. constructor TWABD_Session.Create(AOwner: TComponent);
  5009. begin
  5010.    inherited;
  5011.    TimeOutLength := 600;
  5012.    FVariables := TStringList.create;
  5013.    FQueryFields:=TStringList.Create;
  5014.    FHitCount := 0;
  5015.    FStateless := false;
  5016.    FEnableCookies := true;
  5017.    FSemaphore:=CreateSemaphore(nil,1,1,nil);
  5018.    FProduce:=prodHTML;
  5019. end;
  5020.  
  5021. destructor TWABD_Session.Destroy;
  5022. begin
  5023.    FVariables.Free;
  5024.    FQueryFields.Free;
  5025.    CloseHandle(FSemaphore);
  5026.    inherited;
  5027. end;
  5028.  
  5029. function TWABD_Session.GetVersion:string;
  5030. begin
  5031.      Result:=WABD_VERSION_STR;
  5032. end;
  5033.  
  5034. // Lock this session to synchronize access to it.
  5035. procedure TWABD_Session.LockSession;
  5036. var
  5037.    n:DWORD;
  5038. begin
  5039.      inc(FLockCount);
  5040.      n:=WaitForSingleObject(FSemaphore,WABD_SEMAPHORE_TIMEOUT);
  5041.      if (n=WAIT_TIMEOUT) or (n=WAIT_FAILED) then
  5042.      begin
  5043. //s:=inttostr(OwnerID)+':'+inttostr(FQueueLength)+':Connection lock timed failed.';
  5044. //OutputDebugString(PChar(s));
  5045.           dec(FLockCount);
  5046.      end;
  5047. end;
  5048.  
  5049. procedure TWABD_Session.UnlockSession;
  5050. begin
  5051.      if FLockCount<=0 then
  5052.      begin
  5053.           FLockCount:=0;
  5054.           exit;
  5055.      end;
  5056.      dec(FLockCount);
  5057.      ReleaseSemaphore(FSemaphore,1,nil);
  5058. end;
  5059.  
  5060. // Get username for this session.
  5061. function TWABD_Session.GetSesUserName:string;
  5062. begin
  5063.      Result:=FUserName;
  5064.      if (Result='') and (FRequest<>nil) then Result:=FRequest.RemoteUser;
  5065. end;
  5066.  
  5067. // Get password for this session.
  5068. function TWABD_Session.GetSesPassword:string;
  5069. begin
  5070.      Result:=FPassword;
  5071. end;
  5072.  
  5073. // Check if to initiate Form authentication of user.
  5074. function TWABD_Session.Authenticate:boolean;
  5075. begin
  5076.      Result:=true;
  5077.  
  5078.      // Dont authenticate.
  5079.      if not Assigned(FAuthBody) then exit;
  5080.  
  5081.      // Show authentication form.
  5082.      FCurBody:=AuthBody;
  5083.      Result:=false;
  5084. end;
  5085.  
  5086. procedure TWABD_Session.SendFile(ContentType,FileName,AsFileName:string);
  5087. var
  5088.    s:string;
  5089.    hf:integer;
  5090.    buffer:string;
  5091.    cbuffer:array [0..2047] of char;
  5092.    n:integer;
  5093. begin
  5094. (*
  5095.      CurLocation:=filename;
  5096.  
  5097.      // Redirect page to myself with the DOWNLOAD flag set.
  5098.      CurLocation:=format('%s/%s?%s=%d:&%s=%s&FILE=%s&ASFILE=%s',
  5099.         [DllName,asfilename,WABD_SES_ID_STR,SessionID,WABD_DOWNLOAD_STR,ctype,filename,asfilename]);
  5100. *)
  5101.  
  5102.    // Open file and figure out its size.
  5103.    hf:=FileOpen(FileName, fmOpenRead+fmShareDenyWrite);
  5104. {$ifdef LEVEL6}
  5105.    if hf<0 then RaiseLastOSError;
  5106. {$else}
  5107.    if hf<0 then RaiseLastWin32Error;
  5108. {$endif}
  5109.    FileSeek(hf,0,2);
  5110.    FileSeek(hf,0,0);
  5111.  
  5112.    // Loop until whole file has been written to webstream.
  5113.    s:='';
  5114.    while true do begin
  5115.       n:=FileRead(hf,cbuffer,2048);
  5116. {$ifdef LEVEL6}
  5117.       if n<0 then RaiseLastOSError;
  5118. {$else}
  5119.       if n<0 then RaiseLastWin32Error;
  5120. {$endif}
  5121.       if n>0 then
  5122.       begin
  5123.            SetString(buffer,cbuffer,n);
  5124.            s:=s+buffer;
  5125.       end;
  5126.       if n<2048 then break;
  5127.    end;
  5128.  
  5129.    // Done with it, close file.
  5130.    FileClose(hf);
  5131.  
  5132.    // Override normal response.
  5133.    Response.ContentType:=ContentType;
  5134.    Response.ContentDesc:=AsFileName;
  5135.    Response.Response.Text:=s;
  5136.    Response.OverrideStandardResponse:=true;
  5137. end;
  5138.  
  5139. procedure TWABD_Session.SetVariables(NewVariables: TStrings);
  5140. begin
  5141.      FVariables.Assign(NewVariables);
  5142. end;
  5143.  
  5144. procedure TWABD_Session.SetVariableByName(AName,AValue:string);
  5145. var
  5146.    i:integer;
  5147.    s:string;
  5148. begin
  5149.      i:=FVariables.IndexOfName(AName);
  5150.      s:=AName+'='+AValue;
  5151.      if i>=0 then FVariables.strings[i]:=s
  5152.      else FVariables.add(s);
  5153. end;
  5154.  
  5155. function TWABD_Session.GetVariableByName(AName:string):string;
  5156. begin
  5157.      Result:=FVariables.Values[AName];
  5158. end;
  5159.  
  5160. procedure TWABD_Session.SetCookies(NewCookies: TWABD_Cookies);
  5161. begin
  5162.      FResponse.Cookies.Assign(NewCookies);
  5163. end;
  5164.  
  5165. function TWABD_Session.GetCookies:TWABD_Cookies;
  5166. begin
  5167.      Result:=FResponse.Cookies;
  5168. end;
  5169.  
  5170. procedure TWABD_Session.SetCookieByName(AName,AValue:string);
  5171. var
  5172.    c:TWABD_Cookie;
  5173. begin
  5174.      c:=FResponse.Cookies.GetCookieByName(AName);
  5175.      if (c<>nil) then
  5176.         c.Value:=AValue
  5177.      else
  5178.          FResponse.Cookies.Add(AName,AValue);
  5179. end;
  5180.  
  5181. function TWABD_Session.GetCookieByName(AName:string):string;
  5182. var
  5183.    c:TWABD_Cookie;
  5184. begin
  5185.      c:=FResponse.Cookies.GetCookieByName(AName);
  5186.      if (c<>nil) then
  5187.         Result:=c.Value
  5188.      else
  5189.         Result:='';
  5190. end;
  5191.  
  5192. procedure TWABD_Session.SetQueryFields(NewQueryFields:TStrings);
  5193. begin
  5194.      FQueryFields.Assign(NewQueryFields);
  5195. end;
  5196.  
  5197. procedure TWABD_Session.SetQueryFieldByName(AName,AValue:string);
  5198. var
  5199.    i:integer;
  5200.    s:string;
  5201. begin
  5202.      i:=FQueryFields.IndexOfName(AName);
  5203.      s:=AName+'='+AValue;
  5204.      if i>=0 then FQueryFields.strings[i]:=s
  5205.      else FQueryFields.add(s);
  5206. end;
  5207.  
  5208. function TWABD_Session.GetQueryFieldByName(AName:string):string;
  5209. begin
  5210.      Result:=FQueryFields.Values[AName];
  5211. end;
  5212.  
  5213. // Substitute all variables.
  5214. function TWABD_Session.ProcessVariables(HTML:string):string;
  5215. begin
  5216.      Result:=Process_Variables(HTML,FVariables);
  5217. end;
  5218.  
  5219. procedure TWABD_Session.Notification(AComponent: TComponent; Operation: TOperation);
  5220. begin
  5221.    inherited;
  5222.    if (Operation = opRemove) then
  5223.    begin
  5224.         if (AComponent = MainBody) then FMainBody := nil
  5225.         else if (AComponent = AuthBody) then FAuthBody := nil;
  5226.    end;
  5227. end;
  5228.  
  5229. function TWABD_Session.ProcessRequest(BodyName:string; Request:TWABD_CustomRequest): string;
  5230. var
  5231.    b: TWABD_Body;
  5232.    o: TObject;
  5233.    h: boolean;
  5234. begin
  5235.    inc(FHitCount);
  5236.  
  5237.    FRequest:=Request;
  5238.  
  5239.    if FDetermineBrowser then Request.DetermineBrowser;
  5240.  
  5241.    if BodyName='' then
  5242.    begin
  5243.  
  5244.       // This is a new logon
  5245.       if not Assigned(MainBody) then
  5246.          raise Exception.CreateFmt('MainBody not defined for Session: %s', [Name]);
  5247.  
  5248.       MainBody.FWSession := self;
  5249.       NewBody := MainBody;
  5250.  
  5251.       if Assigned(OnFirstLogon) then OnFirstLogon(FRequest.RemoteHost); // NewBody might change
  5252.       if Assigned(OnRequest) then OnRequest(Self,true);
  5253.       FCurBody := NewBody;
  5254.  
  5255.       // Check if to do session based authentication (form authentication).
  5256.       Authenticate;
  5257.  
  5258.       if CurBody<>nil then
  5259.       begin
  5260.            CurBody.FIsReload:=false;
  5261.            CurBody.FWSession := self;
  5262.  
  5263.            // If an exception occurs, let program intercept.
  5264.            try
  5265.               if (FProduce=prodHTML) or ((FProduce=prodAuto) and (Request.RequestType<>WABD_REQUESTTYPE_WML)) then
  5266.                  Result:=CurBody.Object_To_HTML
  5267.               else
  5268.                   Result:=CurBody.Object_To_WML;
  5269.               if CurBody.FUseSessionCookie then CurBody.CreateSessionCookie;
  5270.            except
  5271.               h:=false;
  5272.               if assigned(FExcept) then FExcept(self,Exception(ExceptObject),h);
  5273.               if not h then raise;
  5274.               if FNewBody<>FCurBody then
  5275.               begin
  5276.                    FCurBody:=FNewBody;
  5277.                    if (FProduce=prodHTML) or ((FProduce=prodAuto) and (Request.RequestType<>WABD_REQUESTTYPE_WML)) then
  5278.                       Result:=CurBody.Object_To_HTML
  5279.                    else
  5280.                       Result:=CurBody.Object_To_WML;
  5281.               end;
  5282.            end;
  5283.       end;
  5284.  
  5285.    end else begin
  5286.       // If request procedure, call it.
  5287.       if Assigned(OnRequest) then OnRequest(Self,false);
  5288.  
  5289.       try
  5290.          // Look for body to handle input.
  5291.          assert(Owner<>nil,'Session has no owner: '+Name);
  5292.          o:=FindComponentRecursive(Owner, BodyName);
  5293.  
  5294.          // Look through all datamodules owned by owner to find component matching name.
  5295.          assert(o<>nil,'Body '+BodyName+' couldnt be found for session: '+Name);
  5296.          assert(o is TWABD_Body, BodyName+' is invalid body component.');
  5297.          b:=TWABD_Body(o);
  5298.          FCurBody:=b;
  5299.  
  5300.          // If just to reload page without submitting new values, do that.
  5301.          CurBody.FIsReload:=(not (Request.Query.Values[WABD_RELOAD_STR]<>'Yes')) or (Request.Query.IndexOfName(WABD_FRAME_STR)>=0);
  5302.  
  5303.          // Let body process the input.
  5304.          NewBody := CurBody;
  5305.          CurBody.FWSession := self;
  5306.          CurBody.ProcessRequest(Request);
  5307.  
  5308.          // If changed body.
  5309.          if Response.OverrideStandardResponse then Result:=Response.Response.Text
  5310.          else
  5311.          begin
  5312.               if CurBody<>nil then
  5313.               begin
  5314.                    FCurBody:=NewBody;
  5315.                    CurBody.FWSession := self;
  5316.  
  5317.                    // If an exception occurs, let program intercept.
  5318.                    if (FProduce=prodHTML) or ((FProduce=prodAuto) and (Request.RequestType<>WABD_REQUESTTYPE_WML)) then
  5319.                       Result:=CurBody.Object_To_HTML
  5320.                    else
  5321.                        Result:=CurBody.Object_To_WML;
  5322.                    if CurBody.FUseSessionCookie then CurBody.CreateSessionCookie;
  5323.               end
  5324.               else Result:='';
  5325.          end;
  5326.       except
  5327.          h:=false;
  5328.          if assigned(FExcept) then FExcept(self,Exception(ExceptObject),h);
  5329.          if (not h) or (FNewBody=nil) then raise;
  5330.          if FNewBody<>FCurBody then
  5331.          begin
  5332.               FCurBody:=FNewBody;
  5333.               if (FProduce=prodHTML) or ((FProduce=prodAuto) and (Request.RequestType<>WABD_REQUESTTYPE_WML)) then
  5334.                  Result:=CurBody.Object_To_HTML
  5335.               else
  5336.                  Result:=CurBody.Object_To_WML;
  5337.          end;
  5338.       end;
  5339.    end;
  5340.  
  5341.    FLastAccess := Now;
  5342. end;
  5343.  
  5344. procedure TWABD_Session.LogOff;
  5345. begin
  5346.    DidLogOff := True;
  5347. end;
  5348.  
  5349. procedure TWABD_Session.Loaded;
  5350. var
  5351.    c : TComponent;
  5352.    i : integer;
  5353. begin
  5354.    inherited;
  5355.    Assert(Owner<>nil, Format('TWABD_Session %s has no owner', [Name]));
  5356.    for i := 0 to Owner.ComponentCount-1 do begin
  5357.       c := Owner.Components[i];
  5358.       if c is TWABD_Body then (c as TWABD_Body).Session := self
  5359.       else if c is TWABD_Javascript then (c as TWABD_Javascript).Session:=self;
  5360.    end;
  5361. end;
  5362.  
  5363.  
  5364. // ************************************************************************
  5365. // TWABD_Object
  5366. // ************************************************************************
  5367.  
  5368. constructor TWABD_Object.Create(AOwner: TComponent);
  5369. begin
  5370.    inherited;
  5371.    FVisible := True;
  5372.    FOrder   := -1;
  5373.    InLoaded := False;
  5374. end;
  5375.  
  5376. destructor TWABD_Object.Destroy;
  5377. begin
  5378.    if FParent<>nil then FParent.FWABD_Objs.Remove(Self);
  5379.    inherited;
  5380. end;
  5381.  
  5382. procedure TWABD_Object.Notification(AComponent: TComponent; Operation: TOperation);
  5383. begin
  5384.    inherited;
  5385.    if (Operation = opRemove) then
  5386.    begin
  5387.         if AComponent=FDependingOn then FDependingOn:=nil;
  5388.    end;
  5389. end;
  5390.  
  5391. // Format a HRef anchor.
  5392. function TWABD_Object.GetHRef(Body:TWABD_Body; Component:TWABD_Object; WabdType,Data:string):string;
  5393. begin
  5394.      if Session<>nil then
  5395.      begin
  5396.           if Data<>'' then Data:='&'+WABD_DATA_STR+'='+Data;
  5397.           Result := Format('%s?%s='+WABD_SES_ID_STR_FORMAT+'&%s=%s%s',
  5398.              [DLLName,WABD_SES_ID_STR, Session.SessionID,Body.Name,WabdType,Component.Name,Data]);
  5399.      end
  5400.      else
  5401.          Result:='';
  5402. end;
  5403.  
  5404. procedure TWABD_Object.SetParent(NewParent: TWABD_Parent);
  5405. begin
  5406.    if NewParent=FParent then exit;
  5407.  
  5408.    if FParent<>nil then begin
  5409.       Assert(FParent.FWABD_Objs<>nil, 'FParent.WABD_Objs = nil');
  5410.       FParent.FWABD_Objs.Remove(Self);
  5411.    end;
  5412.  
  5413.    FParent := NewParent;
  5414.    if FParent<>nil then begin
  5415. //showmessage('Inloaded='+inttostr(ord(InLoaded))+' True='+inttostr(ord(true))+' Name='+Name+' Parent='+Parent.name+' Order='+inttostr(Forder));
  5416. //      if (FOrder<>-1) and (InLoaded) then begin
  5417.       if (FOrder<>-1) then begin
  5418.          Assert(FParent.FWABD_Objs<>nil, 'FParent.WABD_Objs = nil');
  5419.          if FParent.FWABD_Objs.Count < Forder+1 then FParent.FWABD_Objs.Count := FOrder+1;
  5420.          FParent.FWABD_Objs.Items[FOrder] :=  Self;
  5421.       end else begin
  5422.          FParent.FWABD_Objs.Add(Self);
  5423.       end;
  5424.    end;
  5425. end;
  5426.  
  5427. function TWABD_Object.GetOrder: integer;
  5428. begin
  5429.   if FParent <> nil then begin
  5430.     Assert(FParent.FWABD_Objs<>nil, 'FParent.WABD_Objs = nil');
  5431.     Result := FParent.FWABD_Objs.IndexOf(Self);
  5432.    end else begin
  5433.     Result := -1;
  5434.    end;
  5435. end;
  5436.  
  5437. procedure TWABD_Object.SetOrder(NewOrder: integer);
  5438. var
  5439.    Count    : integer;
  5440.    CurOrder : integer;
  5441. begin
  5442.    if csLoading in ComponentState then begin
  5443.       FOrder := NewOrder;
  5444.    end else begin
  5445.       CurOrder := GetOrder;
  5446.       if CurOrder >= 0 then begin
  5447.          Assert(FParent<>nil, 'FParent = nil');
  5448.          Count := FParent.FWABD_Objs.Count;
  5449.          if NewOrder < 0 then NewOrder := 0;
  5450.          if NewOrder >= Count then NewOrder := Count - 1;
  5451.          if NewOrder <> CurOrder then begin
  5452.             Assert(FParent.FWABD_Objs<>nil, 'FParent.WABD_Objs = nil');
  5453.             FParent.FWABD_Objs.Delete(CurOrder);
  5454.             FParent.FWABD_Objs.Insert(NewOrder, Self);
  5455.          end;
  5456.       end;
  5457.    end;
  5458. end;
  5459.  
  5460. procedure TWABD_Object.SetVisible(b: boolean);
  5461. begin
  5462.    if b<>FVisible then begin
  5463.       FVisible := b;
  5464.       Changed;
  5465.    end;
  5466. end;
  5467.  
  5468. function TWABD_Object.GetVisible:boolean;
  5469. begin
  5470.     Result:=FVisible;
  5471.     if FDependingOn<>nil then Result:=FDependingOn.Visible;
  5472. end;
  5473.  
  5474. procedure TWABD_Object.SetName(const Value: TComponentName);
  5475. var
  5476.    OldName, NewName  : string;
  5477.    ParForm           : TWABD_Form;
  5478. begin
  5479.    OldName := Name;
  5480.    NewName := Value;
  5481.    inherited;
  5482.    Changed;
  5483.  
  5484.    if (not (csLoading in ComponentState)) then begin
  5485.       ParForm := GetParentForm;
  5486.       if ParForm<>nil then begin
  5487.          if Assigned(ParForm.OnChildNameChanged) then
  5488.             ParForm.OnChildNameChanged(Self, OldName, NewName);
  5489.       end;
  5490.    end;
  5491. end;
  5492.  
  5493. procedure TWABD_Object.Changed;
  5494. begin
  5495.    if Assigned(OnChange) then OnChange(Self);
  5496. end;
  5497.  
  5498. function TWABD_Object.GetParentForm: TWABD_Form;
  5499. var
  5500.    tmp : TWABD_Parent;
  5501. begin
  5502.    tmp := Parent;
  5503.    while (tmp<>nil) and (not (tmp is TWABD_Form)) do tmp := tmp.Parent;
  5504.    Result := TWABD_Form(tmp);
  5505. end;
  5506.  
  5507. function TWABD_Object.GetSession: TWABD_Session;
  5508. var
  5509.     oc:TWABD_Object;
  5510. begin
  5511.      Result:=nil;
  5512.      oc:=self;
  5513.      while (oc<>nil) do
  5514.      begin
  5515.           if (oc is TWABD_Javascript) then
  5516.           begin
  5517.                Result:=TWABD_Javascript(oc).Session;
  5518.                exit;
  5519.           end
  5520.           else if (oc is TWABD_Form) then
  5521.           begin
  5522.                Result:=TWABD_Form(oc).Session;
  5523.                exit;
  5524.           end
  5525.           else if (oc is TWABD_Frameset) then
  5526.           begin
  5527.                Result:=TWABD_Frameset(oc).Session;
  5528.                exit;
  5529.           end;
  5530.           oc:=oc.Parent;
  5531.      end;
  5532.  {
  5533.      c:=self;
  5534.      while c.Owner<>nil do c:=c.Owner;
  5535.      for i:=0 to c.componentcount do
  5536.         if c.components[i] is TWABD_Session then
  5537.         begin
  5538.             Result:=c.components[i] as TWABD_Session;
  5539.             exit;
  5540.         end;
  5541. }
  5542. end;
  5543.  
  5544. function TWABD_Object.GetSessionID: longint;
  5545. var
  5546.     ses:TWABD_Session;
  5547. begin
  5548.      Result:=-1;
  5549.      ses:=Session;
  5550.      if ses=nil then exit;
  5551.      Result:=ses.SessionID;
  5552. end;
  5553.  
  5554. function TWABD_Object.GetDLLName: string;
  5555. var
  5556.     ses: TWABD_Session;
  5557. begin
  5558.      Result:='Unknown';
  5559.      ses:=Session;
  5560.      if (ses<>nil) and (ses.Request<>nil) then Result:=extractfilename(ses.Request.DllName);
  5561. end;
  5562.  
  5563. procedure TWABD_Object.DefineProperties(Filer: TFiler);
  5564. begin
  5565.    inherited;
  5566.    Filer.DefineProperty('ParentAndOrder', ReadParentName, WriteParentName, True);
  5567. end;
  5568.  
  5569. procedure TWABD_Object.ReadParentName(Reader: TReader);
  5570. begin
  5571.    Reader.ReadListBegin;
  5572.    FParentName := Reader.ReadString;
  5573.    Order := Reader.ReadInteger;
  5574.    Reader.ReadListEnd;
  5575. end;
  5576.  
  5577. procedure TWABD_Object.WriteParentName(Writer: TWriter);
  5578. begin
  5579.    Writer.WriteListBegin;
  5580.    if Parent<>nil then
  5581.       Writer.WriteString(Parent.Name)
  5582.    else
  5583.       Writer.WriteString('');
  5584.    Writer.WriteInteger(Order);
  5585.    Writer.WriteListEnd;
  5586. end;
  5587.  
  5588. procedure TWABD_Object.Loaded;
  5589. begin
  5590.    inherited;
  5591.    InLoaded := True;
  5592.    Assert(Owner<>nil, 'Owner = nil');
  5593.    Parent := Owner.FindComponent(FParentName) as TWABD_Parent;
  5594.    InLoaded := False;
  5595. end;
  5596.  
  5597. procedure TWABD_Object.SaveHTMLToFile(AFile:string);
  5598. var
  5599.    f:TextFile;
  5600.    s:string;
  5601. begin
  5602.      s:=Object_To_HTML;
  5603.      AssignFile(f,AFile);
  5604.      try
  5605.         Rewrite(f);
  5606.         Write(f,s);
  5607.      finally
  5608.         CloseFile(f);
  5609.      end;
  5610. end;
  5611.  
  5612. procedure TWABD_Object.SaveWMLToFile(AFile:string);
  5613. var
  5614.    f:TextFile;
  5615.    s:string;
  5616. begin
  5617.      s:=Object_To_WML;
  5618.      AssignFile(f,AFile);
  5619.      try
  5620.         Rewrite(f);
  5621.         Write(f,s);
  5622.      finally
  5623.         CloseFile(f);
  5624.      end;
  5625. end;
  5626.  
  5627. function TWABD_Object.Object_To_WML:string;
  5628. begin
  5629.      Result:='';
  5630. end;
  5631.  
  5632. function TWABD_Object.Object_To_WML_Postfield:string;
  5633. begin
  5634.      Result:='';
  5635. end;
  5636.  
  5637. // ************************************************************************
  5638. // TWABD_Parent
  5639. // ************************************************************************
  5640.  
  5641. constructor TWABD_Parent.Create(AOwner: TComponent);
  5642. begin
  5643.    inherited;
  5644.    FWABD_Objs := TList.Create;
  5645. end;
  5646.  
  5647. destructor TWABD_Parent.Destroy;
  5648. var
  5649.    i     : integer;
  5650.    Child : TWABD_Object;
  5651. begin
  5652.    // TRACE('BEGIN DESTROYING Parent:  %s (%s)', [Name, ClassName]);
  5653.    // This loop MUST go backwards because the child objects remove
  5654.    // *themselves* from the list we are iterating
  5655.    for i := FWABD_Objs.Count-1 downto 0 do begin
  5656.       Child := FWABD_Objs[i];
  5657.       Child.FParent := nil;      // Must use the non-property Parent variable
  5658.       Child.Free;
  5659.    end;
  5660.    // TRACE('END DESTROYING Parent:  %s (%s)', [Name, ClassName]);
  5661.    // TRACE0('');
  5662.  
  5663.    FWABD_Objs.Free;
  5664.    inherited;
  5665. end;
  5666.  
  5667. function TWABD_Parent.GetWABDObjects(i: integer): TWABD_Object;
  5668. begin
  5669.    Assert(i < FWABD_Objs.Count, 'Children: i out of bounds');
  5670.    Result := FWABD_Objs.Items[i];
  5671. end;
  5672.  
  5673. function TWABD_Parent.GetWABDObjCount: integer;
  5674. begin
  5675.    Result := FWABD_Objs.Count;
  5676. end;
  5677.  
  5678. procedure TWABD_Parent.ChildChanged(Sender: TObject);
  5679. begin
  5680.    // Default is to do nothing
  5681. end;
  5682.  
  5683. function TWABD_Parent.ForEachChild(ForEachProc: TWABD_ForEach; UserData: pointer): boolean;
  5684. var
  5685.    Stop  : boolean;
  5686.    i     : integer;
  5687.    tmp   : TWABD_Object;
  5688.    par   : TWABD_Parent;
  5689. begin
  5690.    Stop := False;
  5691.  
  5692.    for i := 0 to ChildCount-1 do begin
  5693.       ForEachProc(Children[i], Stop, UserData);
  5694.       if Stop then begin
  5695.          Result := True;
  5696.          exit;
  5697.       end;
  5698.    end;
  5699.  
  5700.    // Search for "grandchildren" if necessary
  5701.    for i := 0 to ChildCount-1 do begin
  5702.       tmp := Children[i];
  5703.       if (tmp is TWABD_Parent) then begin
  5704.          par := tmp as TWABD_Parent;
  5705.          if par.ForEachChild(ForEachProc, UserData) then begin
  5706.             Result := True;
  5707.             exit;
  5708.          end;
  5709.       end;
  5710.    end;
  5711.    Result := False;
  5712. end;
  5713.  
  5714. procedure TWABD_Parent.ChildNameProc(Child: TWABD_Object; var Stop: boolean; UserData: pointer);
  5715. begin
  5716.    if Child.Name = tmp then begin
  5717.       TheChild := Child;
  5718.       Stop := True;
  5719.    end;
  5720. end;
  5721.  
  5722. function TWABD_Parent.ChildByName(ChildName: string): TWABD_Object;
  5723. begin
  5724.    tmp := ChildName;
  5725.    TheChild := nil;
  5726.    ForEachChild(ChildNameProc, nil);
  5727.    Result := TheChild;
  5728. end;
  5729.  
  5730. function TWABD_Parent.GetDefaultButton: TWABD_Button;
  5731. begin
  5732.    TheChild := nil;
  5733.    ForEachChild(DefButProc, nil);
  5734.    Result := TheChild as TWABD_Button;
  5735. end;
  5736.  
  5737. procedure TWABD_Parent.DefButProc(Child: TWABD_Object; var Stop: boolean; UserData: pointer);
  5738. begin
  5739.    if (Child is TWABD_Button) then
  5740.       if (Child as TWABD_Button).Default then begin
  5741.          TheChild := Child;
  5742.          Stop := True;
  5743.       end;
  5744. end;
  5745.  
  5746. procedure TWABD_Parent.ButCapProc(Child: TWABD_Object; var Stop: boolean; UserData: pointer);
  5747. begin
  5748.    if (Child is TWABD_Button) then
  5749.       if (Child as TWABD_Button).Caption = tmp then begin
  5750.          TheChild := Child;
  5751.          Stop := True;
  5752.       end;
  5753. end;
  5754.  
  5755. function TWABD_Parent.ButtonByCaption(Caption: string): TWABD_Button;
  5756. begin
  5757.    tmp := Caption;
  5758.    TheChild := nil;
  5759.    ForEachChild(ButCapProc, nil);
  5760.    Result := TheChild as TWABD_Button;
  5761. end;
  5762.  
  5763. procedure TWABD_Parent.Loaded;
  5764. begin
  5765.    inherited;
  5766. end;
  5767.  
  5768. function TWABD_Parent.Object_To_Control(AOwner: TWinControl): TControl;
  5769. var
  5770.    np       : TPaintPanel;
  5771.    i        : integer;
  5772.    c        : TWABD_Object;
  5773.    con      : TControl;
  5774.    MaxHgt   : integer;
  5775.    MaxWid   : integer;
  5776.    CurTop   : integer;
  5777. begin
  5778.    np := TPaintPanel.Create(AOwner);
  5779.    np.Parent  := AOwner;   // Some of the controls need an HWND to set their properties
  5780.    np.Visible := False;    // For Performance (no screen updates)
  5781.    np.Name    := Name;
  5782.    np.Caption := '';
  5783.  
  5784.    MaxHgt := 0;
  5785.    MaxWid := 0;
  5786.    CurTop := 0;
  5787.    for i := 0 to ChildCount-1 do begin
  5788.       c := Children[i] as TWABD_Object;
  5789.       if (c.Visible=False) and not (csDesigning in ComponentState) then continue;
  5790.  
  5791.       con := c.Object_To_Control(np);
  5792.       if con<>nil then begin
  5793.          con.Name    := c.Name;
  5794.          con.Parent  := np;
  5795.          con.Top     := CurTop;
  5796.          con.Left    := 0;
  5797.          CurTop      := CurTop + con.Height;
  5798.          MaxHgt      := MaxHgt + con.Height;
  5799.          if con.Width > MaxWid then
  5800.             MaxWid := con.Width;
  5801.       end;
  5802.    end;
  5803.    np.Height := MaxHgt;
  5804.    np.Width  := MaxWid;
  5805.    np.BevelOuter := bvNone;
  5806.  
  5807.    np.Visible := True;
  5808.    Result := np;
  5809. end;
  5810.  
  5811.  
  5812. // ************************************************************************
  5813. // TWABD_Body. Ancestor of TWABD_Frameset, TWABD_Form, TWABD_HTML and TWABD_HTMLFile.
  5814. // ************************************************************************
  5815. constructor TWABD_Body.Create(AOwner:TComponent);
  5816. begin
  5817.      inherited;
  5818.  
  5819.      FJS_OnUserLoad:=TWABD_JS_Function.Create(jsOnLoad);
  5820.      FJS_OnUserUnload:=TWABD_JS_Function.Create(jsOnUnload);
  5821.      FJS_OnUserEvent:=TWABD_JS_Function.Create(jsOnEvent);
  5822.      FJS_OnUserSubmit:=TWABD_JS_Function.Create(jsOnSubmit);
  5823.  
  5824.      FClientProcessTime:=-1;
  5825.      FClientSubmitTimeStamp:=-1;
  5826.      FClientLoadTimeStamp:=-1;
  5827.  
  5828.      FFieldValues:=TStringList.Create;
  5829.      FUseSessionCookie:=false;
  5830. end;
  5831.  
  5832. destructor TWABD_Body.Destroy;
  5833. begin
  5834.      FFieldValues.Free;
  5835.  
  5836.      FJS_OnUserLoad.free;
  5837.      FJS_OnUserUnload.free;
  5838.      FJS_OnUserEvent.free;
  5839.      FJS_OnUserSubmit.free;
  5840.  
  5841.      inherited;
  5842. end;
  5843.  
  5844. procedure TWABD_Body.ProcessRequest(Request:TWABD_CustomRequest);
  5845. begin
  5846.      if Assigned(FOnSubmit) then FOnSubmit(self,Request);
  5847. end;
  5848.  
  5849. procedure TWABD_Body.DoShow;
  5850. begin
  5851.      if Assigned(OnShow) then OnShow(Self);
  5852. end;
  5853.  
  5854. procedure TWABD_Body.CreateSessionCookie;
  5855. var
  5856.    s:string;
  5857.    c:TWABD_Cookie;
  5858. begin
  5859.      if (Session<>nil) and (Session.Response<>nil) then
  5860.      begin
  5861.           s:=format(WABD_SES_ID_STR_FORMAT,[Session.SessionID,Name]);
  5862.           c:=Session.Response.Cookies.GetCookieByName(WABD_SES_ID_STR);
  5863.           if c=nil then
  5864.              Session.Response.Cookies.Add(WABD_SES_ID_STR,s)
  5865.           else
  5866.               c.Value:=s;
  5867.      end;
  5868. end;
  5869.  
  5870. function TWABD_Body.GetFieldValueCount:integer;
  5871. begin
  5872.      Result:=FFieldValues.Count;
  5873. end;
  5874.  
  5875. function TWABD_Body.GetFieldValue(i:integer):string;
  5876. begin
  5877.      if (i<0) or (i>=FFieldValues.Count) then
  5878.         raise Exception.CreateFmt('Invalid field value index (%d)',[i]);
  5879.      Result:=FFieldValues.Strings[i];
  5880. end;
  5881.  
  5882. function TWABD_Body.GetFieldValueByName(s:string):string;
  5883. var
  5884.    i:integer;
  5885. begin
  5886.      i:=FFieldValues.IndexOfName(s);
  5887.      if (i<0) then
  5888.         raise Exception.CreateFmt('Unknown field value name (%s)',[s]);
  5889.      Result:=FFieldValues.Strings[i];
  5890. end;
  5891.  
  5892. procedure TWABD_Body.SetFieldValue(i:integer; Value:string);
  5893. begin
  5894.      if (i<0) or (i>=FFieldValues.Count) then
  5895.         raise Exception.CreateFmt('Invalid field value index (%d)',[i]);
  5896.      FFieldValues.Strings[i]:=Value;
  5897. end;
  5898.  
  5899. procedure TWABD_Body.SetFieldValueByName(s:string; Value:string);
  5900. var
  5901.    i:integer;
  5902. begin
  5903.      i:=FFieldValues.IndexOfName(s);
  5904.      if (i<0) then
  5905.         raise Exception.CreateFmt('Unknown field value name (%s)',[s]);
  5906.      FFieldValues.Strings[i]:=Value;
  5907. end;
  5908.  
  5909. // ************************************************************************
  5910. // TWABD_Frame/TWABD_Frameset/TWABD_ExternalFrame
  5911. // ************************************************************************
  5912.  
  5913. constructor TWABD_ExternalFrame.Create(AOwner:TComponent);
  5914. begin
  5915.      inherited;
  5916.      FType:=eftOther;
  5917. end;
  5918.  
  5919. procedure TWABD_ExternalFrame.SetFrameType(AType:TWABD_ExternalFrameType);
  5920. begin
  5921.      case AType of
  5922.         eftBlank: FFrameName:='_blank';
  5923.         eftParent: FFrameName:='_parent';
  5924.         eftSelf: FFrameName:='_self';
  5925.         eftTop: FFrameName:='_top';
  5926.         eftSearch: FFrameName:='_search';
  5927.         else if FFrameName='' then FFrameName:=Name;
  5928.      end;
  5929.      FType:=AType;
  5930. end;
  5931.  
  5932. procedure TWABD_ExternalFrame.SetFrameName(AName:string);
  5933. begin
  5934.      if (FType<>eftOther) and (not (csLoading in ComponentState)) then
  5935.         raise Exception.Create('Cannot specify framename when specific frametype chosen.');
  5936.      FFrameName:=AName;
  5937. end;
  5938.  
  5939. function TWABD_ExternalFrame.Object_To_HTML: string;
  5940. begin
  5941.      Result:='';
  5942. end;
  5943.  
  5944. function TWABD_ExternalFrame.Object_To_Control(AOwner: TWinControl): TControl;
  5945. begin
  5946.      Result:=nil;
  5947. end;
  5948.  
  5949. procedure TWABD_ExternalFrame.HTML_To_Object(FormVal: string);
  5950. begin
  5951. end;
  5952.  
  5953. constructor TWABD_Frame.Create(AOwner: TComponent);
  5954. begin
  5955.     inherited;
  5956.     FLinkBody:=nil;
  5957.     FMarginHeight:=-1;
  5958.     FMarginWidth:=-1;
  5959. end;
  5960.  
  5961. procedure TWABD_Frame.SetName(const Value: TComponentName);
  5962. begin
  5963.      inherited;
  5964.      FFrameName:=Value;
  5965. end;
  5966.  
  5967. procedure TWABD_Frame.Notification(AComponent: TComponent; Operation: TOperation);
  5968. begin
  5969.     inherited;
  5970.     if Operation=opRemove then
  5971.     begin
  5972.         if AComponent=FLinkBody then FLinkBody:=nil
  5973.         else if AComponent=Frameset then Frameset:=nil;
  5974.     end;
  5975. end;
  5976.  
  5977. procedure TWABD_Frame.SetLinkBody(body:TWABD_Body);
  5978. begin
  5979.      FLinkBody:=body;
  5980.      body.FFrame:=self;
  5981. end;
  5982.  
  5983. procedure TWABD_Frame.SetFrameset(frameset:TWABD_Frameset);
  5984. begin
  5985.      Parent:=frameset;
  5986. end;
  5987.  
  5988. function TWABD_Frame.GetFrameset:TWABD_Frameset;
  5989. begin
  5990.      Result:=TWABD_Frameset(Parent);
  5991. end;
  5992.  
  5993. constructor TWABD_Frameset.Create(AOwner: TComponent);
  5994. begin
  5995.    inherited;
  5996.    FDivision:=fdHorizontal;
  5997.    FBorderWidth:=-1;
  5998.    FBorderColor:=clNone;
  5999.    FFrameBorder:=true;
  6000.    FParentFrame:=nil;
  6001.    FEdFrameset:= TWABDEditFrameset.Create;
  6002.    FEdFrameset.ParFrameset := self;
  6003. end;
  6004.  
  6005. destructor TWABD_Frameset.Destroy;
  6006. begin
  6007.    FEdFrameset.ParFrameset:=nil;
  6008.    FEdFrameset.free;
  6009.    inherited;
  6010. end;
  6011.  
  6012. procedure  TWABD_Frameset.Notification(AComponent: TComponent; Operation: TOperation);
  6013. begin
  6014.     inherited;
  6015.     if (Operation=opRemove) and (AComponent=FJavascript) then FJavascript:=nil;
  6016. end;
  6017.  
  6018. procedure  TWABD_Frameset.Loaded;
  6019. begin
  6020.      if Assigned(OnCreate) then OnCreate(Self);
  6021. end;
  6022.  
  6023. procedure TWABD_Frameset.Show;
  6024. begin
  6025.    if not Assigned(FWSession) then
  6026.       raise Exception.CreateFmt('TWABD_Frameset "%s" does not have a WABD_Session!', [Name]);
  6027.    FWSession.NewBody := Self;
  6028. end;
  6029.  
  6030. procedure TWABD_Frameset.SetEdFrameset(NewEdFrameset: TWABDEditFrameset);
  6031. begin
  6032.    // Do nothing
  6033. end;
  6034.  
  6035. // Generate Pre form javascript code.
  6036. function TWABD_Frameset.DoPreScript: string;
  6037. begin
  6038.    Result := '';
  6039.  
  6040.    // Check if javascript component to be placed before frameset.
  6041.    if Assigned(FJavascript) then
  6042.       with FJavascript do
  6043.          if Placement=jsFirst then Result:=Result+ProcessMacros(Lines.Text)+CR;
  6044.  
  6045.    if Result<>'' then Result:=JS_BEGIN+Result+JS_END+CR;
  6046. end;
  6047.  
  6048. // Generate Post frameset javascript code.
  6049. function TWABD_Frameset.DoPostScript: string;
  6050. begin
  6051.    Result := '';
  6052.  
  6053.    // Check if javascript component to be placed after frameset.
  6054.    if Assigned(FJavascript) then
  6055.       with FJavascript do
  6056.          if Placement=jsLast then Result:=Result+JS_BEGIN+ProcessMacros(Lines.Text)+CR+JS_END+CR;
  6057. end;
  6058.  
  6059. function TWABD_Frameset.Object_To_HTML: string;
  6060. var
  6061.    i        : integer;
  6062.    s        : string;
  6063.    a        : string;
  6064.    ID       : longint;
  6065.    DLLName  : string;
  6066.    pct      : integer;
  6067.    Header,Footer:string;
  6068.    onload   : string;
  6069. begin
  6070.      DoShow();
  6071.  
  6072.      Header:='';
  6073.      Footer:='';
  6074.      if (Session<>nil) and (Session.Request<>nil) then
  6075.      begin
  6076.           DLLName := extractfilename(Session.Request.DLLName);
  6077.           ID      := Session.SessionID;
  6078.  
  6079.           // Check if this is the main frameset. Then generate header/footer info.
  6080.           if Session.CurBody=self then begin
  6081.              Header := '<HTML><HEAD>' + CR +
  6082.                        '<META NAME="Generator" CONTENT="'+WABD_VERSION_STR+'">' + CR +
  6083.                        '<TITLE>' + FFramesetTitle + '</TITLE>' + CR;
  6084.  
  6085.              // If to close opener.
  6086.              Footer := '<BODY'+GenEventCode(FJS_OnUserLoad,nil,0,'')+
  6087.                                GenEventCode(FJS_OnUserUnload,nil,0,'')+'>';
  6088.              if CloseOpener then Footer:=Footer+JS_BEGIN+'window.opener.close();'+CR+JS_END;
  6089.              Footer:=Footer+'</BODY></HTML>' + CR;
  6090.  
  6091.           end;
  6092.  
  6093.           if (Session.MainBody=self) then
  6094.           begin
  6095.                if (owner<>nil) then
  6096.                begin
  6097.                     // Check if any top level javascript, add code for it.
  6098.                     for i:=0 to owner.ComponentCount-1 do
  6099.                     begin
  6100.                          if owner.Components[i] is TWABD_MenuTree then
  6101.                             Header:=Header+JS_BEGIN+TWABD_MenuTree(owner.Components[i]).Object_To_Top_HTML+JS_END;
  6102.                     end;
  6103.                end;
  6104.                Header:=Header+'</HEAD>'+CR;
  6105.           end;
  6106.      end
  6107.      else
  6108.      begin
  6109.           DLLName := 'Unknown_DLL';
  6110.           ID      := -1;
  6111.      end;
  6112.      CloseOpener:=false;
  6113.  
  6114.      // Setup options.
  6115.      s:='<frameset';
  6116.      if FBorderWidth>=0 then s:=s+format(' Border="%d" Framespacing="%d"',[FBorderWidth,FBorderWidth]);
  6117.      if not FFrameBorder then s:=s+' Frameborder="0"';
  6118.      if FBorderColor<>clNone then s:=s+' Bordercolor='+ColorToHTML(FBorderColor,'"');
  6119.  
  6120.      // Setup col/row divison for subframes.
  6121.      if Division=fdVertical then
  6122.         s:=s+' Cols="'
  6123.      else
  6124.          s:=s+' Rows="';
  6125.      a:='';
  6126.      pct:=0;
  6127.      onload:='';
  6128.      for i:=0 to ChildCount-1 do
  6129.        with TWABD_Frame(Children[i]) do
  6130.        begin
  6131.            if FVisible then
  6132.            begin
  6133.                 // Define framesizes.
  6134.                 s:=s+a;
  6135.                 if FSize=0 then begin
  6136.                    if (pct<0) or (pct>=100) then s:=s+'*'
  6137.                    else s:=s+inttostr(100-pct)+'%';
  6138.                    pct:=-1;
  6139.                 end
  6140.                 else if FSize<0 then begin
  6141.                      s:=s+inttostr(-FSize)+'%';
  6142.                      if pct>=0 then inc(pct,-FSize);
  6143.                 end
  6144.                 else begin
  6145.                     s:=s+inttostr(FSize);
  6146.                     pct:=-1;
  6147.                 end;
  6148.                 a:=',';
  6149.            end;
  6150.        end;
  6151.  
  6152.      s:=s+'">'+CR;
  6153.      onload:='';
  6154.  
  6155.      // Loop through subframes and generate code.
  6156.      for i:=0 to ChildCount-1 do
  6157.      begin
  6158.        with TWABD_Frame(Children[i]) do
  6159.        begin
  6160.            if FVisible and Assigned(LinkBody) then
  6161.            begin
  6162.                 //  Build frame.
  6163.                 s:=s+'<frame';
  6164.                 s:=s+format(' Src="%s?%s='+WABD_SES_ID_STR_FORMAT+'&%s=%s&%s=%.8f"',
  6165.                     [DllName,WABD_SES_ID_STR,ID,LinkBody.Name,WABD_FRAME_STR,Name,
  6166.                     WABD_STAMP_STR,now]);
  6167.  
  6168.                 // Setup target name.
  6169.                 s:=s+' Name="'+Name+'"';
  6170.  
  6171.                 // Build options.
  6172.                 if (not FFrameBorder) and (self.FrameBorder) then s:=s+' frameborder="0"';
  6173.                 if (FBorderColor<>clNone) and (self.BorderColor<>FBorderColor) then s:=s+' bordercolor='+ColorToHTML(FBorderColor,'"');
  6174.                 if not FResize then s:=s+' NoResize';
  6175.                 if FScrolling=fsYes then s:=s+' scrolling=Yes'
  6176.                 else if FScrolling=fsNo then s:=s+' scrolling=No';
  6177.                 if FMarginHeight>=0 then s:=s+' MarginHeight='+inttostr(FMarginHeight);
  6178.                 if FMarginWidth>=0 then s:=s+' MarginWidth='+inttostr(FMarginWidth);
  6179.                 s:=s+'>'+CR;
  6180.            end;
  6181.        end;
  6182.      end;
  6183.      s:=s+'</frameset>'+CR;
  6184.      Result:=Header+DoPreScript+s+DoPostScript+Footer;
  6185. end;
  6186.  
  6187. // ************************************************************************
  6188. // TWABD_Base_HTML
  6189. // ************************************************************************
  6190.  
  6191. constructor TWABD_Base_HTML.Create(AOwner:TComponent);
  6192. begin
  6193.      inherited;
  6194.  
  6195.      FHTML:=TStringList.Create;
  6196.      FHTML.Add('<HTML>');
  6197.      FHTML.Add('<META NAME="Generator" CONTENT="'+WABD_VERSION_STR+'">');
  6198.      FHTML.Add('<HEAD>');
  6199.      FHTML.Add('<TITLE>ENTER THE TITLE HERE</TITLE>');
  6200.      FHTML.Add('<BODY>');
  6201.      FHTML.Add('...ENTER THE HTML HERE...');
  6202.      FHTML.Add('</BODY>');
  6203.      FHTML.Add('</HTML>');
  6204.      FUseSessionCookie:=true;
  6205. end;
  6206.  
  6207. destructor TWABD_Base_HTML.Destroy;
  6208. begin
  6209.      FHTML.free;
  6210.      inherited;
  6211. end;
  6212.  
  6213. procedure TWABD_Base_HTML.Show;
  6214. begin
  6215.    if not Assigned(FWSession) then
  6216.       raise Exception.CreateFmt('TWABD_Base_HTML "%s" does not have a WABD_Session!', [Name]);
  6217.    FWSession.NewBody := Self;
  6218. end;
  6219.  
  6220. // ************************************************************************
  6221. // TWABD_HTML
  6222. // ************************************************************************
  6223.  
  6224. function TWABD_HTML.Object_To_HTML:string;
  6225. begin
  6226.      DoShow;
  6227.      Result:=FHTML.Text;
  6228. end;
  6229.  
  6230. function TWABD_HTML.Object_To_WML:string;
  6231. begin
  6232.      Result:=Object_To_HTML;
  6233. end;
  6234.  
  6235. procedure TWABD_HTML.HTML_To_Object(FormVal: string);
  6236. begin
  6237.      // Do nothing.
  6238. end;
  6239.  
  6240. // ************************************************************************
  6241. // TWABD_HTMLFile
  6242. // ************************************************************************
  6243.  
  6244. constructor TWABD_HTMLFile.Create(AOwner:TComponent);
  6245. begin
  6246.      inherited;
  6247.      FLoadedWhen:=0;
  6248.      FSecsBeforeReload:=0;
  6249.      FCached:=false;
  6250. end;
  6251.  
  6252. destructor TWABD_HTMLFile.Destroy;
  6253. begin
  6254.      inherited;
  6255. end;
  6256.  
  6257. function TWABD_HTMLFile.Object_To_HTML:string;
  6258. begin
  6259.      // Check if cached and to be reloaded or not loaded yet then load.
  6260.      if (FLoadedWhen = 0) or
  6261.         ((FCached) and (FSecsBeforeReload>0) and (trunc((now - FLoadedWhen)*24.0*3600.0) > FSecsBeforeReload)) then
  6262.         Reload;
  6263.  
  6264.      DoShow;
  6265.      Result:=FHTML.Text;
  6266. end;
  6267.  
  6268. function TWABD_HTMLFile.Object_To_WML:string;
  6269. begin
  6270.      Result:=Object_To_HTML;
  6271. end;
  6272.  
  6273. procedure TWABD_HTMLFile.HTML_To_Object(FormVal: string);
  6274. begin
  6275.      // Do nothing.
  6276. end;
  6277.  
  6278. procedure TWABD_HTMLFile.Reload;
  6279. var
  6280.    fn:string;
  6281. begin
  6282.      if FSetup=nil then
  6283.         fn:=FFileName
  6284.      else
  6285.          fn:=FSetup.GetLocalFilePath+FFileName;
  6286.      if fn='' then exit;
  6287.      FHTML.LoadFromFile(fn);
  6288.      FLoadedWhen:=now;
  6289. end;
  6290.  
  6291. procedure TWABD_HTMLFile.Notification(AComponent: TComponent; Operation: TOperation);
  6292. begin
  6293.     inherited;
  6294.     if (Operation=opRemove) then
  6295.     begin
  6296.          if AComponent=FSetup then FSetup:=nil;
  6297.     end;
  6298. end;
  6299.  
  6300. // ************************************************************************
  6301. // TWABD_Form
  6302. // ************************************************************************
  6303.  
  6304. procedure TWABD_Form.SetEdForm(NewEdForm: TWABDEditForm);
  6305. begin
  6306.    // Do nothing
  6307. end;
  6308.  
  6309. constructor TWABD_Form.Create(AOwner: TComponent);
  6310. begin
  6311.    inherited;
  6312.    FTextColor  := clNone;
  6313.    FLinkColor  := clNone;
  6314.    FVLinkColor := clNone;
  6315.    FALinkColor := clNone;
  6316.    FBgndColor  := clNone;
  6317.    FSubmitCount:= 0;
  6318.    FEncType    := '';
  6319.    FEdForm     := TWABDEditForm.Create;
  6320.    FEdForm.ParForm := self;
  6321.    FFrame      := nil;
  6322.    FSubmitTo   := nil;
  6323.    FMarginTop  :=-1;
  6324.    FMarginBottom:=-1;
  6325.    FMarginLeft  :=-1;
  6326.    FMarginRight:=-1;
  6327.    FWidth:=100;
  6328.    FHeight:=100;
  6329.    FCheckOutOfOrder:=false;
  6330.    FJS_OnUserEventSubmit:=TWABD_JS_Function.Create(jsOnSubmit);
  6331. end;
  6332.  
  6333. procedure TWABD_Form.Loaded;
  6334. begin
  6335.    if Assigned(OnCreate) then OnCreate(Self);
  6336. end;
  6337.  
  6338. destructor TWABD_Form.Destroy;
  6339. begin
  6340.    if Assigned(RefNotify) then RefNotify(Self, Self, opRemove);
  6341.    FJS_OnUserEventSubmit.free;
  6342.    FEdForm.ParForm:=nil;
  6343.    FEdForm.free;
  6344.    inherited;
  6345. end;
  6346.  
  6347. procedure TWABD_Form.SetName(const Value: TComponentName);
  6348. begin
  6349.    if (not (csLoading in ComponentState)) and ((FormTitle='') or (FormTitle=Name)) then FormTitle := Value;
  6350.    inherited;
  6351. end;
  6352.  
  6353. procedure TWABD_Form.Notification(AComponent: TComponent; Operation: TOperation);
  6354. begin
  6355.    inherited;
  6356.    if Assigned(RefNotify) then RefNotify(Self, AComponent, Operation);
  6357.    if (Operation=opRemove) then
  6358.    begin
  6359.         if (AComponent=FJavascript) then FJavascript:=nil
  6360.         else if (AComponent=FSubmitTo) then FSubmitTo:=nil;
  6361.    end;
  6362. end;
  6363.  
  6364. // Check if out of order.
  6365. function TWABD_Form.OutOfOrder(Request:TWABD_CustomRequest):boolean;
  6366. var
  6367.    i:integer;
  6368.    s:string;
  6369.    ch:integer;
  6370. begin
  6371.      Result:=false;
  6372.      s:=trim(Request.Query.Values[WABD_FORMSUBMITCOUNT_STR]);
  6373.      if length(s)>0 then
  6374.      begin
  6375.           // Check if a number.
  6376.           for i:=1 to length(s) do
  6377.           begin
  6378.                ch:=ord(s[i]);
  6379.                if (ch<ord('0')) or (ch>ord('9')) then exit;
  6380.           end;
  6381.  
  6382.           // If a number, check if in sequence.
  6383.           i:=strtoint(s);
  6384.           if i<FSubmitCount then Result:=true;
  6385.      end;
  6386. end;
  6387.  
  6388. // Process input strings to handle events and setting properties of objects.
  6389. procedure TWABD_Form.ProcessRequest(Request:TWABD_CustomRequest);
  6390. var
  6391.    ProcessEvents,ProcessProperties:boolean;
  6392. begin
  6393.      ProcessEvents:=true;
  6394.      ProcessProperties:=false;
  6395.  
  6396.      // Check if double submit of same form. Something out of order. Default ignore and redisplay.
  6397.      if FCheckOutOfOrder then
  6398.      begin
  6399.           FOutOfOrder:=OutOfOrder(Request);
  6400.           if FOutOfOrder then
  6401.           begin
  6402.                ProcessEvents:=false;
  6403.                ProcessProperties:=false;
  6404.                if Assigned(FOnOutOfOrder) then FOnOutOfOrder(self,Request,ProcessProperties,ProcessEvents)
  6405.           end;
  6406.      end;
  6407.  
  6408.      inherited;
  6409.      if not (IsReload or ProcessProperties) then SetProperties(Request);
  6410.  
  6411.      if Assigned(OnSubmitForm) then OnSubmitForm(Self,Request,ProcessEvents);
  6412.  
  6413.      // Call the event handlers.
  6414.      if (not IsReload) and ProcessEvents then Call_Handler(Request);
  6415. end;
  6416.  
  6417. procedure TWABD_Form.ClearControl(Child: TWABD_Object; var Stop: boolean; UserData: pointer);
  6418. begin
  6419.    if Child=nil then exit;   // 2.24
  6420.  
  6421.    // Handle if formsection containing list/combo/check/radio is not visible.
  6422.    if Child.Parent<>nil then
  6423.       if not Child.Parent.Visible then exit;
  6424.  
  6425.    // If radio button, clear it. It will be set later on.
  6426.    if (Child is TWABD_RadioButton) then
  6427.       (Child as TWABD_RadioButton).Checked := False;
  6428.  
  6429.    // Handle if not visible.
  6430.    if not Child.Visible then exit;
  6431.  
  6432.    // If checkbox, clear it. It will be set later on.
  6433.    if (Child is TWABD_CheckBox) then
  6434.       (Child as TWABD_CheckBox).Checked := False
  6435.  
  6436.    // If list/combobox, clear selections. They will be set later on.
  6437.    else if (Child is TWABD_SelLinesObject) then
  6438.         with Child as TWABD_SelLinesObject do
  6439.         begin
  6440.              CopyListSelected(FSelList,FOldSelList);
  6441.              ClearListSelected(FSelList);
  6442.         end;
  6443. end;
  6444.  
  6445. procedure TWABD_Form.SetProperties(Request:TWABD_CustomRequest);
  6446. var
  6447.    i,j      : integer;
  6448.    OneLine  : string;
  6449.    NameVal  : string;
  6450.    Value    : string;
  6451.    c        : TWABD_Object;
  6452. begin
  6453.    ForEachChild(ClearControl, nil);
  6454.    for i := 0 to Request.Query.Count-1 do begin
  6455.       OneLine:=Request.Query.Strings[i];
  6456.  
  6457.       j:=pos('=',OneLine);
  6458.       if j>=0 then
  6459.       begin
  6460.            NameVal:=Copy(OneLine,1,j-1);
  6461.            Value:=Copy(OneLine,j+1,length(OneLine));
  6462.       end
  6463.       else
  6464.       begin
  6465.            NameVal:=OneLine;
  6466.            Value:='';
  6467.       end;
  6468.  
  6469.       if (NameVal = WABD_CLIENTLOADTIMESTAMP_STR) then
  6470.       begin
  6471.            FClientLoadTimeStamp:=strtofloat(Value);
  6472.            continue;
  6473.       end;
  6474.       if (NameVal = WABD_CLIENTSUBMITTIMESTAMP_STR) then
  6475.       begin
  6476.            FClientSubmitTimeStamp:=strtofloat(Value);
  6477.            continue;
  6478.       end;
  6479.       if (NameVal = WABD_CLIENTPROCESSTIME_STR) then
  6480.       begin
  6481.            FClientProcessTime:=strtofloat(Value);
  6482.            continue;
  6483.       end;
  6484.  
  6485.       if (copy(NameVal,1,length(WABD_RADIO_STR)) = WABD_RADIO_STR) then begin
  6486.          c := ChildByName(Value);
  6487.          Assert(c<>nil, 'Radio Button does not exist! ' + Value);
  6488.          (c as TWABD_RadioButton).Checked := True;
  6489.          continue;
  6490.       end;
  6491.  
  6492.       // Skip Image clicks
  6493.       if (Pos('.X', UpperCase(NameVal)) <> 0) or
  6494.          (Pos('.Y', UpperCase(NameVal)) <> 0) then continue;
  6495.  
  6496.       if (Copy(NameVal,1,6) = '_WABD_') then continue;
  6497.  
  6498.       c := ChildByName(NameVal);
  6499.       if (c<>nil) and (c is TWABD_Table) then continue;
  6500.  
  6501.       Assert(c<>nil, Format('No property named: %s', [NameVal]));
  6502.       c.HTML_To_Object(HTML_To_ASCII(Value));
  6503.    end;
  6504. end;
  6505.  
  6506.  
  6507. function TWABD_Form.GetEventID(var str:string):string;
  6508. var
  6509.    i:integer;
  6510. begin
  6511.      i:=pos(';',str);
  6512.      if i<=0 then begin
  6513.         Result:=str;
  6514.         str:='';
  6515.      end
  6516.      else begin
  6517.         Result:=copy(str,1,i-1);
  6518.         str:=copy(str,i+1,length(str));
  6519.      end;
  6520. end;
  6521.  
  6522. procedure TWABD_Form.SplitEventID(str:string;var EventID:integer; var CtrlName:string; var Data:string);
  6523. var
  6524.    i:integer;
  6525. begin
  6526.      i:=pos(':',str);
  6527.      if i<=0 then begin
  6528.         CtrlName:='';
  6529.         EventID:=0;
  6530.         exit;
  6531.      end;
  6532.      EventID:=strtoint(copy(str,1,i-1));
  6533.      str:=copy(str,i+1,length(str));
  6534.      i:=pos(':',str);
  6535.      CtrlName:=copy(str,1,i-1);
  6536.      Data:=copy(str,i+1,length(str));
  6537. end;
  6538.  
  6539. procedure TWABD_Form.ParseImageParams(Request:TWABD_CustomRequest; var ImageName: string; var x,y: integer);
  6540. var
  6541.    i, p  : integer;
  6542.    n     : string;
  6543. begin
  6544.    ImageName := '';
  6545.    x  := -1;
  6546.    y  := -1;
  6547.  
  6548.    for i := 0 to Request.Query.Count-1 do begin
  6549.       n := Request.Query.Names[i];
  6550.       p := Pos('.X', UpperCase(n));
  6551.       if p<>0 then begin
  6552.          ImageName := Copy(n, 1, p-1);
  6553.          x  := StrToInt(Request.Query.Values[n]);
  6554.       end;
  6555.       p := Pos('.Y', UpperCase(n));
  6556.       if p<>0 then begin
  6557.          y  := StrToInt(Request.Query.Values[n]);
  6558.       end;
  6559.    end;
  6560. end;
  6561.  
  6562. procedure TWABD_Form.Call_Handler(Request:TWABD_CustomRequest);
  6563. var
  6564.    i           : integer;
  6565.    OneLine     : string;
  6566.    NameVal     : string;
  6567.    c           : TWABD_Object;
  6568.    b           : TWABD_Button;
  6569.    wt          : TWABD_Table;
  6570.    l           : TWABD_Label;
  6571.    ImageName   : string;
  6572.    x, y        : integer;
  6573.    ct          : string;
  6574.    NoDefault   : boolean;
  6575.    EvStr       : string;
  6576.    EvID        : integer;
  6577.    EvCtrl      : string;
  6578.    EvData      : string;
  6579.    s           : string;
  6580.    p           : integer;
  6581. begin
  6582.    // Check if image type. Create event for click.
  6583.    ParseImageParams(Request, ImageName, x, y);
  6584.    if ImageName<>'' then begin
  6585.       c := ChildByName(ImageName);
  6586.       if c<>nil then (c as TWABD_Base_Image).MouseDown(x, y);
  6587.       exit;
  6588.    end;
  6589.  
  6590.    // Other event.
  6591.    NoDefault:=false;
  6592.    for i := 0 to Request.Query.Count-1 do
  6593.    begin
  6594.         OneLine := Request.Query.Strings[i];
  6595.         NameVal := Request.Query.Names[i];
  6596.         if (NameVal = WABD_SES_ID_STR) or (NameVal = WABD_STAMP_STR) then continue;
  6597.  
  6598.         if NameVal = WABD_EVENT_ID_STR then begin
  6599.            EvStr := Request.Query.Values[WABD_EVENT_ID_STR];
  6600.  
  6601.            // Loop for all events.
  6602.            while EvStr<>'' do begin
  6603.               s:=GetEventID(EvStr);
  6604.               SplitEventID(s,EvID,EvCtrl,EvData);
  6605.  
  6606.               case EvID of
  6607.  
  6608.                  WABD_EVENT_USERCHANGE,WABD_EVENT_USERCLICK,WABD_EVENT_USERGOTFOCUS,WABD_EVENT_USERLOSTFOCUS:
  6609.                   begin          // On.... handler.
  6610.                     if EvCtrl='' then continue;
  6611.  
  6612.                     // Handle the grouping of radiobuttons.
  6613.                     if (copy(EvCtrl,1,length(WABD_RADIO_STR)) = WABD_RADIO_STR) then EvCtrl:=EvData;
  6614.  
  6615.                     // Look for object of specified name and call event handler.
  6616.                     c := ChildByName(EvCtrl);
  6617.                     if c=nil then raise Exception.CreateFmt('Event %d - Component ''%s'' not existing', [EvID,EvCtrl]);
  6618.                     if c is TWABD_BaseEventSectionObject then
  6619.                        with TWABD_BaseEventSectionObject(c) do
  6620.                        try
  6621.                          case EvID of
  6622.                            WABD_EVENT_USERCHANGE: if Assigned(FOnUserChange) then FOnUserChange(c);
  6623.                            WABD_EVENT_USERCLICK: if Assigned(FOnUserClick) then FOnUserClick(c);
  6624.                            WABD_EVENT_USERGOTFOCUS: if Assigned(FOnUserGotFocus) then FOnUserGotFocus(c);
  6625.                            WABD_EVENT_USERLOSTFOCUS: if Assigned(FOnUserLostFocus) then FOnUserLostFocus(c);
  6626.                          end;
  6627.                        except
  6628.                          raise;
  6629.                        end;
  6630.                     NoDefault:=true;
  6631.                  end;
  6632.  
  6633.                  WABD_EVENT_CALLBACK:
  6634.                      begin               // Clientside userdefined event.
  6635.                       if Assigned(FOnUserCallback) then FOnUserCallback(self,evData);
  6636.                      end;
  6637.  
  6638.                  WABD_EVENT_AUTOLOAD:
  6639.                      begin               // Autoload other frameset/form. Syntax: autoloadname:1/0 close opener/dont close.
  6640.                       SplitSessionID(EvData,EvData,s);
  6641.                       c:=ChildByName(EvData);
  6642.                       if c<>nil then
  6643.                          with c as TWABD_Autoload do
  6644.                          begin
  6645.                               if Frameset<>nil then
  6646.                               begin
  6647.                                    Frameset.FWSession:=FWSession;
  6648.                                    Frameset.CloseOpener:=(s='1');
  6649.                                    Frameset.show;
  6650.                               end
  6651.                               else if Form<>nil then
  6652.                               begin
  6653.                                    Form.FWSession:=FWSession;
  6654.                                    Form.CloseOpener:=(s='1');
  6655.                                    Form.show;
  6656.                               end;
  6657.                               NoDefault:=true;
  6658.                          end;
  6659.                  end;
  6660.               end;
  6661.            end;
  6662.            continue;
  6663.         end;
  6664.  
  6665.         if NameVal = WABD_FRAME_STR then begin
  6666.            NoDefault:=true;
  6667.            continue;
  6668.         end;
  6669.  
  6670.         // Handles button clicking.
  6671.         if (NameVal = WABD_BUTTON_STR) then begin
  6672.            c := ButtonByCaption(Request.Query.Values[NameVal]);
  6673.            if c<>nil then
  6674.            begin
  6675.                 b :=  c as TWABD_Button;
  6676.                 if Assigned(b.OnUserClick) then b.OnUserClick(b);
  6677.                 exit;
  6678.            end;
  6679.         end;
  6680.  
  6681.         // Handles label anchor clicking.
  6682.         if (NameVal = WABD_LABEL_STR) then begin
  6683.            c := ChildByName(Request.Query.Values[NameVal]);
  6684.            Assert(c<>nil, 'Label does not exist: ' + Request.Query.Values[NameVal]);
  6685.            l := c as TWABD_Label;
  6686.            if Assigned(l.OnUserClick) then l.OnUserClick(l);
  6687.            exit;
  6688.         end;
  6689.  
  6690.         // Handles embedded table cell clicking via anchors.
  6691.         if (NameVal = WABD_TABLE_STR) then begin
  6692.            c := ChildByName(Request.Query.Values[NameVal]);
  6693.            Assert(c<>nil, 'Table does not exist: ' + Request.Query.Values[NameVal]);
  6694.  
  6695.            // Get data for table.
  6696.            s:=Request.Query.Values[WABD_DATA_STR];
  6697.            p:=pos(':',s);
  6698.            if p>0 then
  6699.            begin
  6700.                 x:=strtoint(copy(s,1,p-1));
  6701.                 y:=strtoint(copy(s,p+1,length(s)));
  6702.            end
  6703.            else
  6704.            begin
  6705.                 x:=-1;
  6706.                 y:=-1;
  6707.            end;
  6708.  
  6709.            if c is TWABD_Table then
  6710.            begin
  6711.                 if assigned(TWABD_Table(c).OnUserClickCell) then TWABD_Table(c).OnUserClickCell(c,y,x);
  6712.            end
  6713.            else if c is TWABD_DataTable then
  6714.            begin
  6715.                 if assigned(TWABD_DataTable(c).FTable.OnUserClickCell) then TWABD_DataTable(c).FTable.OnUserClickCell(c,y,x);
  6716.            end;
  6717.            exit;
  6718.         end;
  6719.  
  6720.         // Handles table row clicking via button.
  6721.         c := ChildByName(NameVal);
  6722.         if (c<>nil) and (c is TWABD_Table) then begin
  6723.            wt := c as TWABD_Table;
  6724.            ct := Request.Query.Values[NameVal];
  6725.            ct := Copy(ct, Length(wt.ClickText)+1, Length(ct));
  6726.            if Assigned(wt.OnUserClick) then wt.OnUserClick(wt, StrToInt(ct));
  6727.            exit;
  6728.         end;
  6729.    end;
  6730.  
  6731.    // You can get here if the user just presses enter in an Edit box.
  6732.    if not NoDefault then begin
  6733.       b := GetDefaultButton;
  6734.       if b<>nil then begin
  6735.          if Assigned(b.OnUserClick) then b.OnUserClick(b);
  6736.          exit;
  6737.       end;
  6738.    end;
  6739.  
  6740.    // Not sure what to do here, maybe have a form OnUserClick event? -bpz
  6741. //   raise Exception.Create('Could not find an event handler - No Default Button exists');
  6742. end;
  6743.  
  6744. procedure TWABD_Form.ChildChanged(Sender: TObject);
  6745. begin
  6746. end;
  6747.  
  6748. function TWABD_Form.GetFormBody: string;
  6749. var
  6750.    TextStr  : string;
  6751.    LinkStr  : string;
  6752.    VLinkStr : string;
  6753.    ALinkStr : string;
  6754.    BGndStr  : string;
  6755.    BGColStr : string;
  6756.    TimeStr  : string;
  6757.    MarginStr:string;
  6758.    MHeight,MWidth:integer;
  6759.    
  6760.    function HTMLColStr(col: TColor; ColName: string): string;
  6761.    begin
  6762.       if col <> clNone then
  6763.          Result := ' '+ColName+'='+ColorToHTML(col,'"')
  6764.       else
  6765.          Result := '';
  6766.    end;
  6767. begin
  6768.    // <BODY TEXT="#00ffff" LINK="#ff00ff" VLINK="#800000" BACKGROUND="Image3.gif">
  6769.  
  6770.    TextStr  := HTMLColStr(FTextColor, 'TEXT');
  6771.    LinkStr  := HTMLColStr(FLinkColor, 'LINK');
  6772.    VLinkStr := HTMLColStr(FVLinkColor, 'VLINK');
  6773.    ALinkStr := HTMLColStr(FALinkColor, 'ALINK');
  6774.    BGColStr := HTMLColStr(FBgndColor, 'BGCOLOR');
  6775.  
  6776.    MarginStr:='';
  6777.    MHeight:=0;
  6778.    MWidth:=0;
  6779.  
  6780.    // Setup vertical margins.
  6781.    if FMarginTop>-1 then
  6782.    begin
  6783.         MarginStr:=format('%s TOPMARGIN=%d',[MarginStr,FMarginTop]);
  6784.         inc(MHeight,FMarginTop);
  6785.    end;
  6786.    if FMarginBottom>-1 then
  6787.    begin
  6788.         MarginStr:=format('%s BOTTOMMARGIN=%d',[MarginStr,FMarginBottom]);
  6789.         inc(MHeight,FMarginBottom);
  6790.    end;
  6791.    if MarginStr<>'' then MarginStr:=format('%s MARGINHEIGHT=%d',[MarginStr,MHeight]);
  6792.  
  6793.    // Setup horizontal margins.
  6794.    if FMarginLeft>-1 then
  6795.    begin
  6796.         MarginStr:=format('%s LEFTMARGIN=%d',[MarginStr,FMarginLeft]);
  6797.         inc(MWidth,FMarginLeft);
  6798.    end;
  6799.    if FMarginRight>-1 then
  6800.    begin
  6801.         MarginStr:=format('%s RIGHTMARGIN=%d',[MarginStr,FMarginRight]);
  6802.         inc(MWidth,FMarginRight);
  6803.    end;
  6804.    if MarginStr<>'' then MarginStr:=format('%s MARGINWIDTH=%d',[MarginStr,MWidth]);
  6805.  
  6806.    // Add background image if set.
  6807.    if assigned(FBgrdImage) then
  6808.    begin
  6809.       if RunningLocal then
  6810.          BGndStr := ' BACKGROUND='+'file://'+FBgrdImage.LocalImagePath
  6811.       else
  6812.          BGndStr := ' BACKGROUND='+FBgrdImage.ImagePath;
  6813.    end;
  6814.  
  6815.    // Check if networkstatistics enabled, place javascript.
  6816.    if (Session<>nil) and (Session.SessionMgr<>nil) and (Session.SessionMgr.NetworkStatistics) then
  6817.       TimeStr:='TimeNetworkLoad('+Name+');'
  6818.    else
  6819.        TimeStr:='';
  6820.  
  6821.    Result := '<BODY'+MarginStr+TextStr+LinkStr+VLinkStr+ALinkStr+BGndStr+BGColStr+
  6822.              GenEventCode(FJS_OnUserLoad,nil,0,TimeStr)+GenEventCode(FJS_OnUserUnload,nil,0,'')+'>';
  6823. end;
  6824.  
  6825. // Generate Pre form javascript code.
  6826. function TWABD_Form.DoPreScript: string;
  6827. var
  6828.    DoTime:boolean;
  6829. begin
  6830.    Result := '';
  6831.  
  6832.    // Check if javascript component to be placed before form.
  6833.    if Assigned(FJavascript) then
  6834.       with FJavascript do
  6835.          if Placement=jsFirst then Result:=Result+ProcessMacros(Lines.Text)+CR;
  6836.  
  6837.    // Check if networkstatistics enabled, place javascript.
  6838.    DoTime:=(Session<>nil) and (Session.SessionMgr<>nil) and (Session.SessionMgr.NetworkStatistics);
  6839.    if DoTime then
  6840.       Result:=Result+GenNetworkTimingJS;
  6841.  
  6842.    if FEventHandlersOnForm then Result:=Result+GenEventHandler(DoTime,FJS_OnUserEventSubmit,FJS_OnUserEvent)+CR;
  6843.    if Result<>'' then Result:=JS_BEGIN+Result+JS_END;
  6844. end;
  6845.  
  6846. // Generate Post form javascript code.
  6847. function TWABD_Form.DoPostScript: string;
  6848. var
  6849.    i           : integer;
  6850.    s           : string;
  6851.    s1          : string;
  6852.    al          : TWABD_AutoLoad;
  6853. begin
  6854.    Result := '';
  6855.    for i := 0 to ChildCount-1 do
  6856.    begin
  6857.         if Children[i].Visible then
  6858.         begin
  6859.              // If autoload component.
  6860.              if (Children[i] is TWABD_Autoload) then
  6861.              begin
  6862.                   al:=(Children[i] as TWABD_AutoLoad);
  6863.                   s:=format('menubar=%d,toolbar=%d,scrollbars=%d,status=%d,titlebar=%d,resizable=%d,location=%d',
  6864.                      [ord(al.MenuBar),ord(al.Toolbar),ord(al.Scrollbars),ord(al.Statusbar),ord(al.Titlebar),ord(al.Resizable),ord(al.Locationbar)]);
  6865.                   if al.Delay>0 then
  6866.                   begin
  6867.                      s1:=format('setTimeout("top.open(\"%s?%s='+WABD_SES_ID_STR_FORMAT+'&%s='+inttostr(WABD_EVENT_AUTOLOAD)+'::%s:%d\",\"\",\"%s\")",%d)',
  6868.                         [DllName,WABD_SES_ID_STR,SessionID,Name,WABD_EVENT_ID_STR,al.Name,ord(al.Replace),s,al.Delay]);
  6869.                      Result:=Result+URL_To_HTML(s1)+CR;
  6870.                   end
  6871.                   else
  6872.                      Result:=Result+URL_To_HTML(format('top.open("%s?%s='+WABD_SES_ID_STR_FORMAT+'&%s='+inttostr(WABD_EVENT_AUTOLOAD)+'::%s:%d","","%s")',
  6873.                         [DllName,WABD_SES_ID_STR,SessionID,Name,WABD_EVENT_ID_STR,al.Name,ord(al.Replace),s]))+CR;
  6874.              end;
  6875.         end;
  6876.    end;
  6877.  
  6878.    // Check if javascript component to be placed after form.
  6879.    if Assigned(FJavascript) then
  6880.       with FJavascript do
  6881.            if Placement=jsLast then Result:=Result+ProcessMacros(Lines.Text)+CR;
  6882.  
  6883.    // If to close opener.
  6884.    if CloseOpener then Result:=Result+'window.opener.close();'+CR;
  6885.    CloseOpener:=false;
  6886.  
  6887.    // Send result back.
  6888.    if Result<>'' then Result:=JS_BEGIN+Result+JS_END;
  6889. end;
  6890.  
  6891. function TWABD_Form.FormSections_To_HTML: string;
  6892. var
  6893.    i               : integer;
  6894.    fs              : TWABD_FormSection_Base;
  6895.    r               : string;
  6896.    shalign,svalign : string;
  6897.    o               : TWABD_Object;
  6898. begin
  6899.    Result := '<TABLE COLS=1'+ValueToHTML('HEIGHT',FHeight)+ValueToHTML('WIDTH',FWidth)+'>';
  6900.    for i := 0 to ChildCount-1 do
  6901.    begin
  6902.         o:=TWABD_Object(Children[i]);
  6903.         if not o.Visible then continue;
  6904.  
  6905.         // Check if formsection type (alignments can be set).
  6906.         if (o is TWABD_FormSection_Base) then
  6907.         begin
  6908.              fs:=TWABD_FormSection_Base(o);
  6909.              begin
  6910.                   fs.FEventHandlersOnFormSection:=false;
  6911.  
  6912.                   // Setup form section alignment.
  6913.                   case fs.FHorzAlign of
  6914.                      alhLeft: shalign:=' ALIGN="left"';
  6915.                      alhCenter: shalign:=' ALIGN="center"';
  6916.                      alhRight: shalign:=' ALIGN="right"';
  6917.                      else shalign:='';
  6918.                   end;
  6919.                   case fs.FVertAlign of
  6920.                      alvTop: svalign:=' VALIGN="top"';
  6921.                      alvMiddle: svalign:=' VALIGN="middle"';
  6922.                      alvBottom: svalign:=' VALIGN="bottom"';
  6923.                      alvBaseline: svalign:=' VALIGN="baseline"';
  6924.                      else svalign:='';
  6925.                   end;
  6926.  
  6927.                   r:=ValueToHTML('HEIGHT',fs.FHeight)+ValueToHTML('WIDTH',fs.FWidth)+shalign+svalign;
  6928.  
  6929.                   Result:=Result+'<TR'+r+'><TD>'
  6930.                           +fs.Object_To_HTML
  6931.                           +'</TD></TR>';
  6932.  
  6933.                   // Check if server based event handler on this formsection.
  6934.                   if fs.FEventHandlersOnFormSection then FEventHandlersOnForm:=true;
  6935.              end;
  6936.         end
  6937.  
  6938.         // Ordinary type witout any alignments.
  6939.         else
  6940.             Result:=Result+o.Object_To_HTML+CR;
  6941.    end;
  6942.    Result:=Result+'</TABLE>';
  6943. end;
  6944.  
  6945. function TWABD_Form.FormSections_To_WML: string;
  6946. var
  6947.    i               : integer;
  6948.    o               : TWABD_Object;
  6949. begin
  6950.    Result:='';
  6951.    for i := 0 to ChildCount-1 do
  6952.    begin
  6953.         o:=TWABD_Object(Children[i]);
  6954.         if not o.Visible then continue;
  6955.  
  6956.         if o is TWABD_FormSection_Base then
  6957.            Result:=Result+TWABD_FormSection_Base(o).Object_To_WML
  6958.         else
  6959.            Result:=Result+o.Object_To_WML;
  6960.    end;
  6961. end;
  6962.  
  6963. function TWABD_Form.FormSections_To_WML_Postfield: string;
  6964. var
  6965.    i               : integer;
  6966.    o               : TWABD_Object;
  6967. begin
  6968.    Result:='';
  6969.    for i := 0 to ChildCount-1 do
  6970.    begin
  6971.         o:=TWABD_Object(Children[i]);
  6972.         if not o.Visible then continue;
  6973.  
  6974.         if o is TWABD_FormSection_Base then
  6975.            Result:=Result+TWABD_FormSection_Base(o).Object_To_WML_Postfield
  6976.         else
  6977.            Result:=Result+o.Object_To_WML_Postfield;
  6978.    end;
  6979. end;
  6980.  
  6981. function TWABD_Form.Object_To_HTML: string;
  6982. var
  6983.    Header   : string;
  6984.    Footer   : string;
  6985.    SesID    : string;
  6986.    EventID  : string;
  6987.    TimeStamp: string;
  6988.    ID       : longint;
  6989.    DLLName  : string;
  6990.    TimeStr  : string;
  6991.    Main     : string;
  6992.    EType    : string;
  6993. begin
  6994.    DoShow;
  6995.  
  6996.    if (Session<>nil) and (Session.Request<>nil) then
  6997.    begin
  6998.         DLLName := Session.Request.DLLName;
  6999.         ID      := Session.SessionID;
  7000.    end
  7001.    else
  7002.    begin
  7003.         DLLName := 'Unknown';
  7004.         ID      := -1;
  7005.    end;
  7006.  
  7007.    // Generate html for components on form.
  7008.    FUploadFileOnForm:=false;
  7009.    FEventHandlersOnForm:=Assigned(FOnUserCallback);
  7010.    Main:=FormSections_To_HTML;
  7011.  
  7012.    // Add the Headers and Footers
  7013.    Header := '<HTML>'+ CR +
  7014.              '<HEAD>'+ CR +
  7015.              DoPreScript + CR +
  7016.              '<META NAME="Generator" CONTENT="'+WABD_VERSION_STR+'">' + CR +
  7017.              '<TITLE>' + FormTitle + '</TITLE>'+ CR +
  7018.              '</HEAD>' + GetFormBody + CR +
  7019.              '<FORM NAME="'+Name+'" ACTION=' + extractfilename(DLLName)+' METHOD=POST';
  7020.    if (Session<>nil) and (Session.Response<>nil) and (Frame<>nil) then Session.Response.Header.Add('Window-target: '+Frame.FFrameName);
  7021.    if FSubmitTo<>nil then Header:=Header+' TARGET="'+FSubmitTo.FFrameName+'"';
  7022.    if (Session<>nil) and (Session.SessionMgr<>nil) and (Session.SessionMgr.NetworkStatistics) then
  7023.       TimeStr:='TimeNetworkSubmit(this);'
  7024.    else
  7025.        TimeStr:='';
  7026.    Footer := '</FORM>'+CR + DoPostScript + '</BODY></HTML>' + CR;
  7027.  
  7028.    SesID  := Format('<input type=hidden name=%s value='+WABD_SES_ID_STR_FORMAT+'>' + CR,
  7029.          [WABD_SES_ID_STR, ID,Name]);
  7030.    EventID := Format('<input type=hidden name=%s value=>'+CR,
  7031.          [WABD_EVENT_ID_STR]);
  7032.    TimeStamp:=Format('<input_type=hidden name=%s value=%s>',[WABD_SERVERTIMESTAMP_STR,FormatDateTime('mmddyyyyhhnnss',Now)])+CR;
  7033.  
  7034.    // Determine encode type.
  7035.    EType:=trim(FEncType);
  7036.    if (EType='') and FUploadFileOnForm then EType:='multipart/form-data';
  7037.    if EType<>'' then Header:=Header+' enctype='+EType;
  7038.  
  7039.    // Finish header.
  7040.    Header:=Header+GenEventCode(FJS_OnUserSubmit,nil,0,TimeStr)+'>'+CR;
  7041.  
  7042.    // Build result string.
  7043.    Result := Header +  Main + EventID + SesID + TimeStamp;
  7044.  
  7045.    // Add submit counter for this form to tract double submits (IE5.5 BUG) KBM 19.mar. 2001
  7046.    inc(FSubmitCount);
  7047.    if FCheckOutOfOrder then
  7048.       Result:=Result+Format('<input type=hidden name=%s value=%d>',[WABD_FORMSUBMITCOUNT_STR,FSubmitCount])+CR;
  7049.  
  7050.    if (Session<>nil) and (Session.SessionMgr<>nil) and (Session.SessionMgr.NetworkStatistics) then
  7051.       Result:=Result+
  7052.         Format('<input type=hidden name=%s value=%f>',[WABD_SERVERPROCESSTIME_STR,(Now - Session.LastAccess)*60*60*24*1000])+CR+
  7053.         Format('<input type=hidden name=%s value=%f>',[WABD_CLIENTPROCESSTIME_STR,FClientProcessTime])+CR+
  7054.         Format('<input type=hidden name=%s value=%.0f>',[WABD_CLIENTSUBMITTIMESTAMP_STR,FClientSubmitTimeStamp])+CR+
  7055.         Format('<input type=hidden name=%s value=%.0f>',[WABD_CLIENTLOADTIMESTAMP_STR,FClientLoadTimeStamp])+CR+
  7056.         Footer
  7057.    else
  7058.       Result := Result+Footer;
  7059. end;
  7060.  
  7061. function  TWABD_Form.Object_To_WML:string;
  7062. var
  7063.    Header   : string;
  7064.    Footer   : string;
  7065.    Main     : string;
  7066.    Post     : string;
  7067.    ID       : longint;
  7068.    DLLName  : string;
  7069.    EType    : string;
  7070. begin
  7071.    DoShow;
  7072.  
  7073.    if (Session<>nil) and (Session.Request<>nil) then
  7074.    begin
  7075.         DLLName := Session.Request.DLLName;
  7076.         ID      := Session.SessionID;
  7077.    end
  7078.    else
  7079.    begin
  7080.         DLLName := 'Unknown';
  7081.         ID      := -1;
  7082.    end;
  7083.  
  7084.    // Generate html for components on form.
  7085.    FUploadFileOnForm:=false;
  7086.    FEventHandlersOnForm:=Assigned(FOnUserCallback);
  7087.    Main:=FormSections_To_WML;
  7088.    Post:=FormSections_To_WML_Postfield;
  7089.  
  7090.    // Generate encoding type.
  7091.    EType:=trim(FEncType);
  7092.    if EType<>'' then EType:=' enctype='+EType;
  7093.  
  7094.    // Prepare the Headers and Footers
  7095.    Header := '<?xml version="1.0"?>'+ CR +
  7096.              '<!DOCTYPE wml PUBLIC "-//WAPFORUM//DTD WML 1.1//EN" "http://www.wapforum.org/DTD/wml_1.1.xml">' + CR +
  7097.              '<wml>'+ CR +
  7098.              '<card id="'+Name+'" title="'+FormTitle+'" newcontext="true">' + CR;
  7099.    Footer := '</card>'+CR+'</wml>'+CR;
  7100.  
  7101.    // Build result string.
  7102.    Result := Header + Main + Footer;
  7103.  
  7104.    // Add submit counter for this form to tract double submits (IE5.5 BUG) KBM 19.mar. 2001
  7105.    inc(FSubmitCount);
  7106. {
  7107.    if FCheckOutOfOrder then
  7108.       Result:=Result+Format('<input type=hidden name=%s value=%d>',[WABD_FORMSUBMITCOUNT_STR,FSubmitCount])+CR;
  7109. }
  7110. end;
  7111.  
  7112. procedure TWABD_Form.HTML_To_Object(FormVal: string);
  7113. begin
  7114.     // Nothing.
  7115. end;
  7116.  
  7117. procedure TWABD_Form.Show;
  7118. begin
  7119.    if not Assigned(FWSession) then
  7120.       raise Exception.CreateFmt('TWABD_Form "%s" does not have a WABD_Session!', [Name]);
  7121.    FWSession.NewBody := Self;
  7122. end;
  7123.  
  7124. // ************************************************************************
  7125. // "TOP" Level Objects
  7126. // ************************************************************************
  7127.  
  7128.  
  7129. // TWABD_Header
  7130.  
  7131. constructor TWABD_Header.Create(AOwner: TComponent);
  7132. begin
  7133.    inherited;
  7134.    FNum := 1;
  7135. end;
  7136.  
  7137. procedure TWABD_Header.SetName(const Value: TComponentName);
  7138. begin
  7139.    if (not (csLoading in ComponentState)) and ((FCaption='') or (FCaption=Name)) then Caption := Value;
  7140.    inherited;
  7141. end;
  7142.  
  7143. procedure TWABD_Header.SetNum(NewNum: integer);
  7144. begin
  7145.    if NewNum < 1 then NewNum := 1;
  7146.    if NewNum > 6 then NewNum := 6;
  7147.    FNum := NewNum;
  7148. end;
  7149.  
  7150. function TWABD_Header.Object_To_HTML: string;
  7151. begin
  7152.    Result := Format('<H%d>%s</H%d>'+CR, [HeaderNum, ASCII_To_HTML(Caption), HeaderNum]);
  7153. end;
  7154.  
  7155. procedure TWABD_Header.HTML_To_Object(FormVal: string);
  7156. begin
  7157.    Caption := FormVal; // HTML_To_ASCII(FormVal); // Already done before passed here
  7158. end;
  7159.  
  7160. function TWABD_Header.Object_To_Control(AOwner: TWinControl): TControl;
  7161. var
  7162.    nl : TLabel;
  7163. begin
  7164.    nl := TLabel.Create(AOwner);
  7165.    nl.Name        := Name;
  7166.    nl.Caption     := Caption;
  7167.    nl.Font.Name   := 'Arial';
  7168.    nl.Font.Size   := 9 + (6-HeaderNum) * 4;
  7169.    nl.Height      := Round(nl.Height * 1.2);
  7170.    nl.Transparent := True;
  7171.    Result := nl;
  7172. end;
  7173.  
  7174.  
  7175.  
  7176. // TWABD_Tree
  7177.  
  7178. constructor TWABD_TreeNode.Create(AOwner: TComponent);
  7179. begin
  7180.      inherited Create(AOwner);
  7181.      FJS_OnUserClick:=TWABD_JS_Function.Create(jsOnClick);
  7182.      FLevel:=0;
  7183.      FDefaultOpen:=false;
  7184. end;
  7185.  
  7186. destructor TWABD_TreeNode.Destroy;
  7187. begin
  7188.      FJS_OnUserClick.free;
  7189.      inherited;
  7190. end;
  7191.  
  7192. procedure TWABD_TreeNode.Notification(AComponent: TComponent; Operation: TOperation);
  7193. begin
  7194.      inherited;
  7195.      if (Operation=opRemove) then
  7196.      begin
  7197.         if AComponent=FImgIconLink then FImgIconLink:=nil
  7198.         else if AComponent=FSubmitTo then FSubmitTo:=nil;
  7199.      end;
  7200. end;
  7201.  
  7202. procedure TWABD_TreeNode.SetCaption(s:string);
  7203. begin
  7204.      FCaption:=s;
  7205.      Changed;
  7206. end;
  7207.  
  7208. procedure TWABD_TreeNode.DefineProperties(Filer: TFiler);
  7209. begin
  7210.    inherited;
  7211.    Filer.DefineProperty('Level', ReadLevel, WriteLevel, True);
  7212. end;
  7213.  
  7214. procedure TWABD_TreeNode.WriteLevel(Writer: TWriter);
  7215. begin
  7216.    Writer.WriteInteger(FLevel);
  7217. end;
  7218.  
  7219. procedure TWABD_TreeNode.ReadLevel(Reader: TReader);
  7220. begin
  7221.    FLevel := Reader.ReadInteger;
  7222. end;
  7223.  
  7224. function  TWABD_TreeNode.Object_To_HTML: string;
  7225. begin
  7226.      Result:='';
  7227. end;
  7228.  
  7229. function  TWABD_TreeNode.Object_To_Control(AOwner: TWinControl): TControl;
  7230. begin
  7231.      Result:=nil;
  7232. end;
  7233.  
  7234. procedure TWABD_TreeNode.HTML_To_Object(FormVal: string);
  7235. begin
  7236. end;
  7237.  
  7238. constructor TWABD_Tree.Create(AOwner: TComponent);
  7239. begin
  7240.      inherited;
  7241.      FEdTree:=TWABDEditTree.Create;
  7242.      FEdTree.ParTree:=self;
  7243.      FJS_OnUserClick:=TWABD_JS_Function.Create(jsOnClick);
  7244. end;
  7245.  
  7246. destructor TWABD_Tree.Destroy;
  7247. begin
  7248.      FJS_OnUserClick.free;
  7249.      inherited;
  7250. end;
  7251.  
  7252. procedure TWABD_Tree.SetEdTree(NewEdTree: TWABDEditTree);
  7253. begin
  7254. //
  7255. end;
  7256.  
  7257. function TWABD_Tree.Object_To_HTML: string;
  7258. begin
  7259.      Result:='';
  7260. //
  7261. end;
  7262.  
  7263. function TWABD_Tree.Object_To_Control(AOwner: TWinControl): TControl;
  7264. var
  7265.    nl : TTreeView;
  7266. begin
  7267.    nl := TTreeView.Create(AOwner);
  7268.    nl.Name        := Name;
  7269.    Result := nl;
  7270. end;
  7271.  
  7272. procedure TWABD_Tree.HTML_To_Object(FormVal: string);
  7273. begin
  7274.     // Nothing.
  7275. end;
  7276.  
  7277. procedure TWABD_Tree.ProcessRequest(Request:TWABD_CustomRequest);
  7278. var
  7279.    s:string;
  7280.    n:TWABD_TreeNode;
  7281. begin
  7282.      inherited;
  7283.  
  7284.      // Find which node has been cliced.
  7285.      s:=Request.Query.Values[WABD_MENUTREE_STR];
  7286.      if s<>'' then
  7287.      begin
  7288.           n:=TWABD_TreeNode(FindComponentRecursive(Owner,s));
  7289.           Assert(n<>nil, 'Node does not exist: ' + s);
  7290.           if Assigned(n.OnUserClick) then n.OnUserClick(n);
  7291.      end;
  7292. end;
  7293.  
  7294. function TWABD_Tree.NodeByName(NodeName:string):TWABD_TreeNode;
  7295. var
  7296.    i:integer;
  7297. begin
  7298.      NodeName:=UpperCase(NodeName);
  7299.      Result:=nil;
  7300.      for i:=0 to ChildCount-1 do
  7301.      begin
  7302.           if UpperCase(TWABD_TreeNode(Children[i]).Name) = NodeName then
  7303.           begin
  7304.                Result:=TWABD_TreeNode(Children[i]);
  7305.                exit;
  7306.           end;
  7307.      end;
  7308. end;
  7309.  
  7310. function TWABD_Tree.AddNode(Name:string; RefNode:TWABD_TreeNode; Flags:TWABD_AddTreeNodeFlags):TWABD_TreeNode;
  7311. var
  7312.    i:integer;
  7313.    RefIndex:integer;
  7314.    ANode:TWABD_TreeNode;
  7315.    InsLevel:integer;
  7316. begin
  7317.      // Find index of refnode.
  7318.      RefIndex:=-1;
  7319.      if (RefNode<>nil) then
  7320.      begin
  7321.           for i:=0 to ChildCount-1 do
  7322.           begin
  7323.                // Get node info.
  7324.                ANode:=TWABD_TreeNode(Children[i]);
  7325.                if RefNode=ANode then RefIndex:=i;
  7326.           end;
  7327.      end;
  7328.  
  7329.      // Check insertion level.
  7330.      InsLevel:=0;
  7331.      if RefIndex>=0 then
  7332.      begin
  7333.           if atnChild in flags then
  7334.              InsLevel:=RefNode.Level+1
  7335.           else
  7336.               InsLevel:=RefNode.Level;
  7337.      end;
  7338.  
  7339.      // Check flags for how to insert.
  7340.      if atnFirst in flags then
  7341.      begin
  7342.           // If Refnode given, look for first node in same level.
  7343.           if RefIndex>=0 then
  7344.           begin
  7345.                for i:=RefIndex-1 downto 0 do
  7346.                    if TWABD_TreeNode(Children[i]).FLevel<InsLevel then break;
  7347.           end
  7348.           else i:=0;
  7349.           RefIndex:=i;
  7350.      end
  7351.      else if atnLast in flags then
  7352.      begin
  7353.           // If Refnode given, look for last node in same level.
  7354.           if RefIndex>=0 then
  7355.           begin
  7356.                for i:=RefIndex+1 to ChildCount-1 do
  7357.                    if TWABD_TreeNode(Children[i]).FLevel<InsLevel then break;
  7358.           end
  7359.           else i:=ChildCount-1;
  7360.           RefIndex:=i;
  7361.      end;
  7362.  
  7363.      // Check if insert before or after found index.
  7364.      if atnBefore in flags then
  7365.      begin
  7366.           if RefIndex<0 then RefIndex:=0;
  7367.      end
  7368.      else //if atnAfter in flags then
  7369.      begin
  7370.           if RefIndex<0 then RefIndex:=0
  7371.           else inc(RefIndex);
  7372.      end;
  7373.      if RefIndex<0 then RefIndex:=0;
  7374.  
  7375.      // Create a new node and insert it.
  7376.      Result:=TWABD_TreeNode.Create(self);
  7377.      Result.Name:=Name;
  7378.      Result.Parent:=self;
  7379.      Result.Order:=RefIndex;
  7380.      Result.Level:=InsLevel;
  7381. end;
  7382.  
  7383. procedure TWABD_Tree.DeleteNode(ANode:TWABD_TreeNode; FreeNode:boolean);
  7384. begin
  7385.      ANode.Parent:=nil;
  7386.      if FreeNode then ANode.Free;
  7387. end;
  7388.  
  7389. procedure TWABD_Tree.Clear(FreeNodes:boolean);
  7390. var
  7391.    i:integer;
  7392.    node:TWABD_TreeNode;
  7393. begin
  7394.      for i:=ChildCount-1 downto 0 do
  7395.      begin
  7396.           node:=TWABD_TreeNode(Children[i]);
  7397.           node.Parent:=nil;
  7398.           if FreeNodes then node.free;
  7399.      end;
  7400. end;
  7401.  
  7402. // Menu tree.
  7403. constructor TWABD_MenuTree.Create(AOwner: TComponent);
  7404. begin
  7405.      inherited;
  7406.  
  7407.      FImages:=TstringList.create;
  7408.      FVariables:=TstringList.create;
  7409. end;
  7410.  
  7411. destructor TWABD_MenuTree.Destroy;
  7412. begin
  7413.      FVariables.free;
  7414.      FImages.free;
  7415.      inherited;
  7416. end;
  7417.  
  7418. procedure TWABD_MenuTree.Notification(AComponent: TComponent; Operation: TOperation);
  7419. begin
  7420.     inherited;
  7421.     if (Operation=opRemove) then
  7422.     begin
  7423.         if AComponent=FJavascript then FJavascript:=nil
  7424.         else if AComponent=FSubmitTo then FSubmitTo:=nil;
  7425.     end;
  7426. end;
  7427.  
  7428. // Define setup javascript of menutree.
  7429. function TWABD_MenuTree.GenMenuTreeJSSetup:string;
  7430. var
  7431.    s:string;
  7432.    sclick,target,shint:string;
  7433.    DLLName:string;
  7434.    ID:longint;
  7435.    i,j:integer;
  7436.    NextLevel:integer;
  7437.    ParentNode,ThisNode:TWABD_TreeNode;
  7438.    nItems:integer;
  7439.    img:string;
  7440.    image:TWABD_Image;
  7441.    Session:TWABD_Session;
  7442.  
  7443. begin
  7444.      // Get identifiers.
  7445.      if (Frame<>nil) and (Frame.Frameset<>nil) then
  7446.         Session:=Frame.Frameset.FWSession
  7447.      else
  7448.          Session:=nil;
  7449.      if (Session<>nil) and (Session.Request<>nil) then begin
  7450.         DLLName := extractfilename(Session.Request.DLLName);
  7451.         ID      := Session.SessionID;
  7452.      end else begin
  7453.         DLLName := 'Unknown_DLL';
  7454.         ID      := -1;
  7455.      end;
  7456.  
  7457.      // Nitti gritti standard stuff.
  7458.      s:='function loadData() {'+CR;
  7459.      s:=s+'  top.'+Name+'.clear();'+CR;
  7460.      s:=s+'  top.'+Name+'.output=self;';
  7461.      s:=s+'  top.'+Name+'.add(new top.RootNode("root","'+Caption+'","","",""));'+CR;
  7462.  
  7463.      // Traverse tree definition.
  7464.      ParentNode:=nil;
  7465.      nItems:=Tree.ParTree.ChildCount;
  7466.      for i := 0 to nItems-1 do begin
  7467.  
  7468.         // Get node info.
  7469.         ThisNode:=TWABD_TreeNode(Tree.ParTree.Children[i]);
  7470.         if i<nItems-1 then
  7471.             NextLevel:=TWABD_TreeNode(Tree.ParTree.Children[i+1]).Level
  7472.         else
  7473.             NextLevel:=-1;
  7474.         if ParentNode=nil then ParentNode:=ThisNode;
  7475.  
  7476.         // Check level of node to determine how to add it.
  7477.  
  7478.  
  7479.         // Prepare icon to show.
  7480.         if assigned(ThisNode.Icon) then     // If icon assigned on node, use it together with setup if assigned.
  7481.            image:=ThisNode.Icon
  7482.         else
  7483.            image:=FImgIconLink;
  7484.  
  7485.         if assigned(image) then             // If no icon assigned whatsoever, dont show a node.
  7486.         begin
  7487.              if RunningLocal then
  7488.                 img:=image.LocalImagePath
  7489.              else
  7490.                  img:=image.ImagePath;
  7491.              image.UpdateImage;
  7492.         end
  7493.         else
  7494.             img:='';
  7495.  
  7496.         // Check if onuserclick handler assigned.
  7497.         sclick:='';
  7498.         if assigned(ThisNode.OnUserClick) then
  7499.         begin
  7500.              if FJS_OnUserEvent.FScript<>'' then sclick:=sclick+GenJSFunctionCall(FJS_OnUserEvent)+';';
  7501.              sclick:=sclick+format('HTTP:%s?%s='+WABD_SES_ID_STR_FORMAT+'&%s=%s',[DllName,WABD_SES_ID_STR,ID,Name,WABD_MENUTREE_STR,ThisNode.Name])
  7502.         end;
  7503.  
  7504.         // Get target name.
  7505.         if assigned(ThisNode.FSubmitTo) then
  7506.             target:=ThisNode.FSubmitTo.FFrameName
  7507.         else if assigned(self.FSubmitTo) then
  7508.             target:=self.FSubmitTo.FFrameName
  7509.         else
  7510.             target:='';
  7511.  
  7512.         // Get hint.
  7513.         shint:=ThisNode.hint;
  7514.  
  7515.         // If TOP level.
  7516.         if ThisNode.FLevel = 0 then
  7517.         begin
  7518.              // If contains children, create foldernode otherwise create linknode.
  7519.              if NextLevel>ThisNode.FLevel then
  7520.              begin
  7521.                   s:=s+'  top.'+Name+'.add(new top.FolderNode("'+ThisNode.Name+'","root","'+ThisNode.Caption+'","","'+img+'","'+shint+'",'+inttostr(ord(ThisNode.DefaultOpen))+'));'+CR;
  7522.                   ParentNode:=ThisNode;
  7523.              end
  7524.              else
  7525.                 s:=s+'  top.'+Name+'.add(new top.LinkNode("root","'+ThisNode.Caption+'","'+sclick+'","'+target+'","'+img+'","'+shint+'"));'+CR;
  7526.         end
  7527.  
  7528.         // If CHILD level.
  7529.         else if ThisNode.FLevel > ParentNode.FLevel then
  7530.         begin
  7531.              // If contains children, create foldernode otherwise create linknode.
  7532.              if NextLevel>ThisNode.FLevel then
  7533.              begin
  7534.                   s:=s+'    top.'+Name+'.add(new top.FolderNode("'+ThisNode.Name+'","'+ParentNode.Name+'","'+ThisNode.Caption+'","","'+img+'","'+shint+'",'+inttostr(ord(ThisNode.DefaultOpen))+'));'+CR;
  7535.                   ParentNode:=ThisNode;
  7536.              end
  7537.              else
  7538.                 s:=s+'    top.'+Name+'.add(new top.LinkNode("'+ParentNode.Name+'","'+ThisNode.Caption+'","'+sclick+'","'+target+'","'+img+'","'+shint+'"));'+CR;
  7539.         end
  7540.  
  7541.         // If SIBLING of another lesser level.
  7542.         else if ThisNode.FLevel <= ParentNode.FLevel then
  7543.         begin
  7544.              // if sibling of another lesser level, backtrack to find parent.
  7545.              j:=i-1;
  7546.              while j>=0 do
  7547.              begin
  7548.                   ParentNode:=TWABD_TreeNode(Tree.ParTree.Children[j]);
  7549.                   if ParentNode.FLevel<ThisNode.FLevel then break;
  7550.                   dec(j);
  7551.              end;
  7552.  
  7553.              // If contains children, create foldernode otherwise create linknode.
  7554.              if NextLevel>ThisNode.FLevel then
  7555.              begin
  7556.                   s:=s+'    top.'+Name+'.add(new top.FolderNode("'+ThisNode.Name+'","'+ParentNode.Name+'","'+ThisNode.Caption+'","","'+img+'","'+shint+'",'+inttostr(ord(ThisNode.DefaultOpen))+'));'+CR;
  7557.                   ParentNode:=ThisNode;
  7558.              end
  7559.              else
  7560.                 s:=s+'    top.'+Name+'.add(new top.LinkNode("'+ParentNode.Name+'","'+ThisNode.Caption+'","'+sclick+'","'+target+'","'+img+'","'+shint+'"));'+CR;
  7561.         end
  7562.  
  7563.         // if SIBLING of prev node (same level).
  7564.         else
  7565.         begin
  7566.              // If contains children, create foldernode otherwise create linknode.
  7567.              if NextLevel>ThisNode.FLevel then
  7568.                 s:=s+'    top.'+Name+'.add(new top.FolderNode("'+ThisNode.Name+'","'+ParentNode.Name+'","'+ThisNode.Caption+'","","'+img+'","'+shint+'",'+inttostr(ord(ThisNode.DefaultOpen))+'));'+CR
  7569.              else
  7570.                 s:=s+'    top.'+Name+'.add(new top.LinkNode("'+ParentNode.Name+'","'+ThisNode.Caption+'","'+sclick+'","'+target+'","'+img+'","'+shint+'"));'+CR;
  7571.         end;
  7572.      end;
  7573.      s:=s+'}'+CR;
  7574.      Result:=s;
  7575. end;
  7576.  
  7577. // Setup variables from Setup variable and FLayout stringlist.
  7578. procedure TWABD_MenuTree.SetupVariables;
  7579.      function DefImg(img:TWABD_Image;V:string):string;
  7580.      begin
  7581.           Result:=V+'=';
  7582.           if assigned(img) then
  7583.           begin
  7584.                if RunningLocal then Result:=Result+'file://' + img.LocalImagePath
  7585.                else Result:=Result+img.ImagePath;
  7586.           end;
  7587.      end;
  7588. begin
  7589.      // Find path to icons.
  7590.  
  7591.      with FVariables do
  7592.      begin
  7593.           Clear;
  7594.  
  7595.           // Build variablelist of menu tree icons.
  7596.           add(DefImg(fImgIconBlank,WABD_MT_IMG_BLANK));
  7597.           add(DefImg(FImgIconBranchCont,WABD_MT_IMG_BRANCH_CONT));
  7598.           add(DefImg(FImgIconBranchEnd,WABD_MT_IMG_BRANCH_END));
  7599.           add(DefImg(FImgIconFolderClosed,WABD_MT_IMG_FOLDER_CLOSED));
  7600.           add(DefImg(FImgIconFolderOpen,WABD_MT_IMG_FOLDER_OPEN));
  7601.           add(DefImg(FImgIconRoot,WABD_MT_IMG_ROOT));
  7602.           add(DefImg(FImgIconMinusCont,WABD_MT_IMG_MINUS_CONT));
  7603.           add(DefImg(FImgIconMinusEnd,WABD_MT_IMG_MINUS_END));
  7604.           add(DefImg(FImgIconPlusCont,WABD_MT_IMG_PLUS_CONT));
  7605.           add(DefImg(FImgIconPlusEnd,WABD_MT_IMG_PLUS_END));
  7606.           add(DefImg(FImgIconVertLine,WABD_MT_IMG_VERT_LINE));
  7607.           add(DefImg(FBgrdImage,WABD_MT_IMG_BG));
  7608.  
  7609.           // Build variablelist of other info.
  7610.           add(WABD_MT_SIZE_FONT+'='+inttostr(FFontSize));
  7611.           add(WABD_MT_COLOR_FONT+'='+ColorTOHTML(FFontColor,''''));
  7612.           add(WABD_MT_COLOR_BG+'='+ColorTOHTML(FBGColor,''''));
  7613.           add(WABD_MT_COLOR_LINK+'='+ColorTOHTML(FLinkColor,''''));
  7614.           add(WABD_MT_COLOR_VLINK+'='+ColorTOHTML(FVLinkColor,''''));
  7615.           add(WABD_MT_COLOR_ALINK+'='+ColorTOHTML(FALinkColor,''''));
  7616.           add(WABD_MT_FRAME+'='+Frame.Name);
  7617.           if FSubmitto=nil then
  7618.              add(WABD_MT_FRAME_TARGET+'='+Frame.FFrameName)
  7619.           else
  7620.               add(WABD_MT_FRAME_TARGET+'='+FSubmitto.FFrameName);
  7621.      end;
  7622. end;
  7623.  
  7624. function TWABD_MenuTree.Object_To_Top_HTML: string;
  7625.    procedure UpdImg(img:TWABD_Image);
  7626.    begin
  7627.         if assigned(img) then img.UpdateImage;
  7628.    end;
  7629. begin
  7630.      // Make sure images are updated.
  7631.      UpdImg(FImgIconBlank);
  7632.      UpdImg(FImgIconBranchCont);
  7633.      UpdImg(FImgIconBranchEnd);
  7634.      UpdImg(FImgIconFolderClosed);
  7635.      UpdImg(FImgIconFolderOpen);
  7636.      UpdImg(FImgIconRoot);
  7637.      UpdImg(FImgIconMinusCont);
  7638.      UpdImg(FImgIconMinusEnd);
  7639.      UpdImg(FImgIconPlusCont);
  7640.      UpdImg(FImgIconPlusEnd);
  7641.      UpdImg(FImgIconVertLine);
  7642.      UpdImg(FBgrdImage);
  7643.  
  7644.      // Setup variables to be used for dynamically alter the javascript.
  7645.      SetupVariables;
  7646.  
  7647.      // Result is modified standard menu javascript.
  7648.      Result:=CR+'var '+Name+'=new Collection("'+Name+'");'+CR+CR;
  7649.      if Assigned(FJavascript) then
  7650.         Result:=Result+Process_Variables(FJavascript.FLines.Text,FVariables);
  7651. end;
  7652.  
  7653. function TWABD_MenuTree.Object_To_HTML: string;
  7654. var
  7655.    header,footer:string;
  7656. begin
  7657.      DoShow();
  7658.      Header := '<HTML><HEAD>' + CR +
  7659.                '<META NAME="Generator" CONTENT="'+WABD_VERSION_STR+'">' + CR +
  7660.                '<TITLE>' + FCaption + '</TITLE>' + CR +
  7661.                JS_BEGIN+GenMenuTreeJSSetup+JS_END+
  7662.                '</HEAD>'+CR+'<BODY onLoad="loadData(); top.Start(top.'+Name+')">';
  7663.      Footer := '<P>MENUTREE</P></BODY></HTML>';
  7664.  
  7665.      Result:=Header+Footer;
  7666. end;
  7667.  
  7668. procedure TWABD_MenuTree.HTML_To_Object(FormVal: string);
  7669. begin
  7670.     // Nothing.
  7671. end;
  7672.  
  7673.  
  7674. // ************************************************************************
  7675. // TWABD_HTMLSection
  7676. // ************************************************************************
  7677.  
  7678. constructor TWABD_HTMLSection.Create(AOwner: TComponent);
  7679. begin
  7680.    inherited;
  7681.    FHTML := TStringList.Create;
  7682. end;
  7683.  
  7684. destructor TWABD_HTMLSection.Destroy;
  7685. begin
  7686.    FHTML.Free;
  7687.    inherited;
  7688. end;
  7689.  
  7690. procedure TWABD_HTMLSection.SetHTML(NewHTML: TStrings);
  7691. begin
  7692.    FHTML.Assign(NewHTML);
  7693. end;
  7694.  
  7695. procedure TWABD_HTMLSection.SetName(const Value: TComponentName);
  7696. begin
  7697.    if (not (csLoading in ComponentState)) and ((FHTML.Text='') or (FHTML.Text='<P>'+Name+'</P>')) then FHTML.Text := '<P>'+Value+'</P>';
  7698.    inherited;
  7699. end;
  7700.  
  7701. function TWABD_HTMLSection.Object_To_HTML: string;
  7702. begin
  7703.      Result:=HTML.Text;
  7704. end;
  7705.  
  7706. function TWABD_HTMLSection.Object_To_WML: string;
  7707. begin
  7708.      Result:=Object_To_HTML;
  7709. end;
  7710.  
  7711. procedure TWABD_HTMLSection.HTML_To_Object(FormVal: string);
  7712. begin
  7713.      HTML.Text := FormVal;
  7714. end;
  7715.  
  7716. function TWABD_HTMLSection.Object_To_Control(AOwner: TWinControl): TControl;
  7717. begin
  7718.      Result := nil;
  7719. end;
  7720.  
  7721. // ************************************************************************
  7722. // TWABD_HTMLFileSection
  7723. // ************************************************************************
  7724.  
  7725. constructor TWABD_HTMLFileSection.Create(AOwner:TComponent);
  7726. begin
  7727.      inherited;
  7728.      FLoadedWhen:=0;
  7729.      FSecsBeforeReload:=0;
  7730.      FCached:=false;
  7731. end;
  7732.  
  7733. destructor TWABD_HTMLFileSection.Destroy;
  7734. begin
  7735.      inherited;
  7736. end;
  7737.  
  7738. function TWABD_HTMLFileSection.Object_To_HTML:string;
  7739. begin
  7740.      // Check if cached and to be reloaded or not loaded yet then load.
  7741.      if (FLoadedWhen = 0) or
  7742.         ((FCached) and (FSecsBeforeReload>0) and (trunc((now - FLoadedWhen)*24.0*3600.0) > FSecsBeforeReload)) then
  7743.         Reload;
  7744.  
  7745.      Result:=FHTML.Text;
  7746. end;
  7747.  
  7748. function TWABD_HTMLFileSection.Object_To_WML:string;
  7749. begin
  7750.      Result:=Object_To_HTML;
  7751. end;
  7752.  
  7753. procedure TWABD_HTMLFileSection.Reload;
  7754. var
  7755.    fn:string;
  7756. begin
  7757.      if FSetup=nil then
  7758.         fn:=FFileName
  7759.      else
  7760.          fn:=FSetup.GetLocalFilePath+FFileName;
  7761.      if fn='' then exit;
  7762.      FHTML.LoadFromFile(fn);
  7763.      FLoadedWhen:=now;
  7764. end;
  7765.  
  7766. procedure TWABD_HTMLFileSection.Notification(AComponent: TComponent; Operation: TOperation);
  7767. begin
  7768.     inherited;
  7769.     if (Operation=opRemove) then
  7770.     begin
  7771.          if AComponent=FSetup then FSetup:=nil;
  7772.     end;
  7773. end;
  7774.  
  7775. // ************************************************************************
  7776. // TWABD_HTMLEmbed
  7777. // ************************************************************************
  7778.  
  7779. constructor TWABD_HTMLEmbed.Create(AOwner: TComponent);
  7780. begin
  7781.    inherited;
  7782.    FHTML := TStringList.Create;
  7783.    Width:=PIXELS_PER_CHAR_X * 10;
  7784.    Height:=PIXELS_PER_CHAR_Y*2;
  7785. end;
  7786.  
  7787. destructor TWABD_HTMLEmbed.Destroy;
  7788. begin
  7789.    FHTML.Free;
  7790.    inherited;
  7791. end;
  7792.  
  7793. procedure TWABD_HTMLEmbed.SetWidth(w:integer);
  7794. begin
  7795.    inherited Width:=w;
  7796.    Changed;
  7797. end;
  7798.  
  7799. procedure TWABD_HTMLEmbed.SetHeight(h:integer);
  7800. begin
  7801.    inherited Height:=h;
  7802.    Changed;
  7803. end;
  7804.  
  7805. function TWABD_HTMLEmbed.GetWidth:integer;
  7806. begin
  7807.    Result:=inherited Width;
  7808. end;
  7809.  
  7810. function TWABD_HTMLEmbed.GetHeight:integer;
  7811. begin
  7812.    Result:=inherited Height;
  7813. end;
  7814.  
  7815. procedure TWABD_HTMLEmbed.SetHTML(NewHTML: TStrings);
  7816. begin
  7817.    FHTML.Assign(NewHTML);
  7818.    Changed;
  7819. end;
  7820.  
  7821. procedure TWABD_HTMLEmbed.SetName(const Value: TComponentName);
  7822. begin
  7823.    if (not (csLoading in ComponentState)) and ((FHTML.Text='') or (FHTML.Text='<P>'+Name+'</P>')) then FHTML.Text := '<P>'+Value+'</P>';
  7824.    inherited;
  7825. end;
  7826.  
  7827. function TWABD_HTMLEmbed.Object_To_HTML: string;
  7828. begin
  7829.      Result:=FHTML.Text;
  7830. end;
  7831.  
  7832. function TWABD_HTMLEmbed.Object_To_WML: string;
  7833. begin
  7834.      Result:=Object_To_HTML;
  7835. end;
  7836.  
  7837. procedure TWABD_HTMLEmbed.HTML_To_Object(FormVal: string);
  7838. begin
  7839.    HTML.Text := FormVal;
  7840. end;
  7841.  
  7842. function TWABD_HTMLEmbed.Object_To_Control(AOwner: TWinControl): TControl;
  7843. var
  7844.    ne:TMemo;
  7845. begin
  7846.    ne := TMemo.Create(AOwner);
  7847.    ne.Parent   := AOwner;
  7848.    ne.Name     := Name;
  7849.    ne.Height   := 0;
  7850.    ne.Lines.Assign(FHTML);
  7851.    Result := ne;
  7852. end;
  7853.  
  7854. // ************************************************************************
  7855. // TWABD_HTMLFileEmbed
  7856. // ************************************************************************
  7857.  
  7858. constructor TWABD_HTMLFileEmbed.Create(AOwner:TComponent);
  7859. begin
  7860.      inherited;
  7861.      FLoadedWhen:=0;
  7862.      FSecsBeforeReload:=0;
  7863.      FCached:=false;
  7864. end;
  7865.  
  7866. destructor TWABD_HTMLFileEmbed.Destroy;
  7867. begin
  7868.      inherited;
  7869. end;
  7870.  
  7871. function TWABD_HTMLFileEmbed.Object_To_HTML:string;
  7872. begin
  7873.      // Check if cached and to be reloaded or not loaded yet then load.
  7874.      if (FLoadedWhen = 0) or
  7875.         ((FCached) and (FSecsBeforeReload>0) and (trunc((now - FLoadedWhen)*24.0*3600.0) > FSecsBeforeReload)) then
  7876.         Reload;
  7877.  
  7878.      Result:=FHTML.Text;
  7879. end;
  7880.  
  7881. function TWABD_HTMLFileEmbed.Object_To_WML:string;
  7882. begin
  7883.      Result:=Object_To_HTML;
  7884. end;
  7885.  
  7886. procedure TWABD_HTMLFileEmbed.Reload;
  7887. var
  7888.    fn:string;
  7889. begin
  7890.      if FSetup=nil then
  7891.         fn:=FFileName
  7892.      else
  7893.          fn:=FSetup.GetLocalFilePath+FFileName;
  7894.      if fn='' then exit;
  7895.      FHTML.LoadFromFile(fn);
  7896.      FLoadedWhen:=now;
  7897. end;
  7898.  
  7899. procedure TWABD_HTMLFileEmbed.Notification(AComponent: TComponent; Operation: TOperation);
  7900. begin
  7901.     inherited;
  7902.     if (Operation=opRemove) then
  7903.     begin
  7904.          if AComponent=FSetup then FSetup:=nil;
  7905.     end;
  7906. end;
  7907.  
  7908. // TWABD_JS_Function
  7909.  
  7910. constructor TWABD_JS_Function.Create(jsType:TWABD_JS_Function_Type);
  7911. begin
  7912.     inherited Create;
  7913.     FParams:=TStringList.create;
  7914.     FPlacement:=jsfLast;
  7915.     FType:=jsType;
  7916. end;
  7917.  
  7918. destructor TWABD_JS_Function.Destroy;
  7919. begin
  7920.     if FParams<>nil then FParams.free;
  7921.     inherited;
  7922. end;
  7923.  
  7924. procedure TWABD_JS_Function.SetScript(scr:string);
  7925. begin
  7926.      FScript:=trim(scr);
  7927.      if (FScript='') then FParams.Clear;
  7928. end;
  7929.  
  7930. // TWABD_Javascript
  7931.  
  7932. constructor TWABD_Javascript.Create(AOwner: TComponent);
  7933. begin
  7934.      inherited;
  7935.      FPlacement:=jsFirst;
  7936.      FLines:=TStringList.create;
  7937. end;
  7938.  
  7939. destructor TWABD_Javascript.Destroy;
  7940. begin
  7941.      FLines.free;
  7942.      inherited;
  7943. end;
  7944.  
  7945. procedure TWABD_Javascript.Notification(AComponent: TComponent; Operation: TOperation);
  7946. begin
  7947.     inherited;
  7948.     if (Operation=opRemove) then
  7949.     begin
  7950.          if AComponent=FSetup then FSetup:=nil;
  7951.     end;
  7952. end;
  7953.  
  7954. procedure TWABD_Javascript.SetLines(NewLines: TStrings);
  7955. begin
  7956.    FLines.Assign(NewLines);
  7957. end;
  7958.  
  7959. // Process macros.
  7960. function TWABD_Javascript.ProcessMacros(JS:string):string;
  7961.     function GetValue(macro:string):string;
  7962.     var
  7963.        args,arge:integer;
  7964.        f,arg:string;
  7965.        par:TStringList;
  7966.     begin
  7967.         // Parameterlist.
  7968.         par:=TStringList.create;
  7969.  
  7970.         try
  7971.             // Split into name and argument.
  7972.             args:=pos('(',macro);
  7973.             arge:=pos(')',macro);
  7974.             if args>0 then
  7975.             begin
  7976.                  f:=copy(macro,1,args-1);
  7977.                  arg:=copy(macro,args+1,(arge-args)-1);
  7978.                  par.CommaText:=arg;
  7979.             end
  7980.             else
  7981.             begin
  7982.                  f:=macro;
  7983.                  arg:='';
  7984.             end;
  7985.             f:=UpperCase(f);
  7986.  
  7987.             // Look at name.
  7988.             if f='SESSIONID' then Result:=inttostr(SessionID)
  7989.             else if f='DLLNAME' then Result:=DLLName
  7990.             else if f='IMAGEPATH' then
  7991.             begin
  7992.                 if Assigned(FSetup) then Result:=FSetup.GetImagePath
  7993.                 else Result:='';
  7994.             end
  7995.             else if f='FRAMESRC' then
  7996.             begin
  7997.                 if par.Count<2 then raise Exception.Create('Syntax: [!--FRAMESRC(Framename,Formname)--!]');
  7998.                 Result:=URL_To_HTML(DLLName+'?SESSIONID='+inttostr(SessionID)+':'+par[1]+'&'+WABD_FRAME_STR+'='+par[0]+'&'+WABD_RELOAD_STR+'=Yes');
  7999.             end
  8000.             else if f='STAMP' then
  8001.             begin
  8002.                 Result:=WABD_STAMP_STR+'='+FloatToStr(Now);
  8003.             end
  8004.             else if f='CALLBACK' then
  8005.             begin
  8006.                 Result:='HandleEvent('+inttostr(WABD_EVENT_CALLBACK)+',this.form,this,'''+par.CommaText+''')';
  8007.             end
  8008.             else raise Exception.Create('Unrecognized WABD macro: '+f+'('+arg+')');
  8009.  
  8010.         finally
  8011.             par.free;
  8012.         end;
  8013.     end;
  8014. var
  8015.    s,ss,v:string;
  8016.    j,k:integer;
  8017. begin
  8018.    s:='';  // Processed string.
  8019.    ss:=JS;  // Remaining nonprocessed string.
  8020.  
  8021.    // Loop while there are macros to setup.
  8022.    while true do
  8023.    begin
  8024.         j:=pos('[!--',ss);    // Look for startermarker for macro.
  8025.         if j>0 then
  8026.         begin
  8027.              s:=s+copy(ss,1,j-1); // Add the raw data before the startermarker as a result.
  8028.  
  8029.              ss:=copy(ss,j,length(ss));
  8030.              k:=pos('--!]',ss);  // Look for the endmarker for macro.
  8031.              if k>0 then
  8032.              begin
  8033.                   v:=copy(ss,5,k-5);  // Extract macro.
  8034.                   ss:=copy(ss,k+4,length(ss)); // Only process rest of the string.
  8035.                   s:=s+GetValue(v);
  8036.              end
  8037.              else
  8038.                  raise Exception.CreateFmt('Macro endmarker not found %s', [copy(ss,1,30)]);
  8039.         end
  8040.         else                    // No startermarker found, just add the rest of the text to result and break.
  8041.         begin
  8042.              s:=s+ss;
  8043.              break;
  8044.         end;
  8045.    end;
  8046.    Result := s;
  8047. end;
  8048.  
  8049. // TWAND_AutoRefresh
  8050. function TWABD_Autorefresh.Object_To_HTML:string;
  8051. var
  8052.     s:string;
  8053.     f:TWABD_Form;
  8054. begin
  8055.      Result:='';
  8056.      f:=GetParentForm;
  8057.      if f=nil then exit;
  8058.  
  8059.  
  8060.      if FURL='' then
  8061.      begin
  8062.           if not FNewSession then
  8063.              s:=';URL='+URL_To_HTML(format('%s?%s='+WABD_SES_ID_STR_FORMAT+'&%s=Yes',
  8064.                 [DllName,WABD_SES_ID_STR,SessionID,f.Name,WABD_RELOAD_STR]))
  8065.           else
  8066.               s:='';
  8067.      end
  8068.      else
  8069.          s:=';URL='+URL_To_HTML(FURL);
  8070.      Result:='<META HTTP-EQUIV="refresh" CONTENT="'+inttostr(FInterval)+s+'">'
  8071. end;
  8072.  
  8073. function TWABD_Autorefresh.Object_To_WML:string;
  8074. var
  8075.     s:string;
  8076.     f:TWABD_Form;
  8077. begin
  8078.      Result:='';
  8079.      f:=GetParentForm;
  8080.      if f=nil then exit;
  8081.  
  8082.      if FURL='' then
  8083.      begin
  8084.           if not FNewSession then
  8085.              s:=ASCII_To_HTML(format('%s?%s='+WABD_SES_ID_STR_FORMAT+'&%s=Yes',
  8086.                 [DllName,WABD_SES_ID_STR,SessionID,f.Name,WABD_RELOAD_STR]))
  8087.           else
  8088.               s:='';
  8089.      end
  8090.      else
  8091.          s:=ASCII_To_HTML(FURL);
  8092.  
  8093.      if FInterval>0 then
  8094.         Result := '<onevent type="ontimer">'+CR+
  8095.                   '<go href="'+s+'"/>'+CR+
  8096.                   '</onevent>'+CR+
  8097.                   '<timer value="'+inttostr(FInterval * 10)+'"/>'
  8098.      else
  8099.         Result := '<onevent type="onenterforward">'+CR+
  8100.                   '<go href="'+s+'"/>'+CR+
  8101.                   '</onevent>';
  8102. end;
  8103.  
  8104. function TWABD_Autorefresh.Object_To_Control(AOwner: TWinControl): TControl;
  8105. begin
  8106.      Result := nil;
  8107. end;
  8108.  
  8109. procedure TWABD_Autorefresh.HTML_To_Object(FormVal: string);
  8110. begin
  8111.     // Nothing.
  8112. end;
  8113.  
  8114. // TWAND_Expires
  8115. constructor TWABD_Expires.Create(AOwner:TComponent);
  8116. begin
  8117.      inherited;
  8118.      FMaxAge:=-1;
  8119. end;
  8120.  
  8121. function TWABD_Expires.Object_To_HTML:string;
  8122. var
  8123.    s:string;
  8124. begin
  8125.      if FAlwaysReload or (FMaxAge=0) then
  8126.         s:='0'
  8127.      else
  8128.          s:=formatdatetime('ddd","dd mmm yyyy hh":"nn":"ss',FExpires);
  8129.      if FMaxAge>0 then
  8130.         Result:=Result+CR+'<meta http-equiv="Cache-Control" content="max-age="'+inttostr(FMaxAge)+'" forua="true">';
  8131. end;
  8132.  
  8133. // TWAND_Expires
  8134. function TWABD_Expires.Object_To_WML:string;
  8135. begin
  8136.      Result:='';
  8137.      if (Session=nil) or (Session.Response=nil) then exit;
  8138.      if FAlwaysReload or (FMaxAge=0) then
  8139.      begin
  8140.           Session.Response.Header.Add('Cache-Control: no-cache, must-revalidate');
  8141.           Session.Response.Header.Add('Pragma: no-cache');
  8142.      end;
  8143.  
  8144.      Session.Response.Header.Add('Expires: '+formatdatetime('ddd","dd mmm yyyy hh":"nn":"ss',FExpires));
  8145.  
  8146.      if FMaxAge>0 then
  8147.         Session.Response.Header.Add('Cache-Control: max-age='+inttostr(FMaxAge)+', no-cache');
  8148. end;
  8149.  
  8150. function TWABD_Expires.Object_To_Control(AOwner: TWinControl): TControl;
  8151. begin
  8152.      Result := nil;
  8153. end;
  8154.  
  8155. procedure TWABD_Expires.HTML_To_Object(FormVal: string);
  8156. begin
  8157.     // Nothing.
  8158. end;
  8159.  
  8160. // TWABD_FormSection_Grid
  8161.  
  8162. constructor TWABD_FormSection_Grid.Create(AOwner: TComponent);
  8163. begin
  8164.    inherited;
  8165.    FGridX      := 16;
  8166.    FGridY      := 16;
  8167.    FCellBorder := 0;
  8168.    FCellSpace  := 0;
  8169.    FCellPad    := 0;
  8170. end;
  8171.  
  8172. procedure TWABD_FormSection_Grid.SetGridX(NewX: integer);
  8173. begin
  8174.    FGridX := NewX;
  8175.    Changed;
  8176. end;
  8177.  
  8178. procedure TWABD_FormSection_Grid.SetGridY(NewY: integer);
  8179. begin
  8180.    FGridY := NewY;
  8181.    Changed;
  8182. end;
  8183.  
  8184. function TWABD_FormSection_Grid.FormSection_To_HTML: string;
  8185. const
  8186.    MX = 256;
  8187.    MY = 256;
  8188. var
  8189.    i       : integer;
  8190.    sx      : integer;
  8191.    x, y    : integer;
  8192.    x2,y2   : integer;
  8193.    tg      : TTableGrid;
  8194.    c       : TWABD_SectionObject;
  8195.    MaxX    : integer;
  8196.    MaxXW   : integer;            // Max incl. width.
  8197.    MaxY    : integer;
  8198.    MaxYH   : integer;            // Max incl. height.
  8199.    s       : string;
  8200.    r       : string;
  8201.    va,ha   : string;
  8202.    hs      : string;
  8203.    cspan   : string;
  8204.    rspan   : string;
  8205.    nw      : string;
  8206.    p,p1    : PTableCell;
  8207.    NumSkip : integer;
  8208.    eTD,eTR,eTable : string;
  8209.    CtrlsInRow: array[0..MY] of integer;
  8210.    CtrlsInCol: array[0..MX] of integer;
  8211.    O       : TWABD_SectionObject;
  8212. begin
  8213.    eTD:='</TD>';
  8214.    eTR:='</TR>';
  8215.    eTable:='</TABLE>';
  8216.  
  8217.    tg := TTableGrid.Create;
  8218.    tg.SetSize(MX, MY);
  8219.    r:='';
  8220.    try
  8221.  
  8222.       // Clear controls pr row counter.
  8223.       for i:=0 to MY do CtrlsInRow[i]:=0;
  8224.       for i:=0 to MX do CtrlsInCol[i]:=0;
  8225.  
  8226.       // Plot all controls into a grid and gather info about how much space is taken up.
  8227.       MaxX := -1;
  8228.       MaxXW:= -1;
  8229.       MaxY := -1;
  8230.       MaxYH:= -1;
  8231.       for i := 0 to ChildCount-1 do begin
  8232.          c := Children[i] as TWABD_SectionObject;
  8233.          if c.Visible=False then continue;
  8234.          x := c.LeftPos div GridX;
  8235.          y := c.TopPos  div GridY;
  8236.          if x < 0 then x := 0;
  8237.          if y < 0 then y := 0;
  8238.          if x >= MX then x := MX-1;
  8239.          if y >= MY then y := MY-1;
  8240.          p := tg.GetCell(x,y);
  8241.          p.SObj := c;
  8242.          if c.ColSpan <> -1 then p.SpanX := c.ColSpan else
  8243.             p.SpanX := c.Width div GridX + 1;
  8244.          if c.RowSpan <> -1 then p.SpanY := c.RowSpan else
  8245.             p.SpanY := c.Height div GridY + 1;
  8246.  
  8247.          if x+p.SpanX >= MX then p.SpanX:=MX-x+1;
  8248.          if x>MaxX then MaxX:=x;
  8249.          if x+p.SpanX >= MaxXW then MaxXW := x+p.SpanX-1;
  8250.  
  8251.          if y+p.SpanY >= MY then p.SpanY:=MY-y+1;
  8252.          if y>MaxY then MaxY:=y;
  8253.          if y+p.SpanY >= MaxYH then MaxYH := y+p.SpanY-1;
  8254.  
  8255.          inc(CtrlsInRow[y]);
  8256.          inc(CtrlsInCol[x]);
  8257.  
  8258.          // Skip cells that this control cover.
  8259.          for x2 := 0 to p.SpanX-1 do
  8260.             for y2 := 0 to p.SpanY-1 do begin
  8261.                tg.GetCell(x+x2,y+y2).Skip := True;
  8262.             end;
  8263.       end;
  8264.  
  8265.       // Let controls 'flow' to the next absolute control (unless its specified how much space it can take up).
  8266.       for y:=0 to MaxY do
  8267.       begin
  8268.            sx:=0;
  8269.            NumSkip:=0;
  8270.            for x:=0 to MaxX do
  8271.            begin
  8272.                 p:=tg.GetCell(x,y);
  8273.                 if Assigned(p.SObj) and (p.SObj.ColSpan=0) then continue;
  8274.                 if (x<MaxX) and (p.SObj=nil) then
  8275.                 begin
  8276.                      p.Skip:=true;
  8277.                      inc(NumSkip);
  8278.                 end
  8279.                 else
  8280.                 begin
  8281.    //   showmessage('NumSkip='+inttostr(NumSkip)+' y='+inttostr(y)+' sx='+inttostr(sx));
  8282.                      p1:=tg.GetCell(sx,y);
  8283.                      if p1.Sobj<>nil then inc(NumSkip);
  8284.                      if (NumSkip>p1.SpanX) then p1.SpanX:=NumSkip;
  8285.    //   showmessage('Spanx='+inttostr(p1.SpanX));
  8286.                      p1.Skip:=false;
  8287.                      sx:=x;
  8288.                      NumSkip:=0;
  8289.                 end;
  8290.            end;
  8291.       end;
  8292.  
  8293.       // Output first thin line describing table layout.
  8294.       if FCellBorder<>0 then   // If border shown, show this line clearly for debug purpose.
  8295.          s:=' '
  8296.       else
  8297.           s:='';
  8298.       r:='<TR>';
  8299.       for x:=0 to MaxXW do
  8300.            r:=r+'<TD WIDTH='+inttostr(GridX)+' HEIGHT=0>'+s+'</TD>';
  8301.       r:=r+eTR+CR;
  8302.  
  8303.       // Output the rest.
  8304.       for y := 0 to MaxY do begin
  8305.          r := r + '<TR>';
  8306.          for x := 0 to MaxX do begin
  8307.  
  8308.             // Check if still controls to paint, otherwise skip rest of line.
  8309.             if (x>0) and (CtrlsInRow[y]<=0) then continue;
  8310.  
  8311.             // First column governs height of this row.
  8312.             if x=0 then
  8313.                hs:=' HEIGHT='+inttostr(GridY)
  8314.             else
  8315.                hs:='';
  8316.             p := tg.GetCell(x,y);
  8317.  
  8318.             // Determine width.
  8319.             if p.SpanX > 1 then
  8320.                cspan:=' COLSPAN='+inttostr(p.SpanX)
  8321.             else if p.SpanX=0 then
  8322.                cspan:=' COLSPAN='+inttostr(MaxX+1) // WIDTH=100%';
  8323.             else
  8324.                cspan:='';
  8325.  
  8326.             // Determine height.
  8327.             if p.SpanY > 1 then
  8328.                rspan:=' ROWSPAN='+inttostr(p.SpanY)
  8329.             else if p.SpanY=0 then
  8330.                rspan:=' ROWSPAN='+inttostr(MaxY+1) //HEIGHT=100%';
  8331.             else
  8332.                rspan:='';
  8333.  
  8334.             // If contents in cell, determine how to output it, and do it.
  8335.             o:=p.SObj;
  8336.             if o<>nil then
  8337.             begin
  8338.                  dec(CtrlsInRow[y]);
  8339.  
  8340.                  // Determine if allow wrapping.
  8341.                  if NoWrap or o.NoWrap then
  8342.                     nw:=' NOWRAP'
  8343.                  else
  8344.                     nw:='';
  8345.  
  8346.                  // Determine horizontal alignment.
  8347.                  case o.HorzAlign of
  8348.                      alhLeft: ha:=' ALIGN=left';
  8349.                      alhRight: ha:=' ALIGN=right';
  8350.                      alhCenter: ha:=' ALIGN=Center';
  8351.                      else ha:='';
  8352.                  end;
  8353.  
  8354.                  // Determine vert. alignment
  8355.                  case o.FVertAlign of
  8356.                     alvTop: va:=' VALIGN="top"';
  8357.                     alvMiddle: va:=' VALIGN="middle"';
  8358.                     alvBottom: va:=' VALIGN="bottom"';
  8359.                     alvBaseline: va:=' VALIGN="baseline"';
  8360.                     else va:='';
  8361.                  end;
  8362.  
  8363.      //ShowMessage(format('x,y=%d,%d SpanX,SpanY=%d,%d Name=%s, cspan,rspan=%s,%s, ws,hs=%s,%s',
  8364.      //   [x,y,p.SpanX,p.SpanY,p.SObj.Name,cspan,rspan,ws,hs]));
  8365.  
  8366.                  // Build cell contents.
  8367.                  r := r + '<TD'+nw+hs+cspan+rspan+ha+va+'>';
  8368.                  r := r + o.Object_To_HTML;
  8369.                  r := r + eTD;
  8370.  
  8371.                  // Check if server based event handler on this object.
  8372.                  if o is TWABD_BaseEventSectionObject then
  8373.                     with TWABD_BaseEventSectionObject(o) do
  8374.                     begin
  8375.                          if Assigned(FOnUserClick) or Assigned(FOnUserChange)
  8376.                             or Assigned(FOnUserLostFocus) or Assigned(FOnUserGotFocus) then
  8377.                             FEventHandlersOnFormSection:=true;
  8378.                     end;
  8379.             end
  8380.             else
  8381.             begin
  8382.                  if (x=0) or (not p.Skip) then begin
  8383.                     r := r + '<TD'+hs+cspan+'> '+eTD;
  8384.                  end
  8385.                  else
  8386.                  begin
  8387.                       // r := r + '<TD'+hs+cspan+'>Skip'+eTD+CR;
  8388.                  end;
  8389.             end;
  8390.          end; // x
  8391.  
  8392.          r:=r+eTR+CR
  8393.       end; // y
  8394.    finally
  8395.       tg.Free;
  8396.    end;
  8397.    Result := r;
  8398. end;
  8399.  
  8400. function TWABD_FormSection_Grid.FormSection_To_WML: string;
  8401. const
  8402.    MX = 256;
  8403.    MY = 256;
  8404. var
  8405.    i       : integer;
  8406.    x,y     : integer;
  8407.    tg      : TTableGrid;
  8408.    c       : TWABD_SectionObject;
  8409.    MaxX    : integer;
  8410.    MaxY    : integer;
  8411.    r,a     : string;
  8412.    p       : PTableCell;
  8413.    CtrlsInRow: array[0..MY] of integer;
  8414.    CtrlsInCol: array[0..MX] of integer;
  8415.    O       : TWABD_SectionObject;
  8416. begin
  8417.    tg := TTableGrid.Create;
  8418.    tg.SetSize(MX, MY);
  8419.    r:='';
  8420.    try
  8421.  
  8422.       // Clear controls pr row counter.
  8423.       for i:=0 to MY do CtrlsInRow[i]:=0;
  8424.       for i:=0 to MX do CtrlsInCol[i]:=0;
  8425.  
  8426.       // Plot all controls into a grid. Dont worry to much about space taken up. WML cannot control it anyway.
  8427.       MaxX:=0;
  8428.       MaxY:=0;
  8429.       for i := 0 to ChildCount-1 do begin
  8430.          c := Children[i] as TWABD_SectionObject;
  8431.          if c.Visible=False then continue;
  8432.          x := c.LeftPos div GridX;
  8433.          y := c.TopPos  div GridY;
  8434.          if x < 0 then x := 0;
  8435.          if y < 0 then y := 0;
  8436.          if x >= MX then x := MX-1;
  8437.          if y >= MY then y := MY-1;
  8438.          if x > MaxX then MaxX:=x;
  8439.          if y > MaxY then MaxY:=y;
  8440.          p := tg.GetCell(x,y);
  8441.          p.SObj := c;
  8442.  
  8443.          inc(CtrlsInRow[y]);
  8444.          inc(CtrlsInCol[x]);
  8445.       end;
  8446.  
  8447.       // Output WML.
  8448.       for y := 0 to MaxY do
  8449.       begin
  8450.            if length(r)>0 then r:=r+'<br/>'+CR;
  8451.            a:='';
  8452.            for x := 0 to MaxX do
  8453.            begin
  8454.                 // Check if still controls to paint, otherwise skip rest of line.
  8455.                 if (x>0) and (CtrlsInRow[y]<=0) then continue;
  8456.  
  8457.                 p := tg.GetCell(x,y);
  8458.  
  8459.                 // If contents in cell, determine how to output it, and do it.
  8460.                 o:=p.SObj;
  8461.                 if o<>nil then
  8462.                 begin
  8463.                      dec(CtrlsInRow[y]);
  8464.  
  8465.                      // Build cell contents.
  8466.                      r := r + a + o.Object_To_WML;
  8467.                      a:=' ';
  8468.                 end;
  8469.            end;
  8470.       end;
  8471.    finally
  8472.       tg.Free;
  8473.    end;
  8474.    Result := r;
  8475. end;
  8476.  
  8477. function TWABD_FormSection_Grid.FormSection_To_WML_Postfield: string;
  8478. var
  8479.    i       : integer;
  8480.    c       : TWABD_SectionObject;
  8481. begin
  8482.      Result:='';
  8483.      for i := 0 to ChildCount-1 do begin
  8484.         c := Children[i] as TWABD_SectionObject;
  8485.         if c.Visible=False then continue;
  8486.         Result:=Result+c.Object_To_WML_Postfield;
  8487.      end;
  8488. end;
  8489.  
  8490. function TWABD_FormSection_Grid.Object_To_HTML: string;
  8491. var
  8492.    header    : string;
  8493.    footer    : string;
  8494. begin
  8495.    header := Format('<TABLE BORDER=%d CELLSPACING=%d CELLPADDING=%d',[FCellBorder, FCellSpace, FCellPad]);
  8496.    header := header+ValueToHTML('WIDTH',Width)+ValueToHTML('HEIGHT',Height);
  8497.    header:=header+'>'+CR;
  8498.    footer := '</TABLE>' + CR;
  8499.  
  8500.    Result := header + FormSection_To_HTML + footer;
  8501. end;
  8502.  
  8503. function TWABD_FormSection_Grid.Object_To_WML: string;
  8504. var
  8505.    sHorz:string;
  8506.    sTitle:string;
  8507. begin
  8508.    case HorzAlign of
  8509.      alhLeft:   sHorz:=' align="left"';
  8510.      alhCenter: sHorz:=' align="center"';
  8511.      alhRight:  sHorz:=' align="right"';
  8512.      else       sHorz:='';
  8513.    end;
  8514.    sTitle:=trim(FTitle);
  8515.    if sTitle<>'' then sTitle:=' title="'+sTitle+'"';
  8516.    Result:= '<p'+sHorz+'>'+CR
  8517.           + '<fieldset'+stitle+'>' + CR
  8518.           + FormSection_To_WML+CR
  8519.           +'</fieldset>'+CR
  8520.           +'</p>';
  8521. end;
  8522.  
  8523. function TWABD_FormSection_Grid.Object_To_WML_Postfield: string;
  8524. begin
  8525.      Result:=FormSection_To_WML_Postfield;
  8526. end;
  8527.  
  8528. procedure TWABD_FormSection_Grid.HTML_To_Object(FormVal: string);
  8529. begin
  8530.     // Nothing.
  8531. end;
  8532.  
  8533. procedure TWABD_FormSection_Grid.AutoSizeRowCol;
  8534. var
  8535.    i, t     : integer;
  8536.    c        : TWABD_SectionObject;
  8537.    rs, cs   : integer;
  8538. begin
  8539.    if csDesigning in ComponentState then exit;
  8540.  
  8541.    // Place each control into a Cell (Row,Col) and set those protected properties
  8542.    // Determine # of Rows & Cols
  8543.    NumRow := -1;
  8544.    NumCol := -1;
  8545.    for i := 0 to ChildCount-1 do begin
  8546.       c := Children[i] as TWABD_SectionObject;
  8547.       c.Col := c.OrigLeft div GridX;
  8548.       Assert(c.Col < 255, Format('Max 255 Columns per FormSection: %d, %d, %d', [c.LeftPos, GridX, c.Col]));
  8549.       c.Row := c.OrigTop  div GridY;
  8550.       Assert(c.Row < 255, 'Max 255 Rows per FormSection');
  8551.       cs    := c.Width   div GridX;
  8552.       rs    := c.Height  div GridY;
  8553.       if c.ColSpan>cs then cs:=c.ColSpan;
  8554.       if c.RowSpan>rs then rs:=c.RowSpan;
  8555.       
  8556.       if c.Col+cs > NumCol then
  8557.          NumCol := c.Col+cs;
  8558.       if c.Row+rs > NumRow then
  8559.          NumRow := c.Row+rs;
  8560.    end;
  8561.  
  8562.    // Init RowSizes and ColSizes to GridX, GridY
  8563.    for i := 0 to NumCol-1 do
  8564.       ColSizes[i] := GridX;
  8565.    for i := 0 to NumRow-1 do
  8566.       RowSizes[i] := GridY;
  8567.  
  8568.    // Loop through each Col (& Row), and set its size to the max control size (+CellBorder) in the Col
  8569.    // Only do autosize for ColSpan & RowSpan = 1
  8570.    for i := 0 to ChildCount-1 do begin
  8571.       c := Children[i] as TWABD_SectionObject;
  8572.       // Check the ColSize
  8573.       t := c.Width + CellBorder * 2;
  8574.       if (t > ColSizes[c.Col]) and (c.ColSpan = 1) then
  8575.          ColSizes[c.Col] := t;
  8576.       // Check the RowSize
  8577.       t := c.Height + CellBorder * 2;
  8578.       if (t > RowSizes[c.Row]) and (c.RowSpan = 1) then
  8579.          RowSizes[c.Row] := t;
  8580.    end;
  8581.  
  8582.    // Calculate ColTot & RowTot
  8583.    ColTot[0] := 0;
  8584.    for i := 1 to NumCol do    // note that this goes 1 past the NumCol
  8585.       ColTot[i] := ColTot[i-1] + ColSizes[i-1];
  8586.    RowTot[0] := 0;
  8587.    for i := 1 to NumRow do
  8588.       RowTot[i] := RowTot[i-1] + RowSizes[i-1];
  8589.  
  8590.    // Set each control's LeftPos & TopPos to the new values (+CellBorder)
  8591.    for i := 0 to ChildCount-1 do begin
  8592.       c := Children[i] as TWABD_SectionObject;
  8593.       c.LeftPos := ColTot[c.Col] + CellBorder;
  8594.       c.TopPos  := RowTot[c.Row] + CellBorder;
  8595.    end;
  8596. end;
  8597.  
  8598. function TWABD_FormSection_Grid.Object_To_Control(AOwner: TWinControl): TControl;
  8599. var
  8600.    np          : TPaintPanel;
  8601.    i           : integer;
  8602.    c           : TWABD_SectionObject;
  8603.    con         : TControl;
  8604.    MaxX, MaxY  : integer;
  8605.    x, y        : integer;
  8606. begin
  8607.    AutoSizeRowCol;
  8608.  
  8609.    np := TPaintPanel.Create(AOwner);
  8610.  
  8611.    np.FFormSec    := Self;
  8612.    np.Parent      := AOwner;
  8613.    np.Name        := Name;
  8614.    np.Caption     := '';
  8615.    np.GridX       := GridX;
  8616.    np.GridY       := GridY;
  8617.    np.CellBorder  := CellBorder;
  8618.    for i := 0 to ChildCount-1 do begin
  8619.       c := Children[i] as TWABD_SectionObject;
  8620.       if (c.Visible=False) and not (csDesigning in ComponentState) then continue;
  8621.  
  8622.       con := c.Object_To_Control(np);
  8623.       if con<>nil then begin
  8624.          con.Left    := c.LeftPos;
  8625.          con.Top     := c.TopPos;
  8626.          con.Width   := c.Width;
  8627.          con.Height  := c.Height;
  8628.          con.Name    := c.Name;
  8629.          con.Parent  := np;
  8630.          con.Tag     := i + 1;
  8631.       end;
  8632.    end;
  8633.  
  8634.    MaxX := -1;
  8635.    MaxY := -1;
  8636.    for i := 0 to np.ControlCount-1 do begin
  8637.       x := np.Controls[i].Left + np.Controls[i].Width;
  8638.       y := np.Controls[i].Top + np.Controls[i].Height;
  8639.       if x > MaxX then MaxX := x;
  8640.       if y > MaxY then MaxY := y;
  8641.    end;
  8642.    np.Width := MaxX + 2;
  8643.    np.Height := MaxY + 2;
  8644.    np.BevelOuter := bvNone;
  8645.  
  8646.    Result := np;
  8647. end;
  8648.  
  8649.  
  8650. function TWABD_FormSection_Grid.AddControl(ControlClass: TWABD_SectionObjectClass; Col, Row: integer): TWABD_SectionObject;
  8651. begin
  8652.    Result := ControlClass.Create(Self);
  8653.    Result.Parent  := Self;
  8654.    Result.LeftPos := Col * GridX;
  8655.    Result.TopPos  := Row * GridY;
  8656.    Result.ColSpan := 1;
  8657.    Result.RowSpan := 1;
  8658. end;
  8659.  
  8660. procedure TWABD_FormSection_Grid.ControlAtFunc(Child: TWABD_Object; var Stop: boolean; UserData: pointer);
  8661. var
  8662.    so      : TWABD_SectionObject;
  8663. begin
  8664.    if not (Child is TWABD_SectionObject) then exit;
  8665.    so := TWABD_SectionObject(Child);
  8666.    if (so.Col = FindCol) and (so.Row = FindRow) then begin
  8667.       FindCon := Child as TWABD_SectionObject;
  8668.       Stop := True;
  8669.    end;
  8670. end;
  8671.  
  8672. function TWABD_FormSection_Grid.ControlAtPos(Col, Row: integer): TWABD_SectionObject;
  8673. begin
  8674.    FindCon := nil;
  8675.    ForEachChild(ControlAtFunc, FindCon);
  8676.    Result := FindCon;
  8677. end;
  8678.  
  8679.  
  8680. // TWABD_BaseTable
  8681.  
  8682. constructor TWABD_BaseTable.Create(AOwner: TComponent);
  8683. begin
  8684.    inherited;
  8685.    FClickText := 'Go';
  8686.    CanClick   := False;
  8687. end;
  8688.  
  8689. // TWABD_Table
  8690.  
  8691. constructor TWABD_Table.Create(AOwner: TComponent);
  8692. begin
  8693.    inherited;
  8694.    CellBorder  := 1;
  8695.    CellSpacing := 1;
  8696.    FixedRows   := 1;
  8697.    FWidth      := 100; // 100% of browser frame.
  8698.    FStrings    := TWABD_Table_Strings.Create;
  8699.    FBGColor    := clNone;
  8700.    FShowEmptyRows:=true;
  8701.    FOptimize   := true;
  8702.    FFontColor  := clNone;
  8703.    FFontSize   := 3;
  8704.    FLiteral    := false;
  8705.    FJS_OnUserKeyPress:=TWABD_JS_Function.Create(jsOnKeyPress);
  8706.    FJS_OnUserKeyUp:=TWABD_JS_Function.Create(jsOnKeyUp);
  8707.    FJS_OnUserKeyDown:=TWABD_JS_Function.Create(jsOnKeyDown);
  8708.    FJS_OnUserClick:=TWABD_JS_Function.Create(jsOnClick);
  8709.    FJS_OnUserDblClick:=TWABD_JS_Function.Create(jsOnDblClick);
  8710.    FJS_OnUserMouseOver:=TWABD_JS_Function.Create(jsOnMouseOver);
  8711.    FJS_OnUserMouseDown:=TWABD_JS_Function.Create(jsOnMouseDown);
  8712.    FJS_OnUserMouseUp:=TWABD_JS_Function.Create(jsOnMouseUp);
  8713.    FJS_OnUserMouseMove:=TWABD_JS_Function.Create(jsOnMouseMove);
  8714.    FJS_OnUserMouseOut:=TWABD_JS_Function.Create(jsOnMouseOut);
  8715. end;
  8716.  
  8717. destructor TWABD_Table.Destroy;
  8718. begin
  8719.    FStrings.Free;
  8720.    FJS_OnUserKeyPress.free;
  8721.    FJS_OnUserKeyUp.free;
  8722.    FJS_OnUserKeyDown.free;
  8723.    FJS_OnUserClick.free;
  8724.    FJS_OnUserDblClick.free;
  8725.    FJS_OnUserMouseOver.free;
  8726.    FJS_OnUserMouseDown.free;
  8727.    FJS_OnUserMouseUp.free;
  8728.    FJS_OnUserMouseMove.free;
  8729.    FJS_OnUserMouseOut.free;
  8730.    inherited;
  8731. end;
  8732.  
  8733. function TWABD_Table.GetBut(Row: integer): string;
  8734. begin
  8735.    Result := Format('<INPUT TYPE=SUBMIT NAME=%s VALUE="%s %d">',
  8736.       [Name, ClickText, Row]);
  8737. end;
  8738.  
  8739. function TWABD_Table.Object_To_HTML: string;
  8740. var
  8741.    r, c                 : integer;
  8742.    DataOn, DataOff      : string;
  8743.    Data, ws             : string;
  8744.    w,h                  : integer;
  8745.    ha                   : TWABD_HorzAlignment;
  8746.    va                   : TWABD_VertAlignment;
  8747.    sha,sva              : string;
  8748.    sBGColor,scolor      : string;
  8749.    sww                  : string;
  8750.    s                    : string;
  8751.    BGcolor,color        : TColor;
  8752.    size                 : integer;
  8753.    fb,fi,fu,ff,fst      : boolean;
  8754.    allowwordwrap        : boolean;
  8755.    clickable            : boolean;
  8756.    fw                   : integer;
  8757.    show                 : boolean;
  8758.    eTD,eTR              : string;
  8759.    target               : TWABD_Base_Frame;
  8760.  
  8761.    mover,mout,mdown     : string;
  8762.    mup,mclick,mdblclick : string;
  8763.    mkeypress,mkeydown   : string;
  8764.    mkeyup,id            : string;
  8765.    mjavascript          : string;
  8766.    starget              : string;
  8767.    sevent               : string;
  8768. begin
  8769.    // If to optimize, dont send /TD and /TR.
  8770.    if Optimize then
  8771.    begin
  8772.         eTD:='';
  8773.         eTR:='';
  8774.    end else
  8775.    begin
  8776.         eTD:='</TD>';
  8777.         eTR:='</TR>';
  8778.    end;
  8779.  
  8780.    // If to calculate fixed width.
  8781.    if FWidth=0 then
  8782.    begin
  8783.         fw:=0;
  8784.         for c:=0 to Cells.Cols-1 do inc(fw,ColWidth[c]);
  8785.         fw:=Round(fw * PIXELS_PER_CHAR_X * 1.05);
  8786.    end
  8787.    else fw:=FWidth;
  8788.  
  8789.    // Build HTML code for table.
  8790.    if FBGColor<>clNone then
  8791.       sBGcolor:=' BGCOLOR='+ColorToHTML(FBGcolor,'"')
  8792.    else
  8793.       sBGcolor:='';
  8794.    if FFontColor<>clNone then
  8795.       scolor:=' COLOR='+ColorToHTML(FFontColor,'"')
  8796.    else
  8797.       scolor:='';
  8798.  
  8799.    sevent:=GenEventCode(FJS_OnUserKeyPress,nil,0,'')+
  8800.            GenEventCode(FJS_OnUserKeyUp,nil,0,'')+
  8801.            GenEventCode(FJS_OnUserKeyDown,nil,0,'')+
  8802.            GenEventCode(FJS_OnUserClick,nil,0,'')+
  8803.            GenEventCode(FJS_OnUserDblClick,nil,0,'')+
  8804.            GenEventCode(FJS_OnUserMouseOver,nil,0,'')+
  8805.            GenEventCode(FJS_OnUserMouseDown,nil,0,'')+
  8806.            GenEventCode(FJS_OnUserMouseUp,nil,0,'')+
  8807.            GenEventCode(FJS_OnUserMouseMove,nil,0,'')+
  8808.            GenEventCode(FJS_OnUserMouseOut,nil,0,'');
  8809.  
  8810.    Result := '<TABLE BORDER='+inttostr(CellBorder)
  8811.               +ValueToHTML('WIDTH',fw)
  8812.               +ValueToHTML('HEIGHT',Height)
  8813.               +sevent
  8814.               +'>'+CR+'<FONT '
  8815.               +sBGColor
  8816.               +scolor+
  8817.               'SIZE='+inttostr(FFontSize)+'>';
  8818.  
  8819.    for r := 0 to Cells.Rows-1 do begin
  8820.  
  8821.       // Determine if to show this row.
  8822.       show:=FShowEmptyRows;
  8823.       if not FShowEmptyRows then
  8824.       begin
  8825.            for c := 0 to Cells.Cols-1 do
  8826.               if Trim(Cells[c,r])<>'' then
  8827.               begin
  8828.                    show:=true;
  8829.                    break;
  8830.               end;
  8831.       end;
  8832.       if not show then continue;
  8833.  
  8834.       // Check if Javascript setup for row.
  8835.       mjavascript:='';
  8836.       if Assigned(FSetupRowJavascript) then
  8837.       begin
  8838.            mover:='';
  8839.            mout:='';
  8840.            mdown:='';
  8841.            mup:='';
  8842.            mclick:='';
  8843.            mdblclick:='';
  8844.            mkeypress:='';
  8845.            mkeydown:='';
  8846.            mkeyup:='';
  8847.            id:='';
  8848.            FSetupRowJavascript(self,r,-1,id,mdown,mup,mover,mout,mclick,mdblclick,mkeypress,mkeydown,mkeyup,target);
  8849.            if mover<>'' then mover:=' onmouseover='+mover;
  8850.            if mout<>'' then mout:=' onmouseout='+mout;
  8851.            if mdown<>'' then mdown:=' onmousedown='+mdown;
  8852.            if mup<>'' then mup:=' onmouseup='+mup;
  8853.            if mclick<>'' then mclick:=' onclick='+mclick;
  8854.            if mdblclick<>'' then mdblclick:=' ondblclick='+mdblclick;
  8855.            if mkeypress<>'' then mkeypress:=' onkeypress='+mkeypress;
  8856.            if mkeydown<>'' then mkeydown:=' onkeydown='+mkeydown;
  8857.            if mkeyup<>'' then mkeyup:=' onkeyup='+mkeyup;
  8858.            if id<>'' then id:=' ID='+id;
  8859.            mjavascript:=id+mover+mout+mdown+mup+mclick+mdblclick+mkeypress+mkeydown+mkeyup;
  8860.       end;
  8861.  
  8862.       Result := Result + '<TR '+mjavascript+'>';
  8863.  
  8864.       if CanClick then begin
  8865.          if r > 0 then Data := GetBut(r) else Data := ' ';
  8866.          Result := Result + '<TD>' + Data + eTD;
  8867.       end;
  8868.  
  8869.       for c := 0 to Cells.Cols-1 do
  8870.       begin
  8871.  
  8872.          fb:=false;
  8873.          fu:=false;
  8874.          fi:=false;
  8875.          fst:=false;
  8876.          ff:=false;
  8877.          w:=ColWidth[c];
  8878.          Data:=Cells[c,r];
  8879.          ha:=ColAlign[c];
  8880.          va:=alvNone;
  8881.          color:=clNone;
  8882.          BGcolor:=clNone;
  8883.          allowwordwrap:=ColWrap[c];
  8884.          size:=-1;
  8885.  
  8886.          // Check if to render cell differently.
  8887.          if Assigned(FRenderCell) then
  8888.             FRenderCell(self,r,c,Data,ha,va,color,BGcolor,size,fb,fi,fu,ff,fst,w,h,allowwordwrap);
  8889.  
  8890.          // Check if cell should be clickable.
  8891.          clickable:=ColClickable[c];
  8892.          if (FSubmitTo<>nil) then target:=FSubmitTo
  8893.          else target:=GetParentForm.FSubmitTo;
  8894.          if Assigned(FSetupClickableCell) then
  8895.             FSetupClickableCell(self,r,c,clickable,target);
  8896.  
  8897.          // Check if Javascript setup for cell.
  8898.          mjavascript:='';
  8899.          if Assigned(FSetupCellJavascript) then
  8900.          begin
  8901.               mover:='';
  8902.               mout:='';
  8903.               mdown:='';
  8904.               mup:='';
  8905.               mclick:='';
  8906.               mdblclick:='';
  8907.               mkeypress:='';
  8908.               mkeydown:='';
  8909.               mkeyup:='';
  8910.               id:='';
  8911.               FSetupCellJavascript(self,r,c,id,mdown,mup,mover,mout,mclick,mdblclick,mkeypress,mkeydown,mkeyup,target);
  8912.               if mover<>'' then mover:=' onmouseover='+mover;
  8913.               if mout<>'' then mout:=' onmouseout='+mout;
  8914.               if mdown<>'' then mdown:=' onmousedown='+mdown;
  8915.               if mup<>'' then mup:=' onmouseup='+mup;
  8916.               if mclick<>'' then mclick:=' onclick='+mclick;
  8917.               if mdblclick<>'' then mdblclick:=' ondblclick='+mdblclick;
  8918.               if mkeypress<>'' then mkeypress:=' onkeypress='+mkeypress;
  8919.               if mkeydown<>'' then mkeydown:=' onkeydown='+mkeydown;
  8920.               if mkeyup<>'' then mkeyup:=' onkeyup='+mkeyup;
  8921.               if id<>'' then id:=' ID='+id;
  8922.               mjavascript:=id+mover+mout+mdown+mup+mclick+mdblclick+mkeypress+mkeydown+mkeyup;
  8923.          end;
  8924.  
  8925.          // Determine actual cell width.
  8926.          if (w<>0) {and (r = 0)} then begin
  8927.             ws := ' WIDTH='+inttostr(15 + Round(w * PIXELS_PER_CHAR_X * 1.25));
  8928.          end else begin
  8929.             ws := '';
  8930.          end;
  8931.  
  8932.          // Specify wordwrap allowed in cell.
  8933.          if not allowwordwrap then
  8934.             sww:=' NOWRAP'
  8935.          else
  8936.             sww:='';
  8937.  
  8938.          // Determine horz. alignment.
  8939.          case ha of
  8940.             alhLeft: if Optimize then sha:=''
  8941.                      else sha:=' ALIGN=left';
  8942.             alhRight: sha:=' ALIGN=right';
  8943.             alhCenter: sha:=' ALIGN=center';
  8944.             else sha:='';
  8945.          end;
  8946.  
  8947.          // Determine vert. alignment
  8948.          case va of
  8949.             alvTop: sva:=' VALIGN=top';
  8950.             alvBottom: sva:=' VALIGN=bottom';
  8951.             alvMiddle: sva:=' VALIGN=middle';
  8952.             alvBaseline: sva:=' VALIGN=baseline';
  8953.             else sva:='';
  8954.          end;
  8955.  
  8956.          // Determine background color.
  8957.          if BGcolor<>clNone then
  8958.             sBGcolor:=' BGCOLOR='+ColorToHTML(BGcolor,'"')
  8959.          else
  8960.             sBGcolor:='';
  8961.  
  8962.          // Convert data to display.
  8963.          if not FLiteral then
  8964.          begin
  8965.               Data := Ascii_To_HTML(Data);
  8966.               if Data='' then Data := ' ';
  8967.          end;
  8968.  
  8969.          // Determine font color/size.
  8970.          if (color<>clNone) or (size<>-1) then begin
  8971.             s:='<FONT';
  8972.             if color<>clNone then s:=s+' color='+ColorToHTML(color,'"');
  8973.             if size<>-1 then s:=s+' size='+inttostr(size);
  8974.             s:=s+'>';
  8975.             Data:=s+Data+'</FONT>';
  8976.          end;
  8977.  
  8978.          // Add controls for bold,underlined, italics and fixed font.
  8979.          if fb then Data:='<B>'+Data+'</B>';
  8980.          if fu then Data:='<U>'+Data+'</U>';
  8981.          if fi then Data:='<I>'+Data+'</I>';
  8982.          if ff then Data:='<TT>'+Data+'</TT>';
  8983.          if fst then Data:='<S>'+Data+'</S>';
  8984.  
  8985.          // Prepare actual cell HTML code.
  8986.          DataOn  := '<TD'+ws+sww+sha+sva+sBGcolor+mJavascript+'>';
  8987.          DataOff := eTD;
  8988.  
  8989.          // Check if target set.
  8990.          if target<>nil then
  8991.             sTarget:=' TARGET="'+target.FFrameName+'"'
  8992.          else
  8993.             sTarget:='';
  8994.  
  8995.          if clickable then
  8996.             Data:='<A HREF='+GetHRef(GetParentForm,self,WABD_TABLE_STR,format('%d:%d',[c,r]))+sTarget+'>'+Data+'</A>';
  8997.  
  8998.          if Assigned(FSetupCellJavascript) then
  8999.             Data:=Data;
  9000.  
  9001.          Result := Result + DataOn + Data + DataOff;
  9002.       end;
  9003.       Result := Result + eTR + CR;
  9004.    end;
  9005.  
  9006.    Result := Result + '</TABLE>'+CR;
  9007. end;
  9008.  
  9009. procedure TWABD_Table.HTML_To_Object(FormVal: string);
  9010. begin
  9011.     // Nothing.
  9012. end;
  9013.  
  9014. procedure TWABD_Table.SetStrings(NewStrings: TWABD_Table_Strings);
  9015. begin
  9016.    FStrings.Assign(NewStrings);
  9017. end;
  9018.  
  9019. function TWABD_Table.GetColWidth(i: integer): integer;
  9020. begin
  9021.    Assert((i >= 0) and (i < FStrings.XSize) and (i <= 255), 'ColWidth Index out of Range');
  9022.    Result := FColWid[i];
  9023. end;
  9024.  
  9025. procedure TWABD_Table.SetColWidth(i: integer; v: integer);
  9026. begin
  9027.    Assert((i >= 0) and (i < FStrings.XSize) and (i <= 255), 'ColWidth Index out of Range');
  9028.    FColWid[i] := v;
  9029. end;
  9030.  
  9031. function TWABD_Table.GetColAlign(i: integer): TWABD_HorzAlignment;
  9032. begin
  9033.    Assert((i >= 0) and (i < FStrings.XSize) and (i <= 255), 'ColAlign Index out of Range');
  9034.    Result := FColAlign[i];
  9035. end;
  9036.  
  9037. procedure TWABD_Table.SetColAlign(i: integer; v: TWABD_HorzAlignment);
  9038. begin
  9039.    Assert((i >= 0) and (i < FStrings.XSize) and (i <= 255), 'ColAlign Index out of Range');
  9040.    FColAlign[i] := v;
  9041. end;
  9042.  
  9043. function TWABD_Table.GetColWrap(i: integer): boolean;
  9044. begin
  9045.    Assert((i >= 0) and (i < FStrings.XSize) and (i <= 255), 'ColWrap Index out of Range');
  9046.    Result := FColWrap[i];
  9047. end;
  9048.  
  9049. procedure TWABD_Table.SetColWrap(i: integer; v: boolean);
  9050. begin
  9051.    Assert((i >= 0) and (i < FStrings.XSize) and (i <= 255), 'ColWrap Index out of Range');
  9052.    FColWrap[i] := v;
  9053. end;
  9054.  
  9055. function TWABD_Table.GetColClickable(i: integer): boolean;
  9056. begin
  9057.    Assert((i >= 0) and (i < FStrings.XSize) and (i <= 255), 'ColClickable Index out of Range');
  9058.    Result := FColClickable[i];
  9059. end;
  9060.  
  9061. procedure TWABD_Table.SetColClickable(i: integer; v: boolean);
  9062. begin
  9063.    Assert((i >= 0) and (i < FStrings.XSize) and (i <= 255), 'ColClickable Index out of Range');
  9064.    FColClickable[i] := v;
  9065. end;
  9066.  
  9067. function TWABD_Table.Object_To_Control(AOwner: TWinControl): TControl;
  9068. var
  9069.    nt        : TStringGridEx;
  9070.    x, y      : integer;
  9071.    cw, w, tw : integer;
  9072. begin
  9073.    nt := TStringGridEx.Create(AOwner);
  9074.    nt.ClickText := ClickText;
  9075.    nt.Name      := Name;
  9076.    nt.CanClick  := CanClick;
  9077.  
  9078.    nt.Options := nt.Options + [goColSizing, goRowSelect];
  9079.    nt.FixedCols := FixedCols;
  9080.    nt.FixedRows := FixedRows;
  9081.    nt.ColCount  := Cells.Cols;
  9082.    nt.RowCount  := Cells.Rows;
  9083.    tw := 0;
  9084.    for x := 0 to nt.ColCount-1 do begin
  9085.       cw := -1;
  9086.  
  9087.       if ColWidth[x]=0 then begin
  9088.          // Use the largest column width
  9089.          for y := 0 to nt.RowCount-1 do begin
  9090.             nt.Cells[x,y] := Cells[x,y];
  9091.             w := Round(Length(Cells[x,y]) * PIXELS_PER_CHAR_X * 1.25);
  9092.             if w > cw then cw := w;
  9093.          end;
  9094.       end else begin
  9095.          cw := Round(ColWidth[x] * PIXELS_PER_CHAR_X * 1.25);
  9096.       end;
  9097.  
  9098.       nt.ColWidths[x] := cw;
  9099.       tw := tw + cw;
  9100.    end;
  9101.    nt.Width     := tw + 25;
  9102.    nt.Height    := nt.DefaultRowHeight * nt.RowCount + 25;
  9103.    Result := nt;
  9104. end;
  9105.  
  9106.  
  9107. // TWABD_DataTable Helper Functions
  9108.  
  9109. function FieldTypeIsString(ft: TFieldType): boolean;
  9110. begin
  9111.    Result := True;
  9112.    case ft of
  9113.       ftUnknown, ftBytes, ftVarBytes, ftBlob,
  9114.       ftGraphic, ftFmtMemo, ftMemo, ftParadoxOle,
  9115.       ftDBaseOle, ftTypedBinary: Result := False;
  9116.    end;
  9117. end;
  9118.  
  9119. function VisFieldCount(ds: TDataSet): integer;
  9120. var
  9121.    i : integer;
  9122. begin
  9123.    Result := 0;
  9124.    for i := 0 to ds.FieldCount-1 do
  9125.       if ds.Fields[i].Visible then Inc(Result);
  9126. end;
  9127.  
  9128. function VisField(ds: TDataSet; idx: integer): TField;
  9129. var
  9130.    i, tmp : integer;
  9131. begin
  9132.    Result := nil;
  9133.    tmp    := 0;
  9134.    for i := 0 to ds.FieldCount-1 do
  9135.       if ds.Fields[i].Visible then begin
  9136.          if (idx = tmp) then Result := ds.Fields[i];
  9137.          Inc(tmp);
  9138.       end;
  9139. end;
  9140.  
  9141.  
  9142. // TWABD_DataLink
  9143. procedure TWABD_DataLink.ActiveChanged;
  9144. begin
  9145.     if assigned(FOnActiveChanged) then FOnActiveChanged(self);
  9146. end;
  9147.  
  9148. procedure TWABD_DataLink.DatasetChanged;
  9149. begin
  9150.     if assigned(FOnDatasetChanged) then FOnDatasetChanged(self);
  9151. end;
  9152.  
  9153. // TWABD_DataTable
  9154.  
  9155. constructor TWABD_DataTable.Create(AOwner: TComponent);
  9156. begin
  9157.    inherited;
  9158.    FShowForm  := True;
  9159.    FNavButs   := True;
  9160.    FShowTable := True;
  9161.    FMaxRows   := 10;
  9162.    FNumCol    := 3;
  9163.    FColWidth  := 150;
  9164.    FAutoWid   := True;
  9165.    FRecordCount:=0;
  9166.    FActiveRec := 0;
  9167.    Stat       := '';
  9168.    DidAppend  := False;
  9169.    FCanSelectRecord:=true;
  9170.    FCalcPages := true;
  9171.    FDataLink  := TWABD_DataLink.Create;
  9172.    FDataLink.OnActiveChanged:=RecountRecords;
  9173.  
  9174.    FFormSec := TWABD_FormSection.Create(Self);
  9175.    FFormSec.Parent := self;
  9176.    FNavForm := TWABD_FormSection.Create(Self);
  9177.    FNavForm.Parent := self;
  9178.    FTable := TWABD_Table.Create(Self);
  9179.    FTable.Parent := self;
  9180.    FTable.CanClick := FCanSelectRecord;
  9181.    FTable.OnUserClick := TableClick;
  9182. end;
  9183.  
  9184. function TWABD_DataTable.GetOptimize:boolean;
  9185. begin
  9186.     if FTable<>nil then Result:=FTable.Optimize
  9187.     else Result:=false;
  9188. end;
  9189.  
  9190. function TWABD_DataTable.GetBGColor:TColor;
  9191. begin
  9192.     if FTable<>nil then Result:=FTable.BGColor
  9193.     else Result:=clNone;
  9194. end;
  9195.  
  9196. function TWABD_DataTable.GetCellBorder:integer;
  9197. begin
  9198.     if FTable<>nil then Result:=FTable.CellBorder
  9199.     else Result:=0;
  9200. end;
  9201.  
  9202. function TWABD_DataTable.GetCellSpacing:integer;
  9203. begin
  9204.     if FTable<>nil then Result:=FTable.CellSpacing
  9205.     else Result:=0;
  9206. end;
  9207.  
  9208. function TWABD_DataTable.GetWidth:integer;
  9209. begin
  9210.     if FTable<>nil then Result:=FTable.Width
  9211.     else Result:=0;
  9212. end;
  9213.  
  9214. function TWABD_DataTable.GetShowEmptyRows:boolean;
  9215. begin
  9216.     if FTable<>nil then Result:=FTable.ShowEmptyRows
  9217.     else Result:=false;
  9218. end;
  9219.  
  9220. function TWABD_DataTable.GetFontColor:TColor;
  9221. begin
  9222.      if FTable<>nil then Result:=FTable.FontColor
  9223.      else Result:=clNone;
  9224. end;
  9225.  
  9226. function TWABD_DataTable.GetFontSize:integer;
  9227. begin
  9228.      if FTable<>nil then Result:=FTable.FontSize
  9229.      else Result:=3;
  9230. end;
  9231.  
  9232. function TWABD_DataTable.GetSubmitTo:TWABD_Base_Frame;
  9233. begin
  9234.      if FTable<>nil then Result:=FTable.SubmitToFrame
  9235.      else Result:=nil;
  9236. end;
  9237.  
  9238. procedure TWABD_DataTable.SetSubmitTo(fr:TWABD_Base_Frame);
  9239. begin
  9240.      if FTable<>nil then FTable.SubmitToFrame:=fr;
  9241. end;
  9242.  
  9243. function    TWABD_DataTable.GetJSOnUserKeyPress:TWABD_JS_Function;
  9244. begin
  9245.      if FTable<>nil then Result:=FTable.JS_OnUserKeyPress
  9246.      else Result:=nil;
  9247. end;
  9248.  
  9249. procedure   TWABD_DataTable.SetJSOnUserKeyPress(Value:TWABD_JS_Function);
  9250. begin
  9251.      if FTable<>nil then FTable.JS_OnUserKeyPress:=Value;
  9252. end;
  9253.  
  9254. function    TWABD_DataTable.GetJSOnUserKeyDown:TWABD_JS_Function;
  9255. begin
  9256.      if FTable<>nil then Result:=FTable.JS_OnUserKeyDown
  9257.      else Result:=nil;
  9258. end;
  9259.  
  9260. procedure   TWABD_DataTable.SetJSOnUserKeyDown(Value:TWABD_JS_Function);
  9261. begin
  9262.      if FTable<>nil then FTable.JS_OnUserKeyDown:=Value;
  9263. end;
  9264.  
  9265. function    TWABD_DataTable.GetJSOnUserKeyUp:TWABD_JS_Function;
  9266. begin
  9267.      if FTable<>nil then Result:=FTable.JS_OnUserKeyUp
  9268.      else Result:=nil;
  9269. end;
  9270.  
  9271. procedure   TWABD_DataTable.SetJSOnUserKeyUp(Value:TWABD_JS_Function);
  9272. begin
  9273.      if FTable<>nil then FTable.JS_OnUserKeyUp:=Value;
  9274. end;
  9275.  
  9276. function    TWABD_DataTable.GetJSOnUserClick:TWABD_JS_Function;
  9277. begin
  9278.      if FTable<>nil then Result:=FTable.JS_OnUserClick
  9279.      else Result:=nil;
  9280. end;
  9281.  
  9282. procedure   TWABD_DataTable.SetJSOnUserClick(Value:TWABD_JS_Function);
  9283. begin
  9284.      if FTable<>nil then FTable.JS_OnUserClick:=Value;
  9285. end;
  9286.  
  9287. function    TWABD_DataTable.GetJSOnUserDblClick:TWABD_JS_Function;
  9288. begin
  9289.      if FTable<>nil then Result:=FTable.JS_OnUserDblClick
  9290.      else Result:=nil;
  9291. end;
  9292.  
  9293. procedure   TWABD_DataTable.SetJSOnUserDblClick(Value:TWABD_JS_Function);
  9294. begin
  9295.      if FTable<>nil then FTable.JS_OnUserDblClick:=Value;
  9296. end;
  9297.  
  9298. function    TWABD_DataTable.GetJSOnUserMouseOver:TWABD_JS_Function;
  9299. begin
  9300.      if FTable<>nil then Result:=FTable.JS_OnUserMouseOver
  9301.      else Result:=nil;
  9302. end;
  9303.  
  9304. procedure   TWABD_DataTable.SetJSOnUserMouseOver(Value:TWABD_JS_Function);
  9305. begin
  9306.      if FTable<>nil then FTable.JS_OnUserMouseOver:=Value;
  9307. end;
  9308.  
  9309. function    TWABD_DataTable.GetJSOnUserMouseMove:TWABD_JS_Function;
  9310. begin
  9311.      if FTable<>nil then Result:=FTable.JS_OnUserMouseMove
  9312.      else Result:=nil;
  9313. end;
  9314.  
  9315. procedure   TWABD_DataTable.SetJSOnUserMouseMove(Value:TWABD_JS_Function);
  9316. begin
  9317.      if FTable<>nil then FTable.JS_OnUserMouseMove:=Value;
  9318. end;
  9319.  
  9320. function    TWABD_DataTable.GetJSOnUserMouseDown:TWABD_JS_Function;
  9321. begin
  9322.      if FTable<>nil then Result:=FTable.JS_OnUserMouseDown
  9323.      else Result:=nil;
  9324. end;
  9325.  
  9326. procedure   TWABD_DataTable.SetJSOnUserMouseDown(Value:TWABD_JS_Function);
  9327. begin
  9328.      if FTable<>nil then FTable.JS_OnUserMouseDown:=Value;
  9329. end;
  9330.  
  9331. function    TWABD_DataTable.GetJSOnUserMouseUp:TWABD_JS_Function;
  9332. begin
  9333.      if FTable<>nil then Result:=FTable.JS_OnUserMouseUp
  9334.      else Result:=nil;
  9335. end;
  9336.  
  9337. procedure   TWABD_DataTable.SetJSOnUserMouseUp(Value:TWABD_JS_Function);
  9338. begin
  9339.      if FTable<>nil then FTable.JS_OnUserMouseUp:=Value;
  9340. end;
  9341.  
  9342. function    TWABD_DataTable.GetJSOnUserMouseOut:TWABD_JS_Function;
  9343. begin
  9344.      if FTable<>nil then Result:=FTable.JS_OnUserMouseOut
  9345.      else Result:=nil;
  9346. end;
  9347.  
  9348. procedure   TWABD_DataTable.SetJSOnUserMouseOut(Value:TWABD_JS_Function);
  9349. begin
  9350.      if FTable<>nil then FTable.JS_OnUserMouseOut:=Value;
  9351. end;
  9352.  
  9353. procedure TWABD_DataTable.SetOptimize(o:boolean);
  9354. begin
  9355.     if FTable<>nil then FTable.Optimize:=o;
  9356. end;
  9357.  
  9358. procedure TWABD_DataTable.SetBGColor(c:TColor);
  9359. begin
  9360.     if FTable<>nil then FTable.BGColor:=c;
  9361. end;
  9362.  
  9363. procedure TWABD_DataTable.SetCellBorder(i:integer);
  9364. begin
  9365.     if FTable<>nil then FTable.CellBorder:=i;
  9366. end;
  9367.  
  9368. procedure TWABD_DataTable.SetCellSpacing(i:integer);
  9369. begin
  9370.     if FTable<>nil then FTable.CellSpacing:=i;
  9371. end;
  9372.  
  9373. procedure TWABD_DataTable.SetWidth(w:integer);
  9374. begin
  9375.     if FTable<>nil then FTable.Width:=w;
  9376. end;
  9377.  
  9378. procedure TWABD_DataTable.SetShowEmptyRows(s:boolean);
  9379. begin
  9380.     if FTable<>nil then FTable.ShowEmptyRows:=s;
  9381. end;
  9382.  
  9383. procedure TWABD_DataTable.SetFontColor(c:TColor);
  9384. begin
  9385.      if FTable<>nil then FTable.FontColor:=c;
  9386. end;
  9387.  
  9388. procedure TWABD_DataTable.SetFontSize(sz:integer);
  9389. begin
  9390.      if FTable<>nil then FTable.FontSize:=sz;
  9391. end;
  9392.  
  9393. procedure TWABD_DataTable.RecountRecords(Sender:TObject);
  9394. begin
  9395.     if DataSource<>nil then
  9396.        if DataSource.DataSet<>nil then
  9397.           with FDataLink.DataSource.DataSet do
  9398.           begin
  9399.               if Active then FActiveRec:=1
  9400.               else FActiveRec:=0;
  9401.               if (Active) and (FCalcPages) then
  9402.               begin
  9403.                   Last;
  9404.                   First;
  9405.                   FRecordCount:=RecordCount;
  9406.               end;
  9407.           end;
  9408. end;
  9409.  
  9410. function TWABD_DataTable.GetRenderCell:TWABD_OnRenderCellEvent;
  9411. begin
  9412.      if FTable<>nil then Result:=FTable.OnRenderCell
  9413.      else Result:=nil;
  9414. end;
  9415.  
  9416. procedure TWABD_DataTable.SetRenderCell(Event:TWABD_OnRenderCellEvent);
  9417. begin
  9418.      if FTable<>nil then FTable.OnRenderCell:=Event;
  9419. end;
  9420.  
  9421. function TWABD_DataTable.GetUserClickCell:TWABD_OnUserClickCellEvent;
  9422. begin
  9423.      if FTable<>nil then Result:=FTable.OnUserClickCell
  9424.      else Result:=nil;
  9425. end;
  9426.  
  9427. procedure TWABD_DataTable.SetUserClickCell(Event:TWABD_OnUserClickCellEvent);
  9428. begin
  9429.      if FTable<>nil then FTable.OnUserClickCell:=Event;
  9430. end;
  9431.  
  9432. function TWABD_DataTable.GetSetupClickableCell:TWABD_OnSetupClickableCellEvent;
  9433. begin
  9434.      if FTable<>nil then Result:=FTable.OnSetupClickableCell
  9435.      else Result:=nil;
  9436. end;
  9437.  
  9438. procedure TWABD_DataTable.SetSetupClickableCell(Event:TWABD_OnSetupClickableCellEvent);
  9439. begin
  9440.      if FTable<>nil then FTable.OnSetupClickableCell:=Event;
  9441. end;
  9442.  
  9443. function TWABD_DataTable.GetSetupCellJavascript:TWABD_OnSetupJavascriptEvent;
  9444. begin
  9445.      if FTable<>nil then Result:=FTable.OnSetupCellJavascript
  9446.      else Result:=nil;
  9447. end;
  9448.  
  9449. procedure TWABD_DataTable.SetSetupCellJavascript(Event:TWABD_OnSetupJavascriptEvent);
  9450. begin
  9451.      if FTable<>nil then FTable.OnSetupCellJavascript:=Event;
  9452. end;
  9453.  
  9454. function TWABD_DataTable.GetSetupRowJavascript:TWABD_OnSetupJavascriptEvent;
  9455. begin
  9456.      if FTable<>nil then Result:=FTable.OnSetupRowJavascript
  9457.      else Result:=nil;
  9458. end;
  9459.  
  9460. procedure TWABD_DataTable.SetLiteral(Value:boolean);
  9461. begin
  9462.      if FTable<>nil then FTable.Literal:=Value;
  9463. end;
  9464.  
  9465. function TWABD_DataTable.GetLiteral:boolean;
  9466. begin
  9467.      if FTable<>nil then Result:=FTable.Literal
  9468.      else Result:=false;
  9469. end;
  9470.  
  9471.  
  9472. procedure TWABD_DataTable.SetSetupRowJavascript(Event:TWABD_OnSetupJavascriptEvent);
  9473. begin
  9474.      if FTable<>nil then FTable.OnSetupRowJavascript:=Event;
  9475. end;
  9476.  
  9477. procedure TWABD_DataTable.SetName(const NewName: TComponentName);
  9478. begin
  9479.    inherited;
  9480.    FTable.Name := Name + '_Tab';
  9481. end;
  9482.  
  9483. destructor  TWABD_DataTable.Destroy;
  9484. begin
  9485.    FDataLink.Free;
  9486.    inherited;
  9487. end;
  9488.  
  9489. procedure TWABD_DataTable.Notification(AComponent: TComponent; Operation: TOperation);
  9490. begin
  9491.    inherited;
  9492.    if (Operation = opRemove) and (AComponent = FDataLink.DataSource) then
  9493.       FDataLink.DataSource := nil;
  9494. end;
  9495.  
  9496. function TWABD_DataTable.GetDataSource: TDataSource;
  9497. begin
  9498.    Result := FDataLink.DataSource;
  9499. end;
  9500.  
  9501. procedure TWABD_DataTable.SetDataSource(NewDataSource: TDataSource);
  9502. begin
  9503.    FDataLink.DataSource := NewDataSource;
  9504.    if NewDataSource<>nil then NewDataSource.FreeNotification(self);
  9505. end;
  9506.  
  9507. function TWABD_DataTable.GetNumPages:integer;
  9508. begin
  9509.     if FRecordCount<=0 then Result:=0
  9510.     else if FMaxRows<=0 then Result:=1
  9511.     else
  9512.     begin
  9513.         Result:=(FRecordCount div FMaxRows);
  9514.         if (FRecordCount mod FMaxRows) > 0 then inc(Result);
  9515.     end;
  9516. end;
  9517.  
  9518. function TWABD_DataTable.GetPage:integer;
  9519. begin
  9520.     Result:=0;
  9521.     if FMaxRows<=0 then Result:=1
  9522.     else if FActiveRec>0 then
  9523.         Result:=((FActiveRec-1) div FMaxRows)+1;
  9524. end;
  9525.  
  9526. function TWABD_DataTable.Object_To_HTML: string;
  9527. var
  9528.    t1, t2, t3 : string;
  9529. begin
  9530.    Result := '';
  9531.    if DataSource = nil then exit;
  9532.  
  9533.    if ShowEditForm then begin
  9534.       InitForm;
  9535.       t1 := FFormSec.Object_To_HTML + '<br>';
  9536.    end;
  9537.  
  9538.    if ShowNavButs then begin
  9539.       InitNavButs;
  9540.       t2 := FNavForm.Object_To_HTML + '<br>';
  9541.    end;
  9542.  
  9543.    if ShowTable then begin
  9544.       InitTable;
  9545.       t3 := FTable.Object_To_HTML + '<br>';
  9546.    end;
  9547.  
  9548.    Result := t1 + t2 + t3;
  9549. end;
  9550.  
  9551. procedure TWABD_DataTable.HTML_To_Object(FormVal: string);
  9552. begin
  9553.     // Nothing.
  9554. end;
  9555.  
  9556. procedure TWABD_DataTable.NextPage;
  9557. begin
  9558.     NextPgClick(self);
  9559. end;
  9560.  
  9561. procedure TWABD_DataTable.PrevPage;
  9562. begin
  9563.     PrevPgClick(self);
  9564. end;
  9565.  
  9566. procedure TWABD_DataTable.LastPage;
  9567. begin
  9568.     LastClick(self);
  9569. end;
  9570.  
  9571. procedure TWABD_DataTable.FirstPage;
  9572. begin
  9573.     FirstClick(self);
  9574. end;
  9575.  
  9576. procedure TWABD_DataTable.FirstClick(Sender: TObject);
  9577. begin
  9578.    DidAppend := False;
  9579.    if (DataSource=nil) or (DataSource.DataSet=nil) then exit;
  9580.    if DataSource.DataSet.BOF then Stat := 'Already at First Record'
  9581.       else Stat := 'Moved to First Record';
  9582.    DataSource.DataSet.First;
  9583.    if FActiveRec>0 then FActiveRec:=1;
  9584. end;
  9585.  
  9586. procedure TWABD_DataTable.LastClick(Sender: TObject);
  9587. begin
  9588.    if (DataSource=nil) or (DataSource.DataSet=nil) then exit;
  9589.    DidAppend := False;
  9590.    if DataSource.DataSet.EOF then Stat := 'Already at Last Record'
  9591.       else Stat := 'Moved to Last Record';
  9592.    DataSource.DataSet.Last;
  9593.    if FActiveRec>0 then FActiveRec:=FRecordCount;
  9594. end;
  9595.  
  9596. procedure TWABD_DataTable.NextClick(Sender: TObject);
  9597. begin
  9598.    if (DataSource=nil) or (DataSource.DataSet=nil) then exit;
  9599.    DidAppend := False;
  9600.    DataSource.DataSet.Next;
  9601.    if DataSource.DataSet.EOF then Stat := 'Already at Last Record'
  9602.       else begin
  9603.         Stat := 'Moved to Next Record';
  9604.         if FActiveRec>0 then inc(FActiveRec);
  9605.       end;
  9606. end;
  9607.  
  9608. procedure TWABD_DataTable.PrevClick(Sender: TObject);
  9609. begin
  9610.    if (DataSource=nil) or (DataSource.DataSet=nil) then exit;
  9611.    DidAppend := False;
  9612.    DataSource.DataSet.Prior;
  9613.    if DataSource.DataSet.BOF then Stat := 'Already at First Record'
  9614.       else begin
  9615.         Stat := 'Moved to Previous Record';
  9616.         if FActiveRec>0 then dec(FActiveRec);
  9617.       end;
  9618. end;
  9619.  
  9620. procedure TWABD_DataTable.NextPgClick(Sender: TObject);
  9621. begin
  9622.    if (DataSource=nil) or (DataSource.DataSet=nil) then exit;
  9623.    DidAppend := False;
  9624.    if (not DataSource.DataSet.EOF) and (FActiveRec + MaxRows <= FRecordCount) then
  9625.    begin
  9626.         DataSource.DataSet.MoveBy(MaxRows);
  9627.         if FActiveRec>0 then
  9628.         begin
  9629.             if DataSource.DataSet.EOF then FActiveRec:=FRecordCount
  9630.             else inc(FActiveRec,MaxRows);
  9631.         end;
  9632.         Stat := 'Moved to Next Page';
  9633.    end
  9634.    else Stat := 'Allready at Last Page';
  9635. end;
  9636.  
  9637. procedure TWABD_DataTable.PrevPgClick(Sender: TObject);
  9638. begin
  9639.    if (DataSource=nil) or (DataSource.DataSet=nil) then exit;
  9640.    DidAppend := False;
  9641.    if (not DataSource.DataSet.BOF) and (FActiveRec - MaxRows > 0)  then
  9642.    begin
  9643.         DataSource.DataSet.MoveBy(-MaxRows);
  9644.         if FActiveRec>0 then
  9645.         begin
  9646.             if DataSource.DataSet.BOF then FActiveRec:=1
  9647.             else dec(FActiveRec,MaxRows);
  9648.         end;
  9649.         Stat := 'Moved to Previous Page';
  9650.    end
  9651.    else Stat := 'Allready at First Page';
  9652. end;
  9653.  
  9654. procedure TWABD_DataTable.JumpToTableRecord(RowIndex: integer);
  9655. var
  9656.    r:longint;
  9657. begin
  9658.    if (DataSource=nil) or (DataSource.DataSet=nil) then exit;
  9659.    DidAppend := False;
  9660.    r:=DataSource.DataSet.MoveBy(RowIndex-1);
  9661.    if FActiveRec>0 then inc(FActiveRec,r);
  9662.    Stat := 'Moved to Record';
  9663. end;
  9664.  
  9665. procedure TWABD_DataTable.TableClick(Sender: TObject; RowIndex: integer);
  9666. var
  9667.    MoveToRecord   : boolean;
  9668. begin
  9669.    if (DataSource=nil) or (DataSource.DataSet=nil) then exit;
  9670.    MoveToRecord := True;
  9671.  
  9672.    if Assigned(OnRecordClick) then OnRecordClick(Self, RowIndex, MoveToRecord);
  9673.  
  9674.    if MoveToRecord then JumpToTableRecord(RowIndex);
  9675. end;
  9676.  
  9677. procedure TWABD_DataTable.AddClick(Sender: TObject);
  9678. begin
  9679.    if (DataSource=nil) or (DataSource.DataSet=nil) then exit;
  9680.    DidAppend := False;
  9681.    try
  9682.       Assert(not ReadOnly, 'DataSet is Read Only!');
  9683.  
  9684.       DataSource.DataSet.Append;
  9685.       if FRecordCount>0 then inc(FRecordCount);
  9686.       DidAppend := True;
  9687.       Stat := 'Fields initialized, make changes and then select "Edit" to save';
  9688.       InitForm;
  9689.    except
  9690.       on e: Exception do begin
  9691.          Stat := e.Message;
  9692.          DataSource.DataSet.Cancel;
  9693.       end;
  9694.    end;
  9695. end;
  9696.  
  9697. procedure TWABD_DataTable.EditClick(Sender: TObject);
  9698. var
  9699.    i        : integer;
  9700.    we       : TWABD_Edit;
  9701.    EdName   : string;
  9702.    f        : TField;
  9703. begin
  9704.    if (DataSource=nil) or (DataSource.DataSet=nil) then exit;
  9705.    try
  9706.       Assert(not ReadOnly, 'DataSet is Read Only!');
  9707.  
  9708.       if DidAppend then
  9709.          DataSource.DataSet.Append
  9710.       else
  9711.          DataSource.DataSet.Edit;
  9712.  
  9713.       // Read in the Field Values
  9714.       with FFormSec do begin
  9715.          for i := 0 to VisFieldCount(DataSource.DataSet)-1 do begin
  9716.             f := VisField(DataSource.DataSet, i);
  9717.  
  9718.             EdName := Self.Name + '_TFE_' + IntToStr(i);
  9719.             we := ChildByName(EdName) as TWABD_Edit;
  9720.             f.AsString := we.Text;
  9721.          end;
  9722.       end;
  9723.  
  9724.       DataSource.DataSet.Post;
  9725.       Stat := 'Field updated';
  9726.       DidAppend := False;
  9727.    except
  9728.       on e: Exception do begin
  9729.          Stat := e.Message;
  9730.          DataSource.DataSet.Cancel;
  9731.          DidAppend := False;
  9732.       end;
  9733.    end;
  9734. end;
  9735.  
  9736. procedure TWABD_DataTable.DeleteClick(Sender: TObject);
  9737. begin
  9738.    if (DataSource=nil) or (DataSource.DataSet=nil) then exit;
  9739.    DidAppend := False;
  9740.    try
  9741.       Assert(not ReadOnly, 'DataSet is Read Only!');
  9742.  
  9743.       DataSource.DataSet.Delete;
  9744.       if FRecordCount>0 then dec(FRecordCount);
  9745.       Stat := 'Deleted Record';
  9746.    except
  9747.       on e: Exception do Stat := e.Message;
  9748.    end;
  9749. end;
  9750.  
  9751. procedure TWABD_DataTable.InitForm;
  9752. var
  9753.    i     : integer;
  9754.    x, y  : integer;
  9755.    ds    : TDataSet;
  9756.    f     : TField;
  9757.    nl    : TWABD_Label;
  9758.    ne    : TWABD_Edit;
  9759. begin
  9760.    ds := DataSource.DataSet;
  9761.    with FFormSec do begin
  9762.       // Clear out old Controls
  9763.       for i := ChildCount-1 downto 0 do
  9764.          Children[i].Free;
  9765.  
  9766.       GridX := FColWidth;
  9767.       GridY := 25;
  9768.  
  9769.       x := 0;
  9770.       y := 0;
  9771.       for i := 0 to VisFieldCount(ds)-1 do begin
  9772.          f := VisField(ds, i);;
  9773.  
  9774.          // Create the Label
  9775.          nl := TWABD_Label.Create(Self);
  9776.          nl.Parent := FFormSec;
  9777.          nl.Caption := f.DisplayLabel;
  9778.          nl.LeftPos := x * GridX;
  9779.          nl.TopPos  := (y*2) * GridY;
  9780.          nl.ColSpan := 1;
  9781.  
  9782.          // Create the Edit Box
  9783.          ne := TWABD_Edit.Create(Self);
  9784.          ne.Name    := Self.Name + '_TFE_' + IntToStr(i);
  9785.          ne.Parent  := FFormSec;
  9786.          ne.LeftPos := x * GridX;
  9787.          ne.TopPos  := (y*2+1) * GridY;
  9788.          ne.Size    := (GridX - 10) div PIXELS_PER_CHAR_X;
  9789.          ne.Text := f.AsString;
  9790.  
  9791.          // go to the next position
  9792.          x := x + 1;
  9793.          if x = FNumCol then begin
  9794.             x := 0;
  9795.             y := y + 1;
  9796.          end;
  9797.       end;
  9798.    end;
  9799. end;
  9800.  
  9801. procedure TWABD_DataTable.CreateNavBut(x, y : integer; ButCap: string; OnUserClick: TNotifyEvent);
  9802. var
  9803.    b : TWABD_Button;
  9804. begin
  9805.    b         := TWABD_Button.Create(Self);
  9806.    b.Parent  := FNavForm;
  9807.    b.LeftPos := x;
  9808.    b.TopPos  := y;
  9809.    b.Caption := ButCap;
  9810.    b.OnUserClick := OnUserClick;
  9811. end;
  9812.  
  9813. procedure TWABD_DataTable.InitNavButs;
  9814. const
  9815.    X = 50;
  9816. var
  9817.    i  : integer;
  9818.    nl : TWABD_Label;
  9819. begin
  9820.    // Clear out old Controls
  9821.    for i := FNavForm.ChildCount-1 downto 0 do
  9822.       FNavForm.Children[i].Free;
  9823.  
  9824.    FNavForm.GridX := X;
  9825.    FNavForm.GridY := 35;
  9826.  
  9827.    CreateNavBut(X * 0,  0, 'First',  FirstClick);
  9828.    CreateNavBut(X * 1,  0, 'Last',   LastClick);
  9829.    CreateNavBut(X * 2,  0, 'Prev',   PrevClick);
  9830.    CreateNavBut(X * 3,  0, 'Next',   NextClick);
  9831.    CreateNavBut(X * 4,  0, 'Prev+',  PrevPgClick);
  9832.    CreateNavBut(X * 5,  0, 'Next+',  NextPgClick);
  9833.  
  9834.    if ShowEditForm and (not ReadOnly) then begin
  9835.       CreateNavBut(X * 7,  0, 'Add',    AddClick);
  9836.       CreateNavBut(X * 8,  0, 'Edit',   EditClick);
  9837.       CreateNavBut(X * 9,  0, 'Delete', DeleteClick);
  9838.    end;
  9839.  
  9840.    nl := TWABD_Label.Create(Self);
  9841.    nl.Parent := FNavForm;
  9842.    nl.LeftPos := 0;
  9843.    nl.TopPos  := 35;
  9844.    if Stat='' then Stat := 'Viewing ' + DataSource.DataSet.Name;
  9845.    nl.Caption := Format('Status:  %s', [Stat]);
  9846. end;
  9847.  
  9848. procedure TWABD_DataTable.InitTable;
  9849. var
  9850.    ds    : TDataSet;
  9851.    i     : integer;
  9852.    bm    : TBookmark;
  9853.    row   : integer;
  9854.    mr    : integer;
  9855.    f     : TField;
  9856. begin
  9857.    FTable.CanClick:=FCanSelectRecord;
  9858.    ds := DataSource.DataSet;
  9859.    FTable.Cells.SetSize(0, 0);
  9860.    mr:=FMaxRows;
  9861.    if mr<=0 then mr:=FRecordCount;
  9862.    if mr<=0 then mr:=10;
  9863.    FTable.Cells.SetSize(VisFieldCount(ds), mr + 1);
  9864.  
  9865.    // Set the Column Widths
  9866.    if not AutoWidth then begin
  9867.       for i := 0 to VisFieldCount(ds)-1 do begin
  9868.          FTable.ColWidth[i] := VisField(ds, i).DisplayWidth;   // Table will convert Chars to Pixels
  9869.       end;
  9870.    end;
  9871.  
  9872.    // Set the Field Headers and alignment.
  9873.    for i := 0 to VisFieldCount(ds)-1 do begin
  9874.       f:=VisField(ds,i);
  9875.  
  9876.       // Setup header.
  9877.       FTable.Cells[i, 0] := f.DisplayLabel;
  9878.  
  9879.       // If field is datetime, dont allow wrap.
  9880.       FTable.ColWrap[i]:=not (f.DataType in [ftDate,ftTime,ftDateTime]);
  9881.  
  9882.       // Setup alignment.
  9883.       case f.Alignment of
  9884.         taRightJustify: FTable.ColAlign[i]:=alhRight;
  9885.         taCenter: FTable.ColAlign[i]:=alhCenter;
  9886.       else
  9887.         FTable.ColAlign[i]:=alhLeft;
  9888.       end;
  9889.    end;
  9890.  
  9891.    bm := ds.GetBookmark;
  9892.    row := 0;
  9893.    repeat
  9894.       for i := 0 to VisFieldCount(ds)-1 do begin
  9895.          FTable.Cells[i, row+1] := VisField(ds, i).DisplayText;
  9896.       end;
  9897.       ds.Next;
  9898.       row := row + 1;
  9899.    until (row >= mr) or (ds.EOF);
  9900.  
  9901.    ds.GotoBookmark(bm);
  9902.    ds.FreeBookmark(bm);
  9903. end;
  9904.  
  9905.  
  9906. // TWABD_Hidden
  9907.  
  9908. function TWABD_Hidden.Object_To_HTML: string;
  9909. begin
  9910.    Result := '<input type=hidden name='+Name+' value='+Value+'>' + CR;
  9911. end;
  9912.  
  9913. procedure TWABD_Hidden.HTML_To_Object(FormVal: string);
  9914. begin
  9915.    Value := FormVal;
  9916. end;
  9917.  
  9918. function TWABD_Hidden.Object_To_Control(AOwner: TWinControl): TControl;
  9919. var
  9920.    ne : TEdit;
  9921. begin
  9922.    ne := TEdit.Create(AOwner);
  9923.    ne.Parent   := AOwner;
  9924.    ne.Name     := Name;
  9925.    ne.Height   := 0;
  9926.    ne.Text     := Value;
  9927.    Result := ne;
  9928. end;
  9929.  
  9930.  
  9931. // TWABD_BlankLines
  9932.  
  9933. constructor TWABD_BlankLines.Create(AOwner: TComponent);
  9934. begin
  9935.    inherited;
  9936.    FNumLines := 1;
  9937. end;
  9938.  
  9939. function TWABD_BlankLines.Object_To_HTML: string;
  9940. var
  9941.    i : integer;
  9942. begin
  9943.    Result := '';
  9944.    for i := 0 to FNumLines-1 do begin
  9945.       Result := Result + '<P> </P>';
  9946.    end;
  9947. end;
  9948.  
  9949. function TWABD_BlankLines.Object_To_WML: string;
  9950. var
  9951.    i:integer;
  9952. begin
  9953.    Result := '';
  9954.    for i := 0 to FNumLines-1 do
  9955.       Result := Result + '<br/>';
  9956. end;
  9957.  
  9958. function TWABD_BlankLines.Object_To_Control(AOwner: TWinControl): TControl;
  9959. var
  9960.    np : TPaintPanel;
  9961. begin
  9962.    np := TPaintPanel.Create(AOwner);
  9963.    np.BevelOuter := bvNone;
  9964.    np.Height     := FNumLines * PIXELS_PER_CHAR_Y;
  9965.    np.Name       := Name;
  9966.    np.Caption    := '';
  9967.    Result := np;
  9968. end;
  9969.  
  9970. procedure TWABD_BlankLines.HTML_To_Object(FormVal: string);
  9971. begin
  9972.     // Nothing.
  9973. end;
  9974.  
  9975.  
  9976. // ************************************************************************
  9977. // Form Level Objects
  9978. // ************************************************************************
  9979.  
  9980.  
  9981. // TWABD_SectionObject
  9982.  
  9983. constructor TWABD_SectionObject.Create(AOwner: TComponent);
  9984. begin
  9985.      inherited;
  9986.      FLeftPos  := 0;
  9987.      FTopPos   := 0;
  9988.      FWidth    := 0;
  9989.      FHeight   := 0;
  9990.      FColSpan  := -1;
  9991.      FRowSpan  := -1;
  9992. end;
  9993.  
  9994. destructor TWABD_SectionObject.Destroy;
  9995. begin
  9996.      inherited;
  9997. end;
  9998.  
  9999. procedure TWABD_SectionObject.SetLeft(NewLeft: integer);
  10000. begin
  10001.    if (NewLeft<>OrigLeft) then begin
  10002.       FLeftPos := NewLeft;
  10003.       OrigLeft := NewLeft;
  10004.       Changed;
  10005.    end;
  10006. end;
  10007.  
  10008. procedure TWABD_SectionObject.SetTop(NewTop: integer);
  10009. begin
  10010.    if (NewTop<>OrigTop) then begin
  10011.       FTopPos := NewTop;
  10012.       OrigTop := NewTop;
  10013.       Changed;
  10014.    end;
  10015. end;
  10016.  
  10017. function TWABD_SectionObject.GenerateOptionHTML:string;
  10018. var
  10019.    s:string;
  10020. begin
  10021.      s:='';
  10022.      if FTabIndex<>0 then s:=s+' TABINDEX='+inttostr(FTabIndex);
  10023.      if FDisabled then s:=s+' DISABLED';
  10024.      if FAccessKey<>'' then s:=s+' ACCESSKEY="'+copy(FAccessKey,1,1)+'"';
  10025.      Result:=s;
  10026. end;
  10027.  
  10028. // TWABD_BaseEventSectionObject
  10029.  
  10030. constructor TWABD_BaseEventSectionObject.Create(AOwner:TComponent);
  10031. begin
  10032.      inherited;
  10033.  
  10034.      FJS_OnUserKeyPress:=TWABD_JS_Function.Create(jsOnKeyPress);
  10035.      FJS_OnUserKeyUp:=TWABD_JS_Function.Create(jsOnKeyUp);
  10036.      FJS_OnUserKeyDown:=TWABD_JS_Function.Create(jsOnKeyDown);
  10037.      FJS_OnUserClick:=TWABD_JS_Function.Create(jsOnClick);
  10038.      FJS_OnUserDblClick:=TWABD_JS_Function.Create(jsOnDblClick);
  10039.      FJS_OnUserMouseOver:=TWABD_JS_Function.Create(jsOnMouseOver);
  10040.      FJS_OnUserMouseDown:=TWABD_JS_Function.Create(jsOnMouseDown);
  10041.      FJS_OnUserMouseUp:=TWABD_JS_Function.Create(jsOnMouseUp);
  10042.      FJS_OnUserMouseMove:=TWABD_JS_Function.Create(jsOnMouseMove);
  10043.      FJS_OnUserMouseOut:=TWABD_JS_Function.Create(jsOnMouseOut);
  10044.      FJS_OnUserGotFocus:=TWABD_JS_Function.Create(jsOnFocus);
  10045.      FJS_OnUserLostFocus:=TWABD_JS_Function.Create(jsOnBlur);
  10046.      FJS_OnUserChange:=TWABD_JS_Function.Create(jsOnChange);
  10047. end;
  10048.  
  10049. destructor TWABD_BaseEventSectionObject.Destroy;
  10050. begin
  10051.      FJS_OnUserKeyPress.Free;
  10052.      FJS_OnUserKeyUp.Free;
  10053.      FJS_OnUserKeyDown.Free;
  10054.      FJS_OnUserClick.Free;
  10055.      FJS_OnUserDblClick.Free;
  10056.      FJS_OnUserMouseOver.Free;
  10057.      FJS_OnUserMouseDown.Free;
  10058.      FJS_OnUserMouseUp.Free;
  10059.      FJS_OnUserMouseMove.Free;
  10060.      FJS_OnUserMouseOut.Free;
  10061.      FJS_OnUserGotFocus.Free;
  10062.      FJS_OnUserLostFocus.Free;
  10063.      FJS_OnUserChange.Free;
  10064.      inherited;
  10065. end;
  10066.  
  10067. function TWABD_BaseEventSectionObject.GenerateEventScript:string;
  10068. begin
  10069.      Result := GenEventCode(FJS_OnUserChange,FOnUserChange,WABD_EVENT_USERCHANGE,'')+
  10070.                GenEventCode(FJS_OnUserClick,FOnUserClick,WABD_EVENT_USERCLICK,'')+
  10071.                GenEventCode(FJS_OnUserGotFocus,FOnUserGotFocus,WABD_EVENT_USERGOTFOCUS,'')+
  10072.                GenEventCode(FJS_OnUserLostFocus,FOnUserLostFocus,WABD_EVENT_USERLOSTFOCUS,'')+
  10073.                GenEventCode(FJS_OnUserDblClick,nil,0,'')+
  10074.                GenEventCode(FJS_OnUserMouseOver,nil,0,'')+
  10075.                GenEventCode(FJS_OnUserMouseDown,nil,0,'')+
  10076.                GenEventCode(FJS_OnUserMouseUp,nil,0,'')+
  10077.                GenEventCode(FJS_OnUserMouseMove,nil,0,'')+
  10078.                GenEventCode(FJS_OnUserMouseOut,nil,0,'')+
  10079.                GenEventCode(FJS_OnUserKeyPress,nil,0,'')+
  10080.                GenEventCode(FJS_OnUserKeyDown,nil,0,'')+
  10081.                GenEventCode(FJS_OnUserKeyUp,nil,0,'');
  10082. end;
  10083.  
  10084. // TWABD_Autoload
  10085.  
  10086. constructor TWABD_Autoload.Create(AOwner: TComponent);
  10087. begin
  10088.    inherited;
  10089.    FDelay:=0;
  10090.    FForm:=nil;
  10091.    FFrameset:=nil;
  10092.    FMenubar:=true;
  10093.    FToolbar:=true;
  10094. end;
  10095.  
  10096. procedure TWABD_Autoload.Notification(AComponent: TComponent; Operation: TOperation);
  10097. begin
  10098.     inherited;
  10099.     if Operation=opRemove then
  10100.     begin
  10101.         if AComponent=FForm then FForm:=nil
  10102.         else if AComponent=FFrameSet then FFrameset:=nil;
  10103.     end;
  10104. end;
  10105.  
  10106. function TWABD_Autoload.Object_To_HTML: string;
  10107. begin
  10108.    Result := '';
  10109. end;
  10110.  
  10111. function TWABD_Autoload.Object_To_WML: string;
  10112. var
  10113.    s:string;
  10114.    f:TWABD_Body;
  10115. begin
  10116.      Result:='';
  10117.      f:=GetParentForm;
  10118.      if f=nil then exit;
  10119.  
  10120.      s:=ASCII_To_HTML(format('%s?%s='+WABD_SES_ID_STR_FORMAT+'&%s='+inttostr(WABD_EVENT_AUTOLOAD)+'::%s:%d',
  10121.         [DllName,WABD_SES_ID_STR,SessionID,f.Name,WABD_EVENT_ID_STR,f.Name,ord(Replace)]));
  10122.      if Delay>0 then
  10123.         Result := '<onevent type="ontimer">'+CR+
  10124.                   '<go href="'+s+'"/>'+CR+
  10125.                   '</onevent>'+CR+
  10126.                   '<timer value="'+inttostr(Delay div 100)+'"/>'
  10127.      else
  10128.         Result := '<onevent type="onenterforward">'+CR+
  10129.                   '<go href="'+s+'"/>'+CR+
  10130.                   '</onevent>';
  10131. end;
  10132.  
  10133. procedure TWABD_Autoload.HTML_To_Object(FormVal: string);
  10134. begin
  10135.     // Nothing.
  10136. end;
  10137.  
  10138. function TWABD_Autoload.Object_To_Control(AOwner: TWinControl): TControl;
  10139. begin
  10140.      Result := nil;
  10141. end;
  10142.  
  10143. // TWABD_Anchor
  10144.  
  10145. constructor TWABD_Anchor.Create(AOwner: TComponent);
  10146. begin
  10147.    inherited;
  10148.    Destination := '';
  10149. end;
  10150.  
  10151. procedure TWABD_Anchor.Notification(AComponent: TComponent; Operation: TOperation);
  10152. begin
  10153.     inherited;
  10154.     if (Operation=opRemove) and (AComponent=FSubmitTo) then FSubmitTo:=nil;
  10155. end;
  10156.  
  10157. function TWABD_Anchor.Object_To_HTML: string;
  10158. var
  10159.    r2 : string;
  10160.    s  : string;
  10161. begin
  10162.    if FSubmitTo<>nil then
  10163.       s:=' TARGET="'+FSubmitTo.FFrameName+'"'
  10164.    else
  10165.      s:='';
  10166.    s:=trim(Destination+s);
  10167.    Result := '<A NAME='+Name;
  10168.    if s<>'' then Result := Result+' HREF='+s;
  10169.    Result:=Result+'>';
  10170.    r2 := ASCII_To_HTML(Caption);
  10171.    if Bold      then r2 := '<B>' + r2 + '</B>';
  10172.    if Italic    then r2 := '<I>' + r2 + '</I>';
  10173.    if Underline then r2 := '<U>' + r2 + '</U>';
  10174.    Result := Result + r2 + '</A>';
  10175. end;
  10176.  
  10177. function TWABD_Anchor.Object_To_WML: string;
  10178. var
  10179.    r2 : string;
  10180.    s  : string;
  10181. begin
  10182.    Result:='';
  10183.    s:=trim(Destination);
  10184.    if s='' then exit;
  10185.    Result := '<a ';
  10186.    if s<>'' then Result := Result+' href="'+s+'"';
  10187.    Result:=Result+'>';
  10188.    r2 := ASCII_To_HTML(Caption);
  10189.    if Bold      then r2 := '<b>' + r2 + '</b>';
  10190.    if Italic    then r2 := '<i>' + r2 + '</i>';
  10191.    if Underline then r2 := '<u>' + r2 + '</u>';
  10192.    Result := Result + r2 + '</a>';
  10193. end;
  10194.  
  10195. procedure TWABD_Anchor.HTML_To_Object(FormVal: string);
  10196. begin
  10197.     // Nothing.
  10198. end;
  10199.  
  10200. procedure TWABD_Anchor.SetName(const Value: TComponentName);
  10201. begin
  10202.    if (not (csLoading in ComponentState)) and ((FCaption='') or (FCaption=Name)) then Caption := Value;
  10203.    inherited;
  10204. end;
  10205.  
  10206. procedure TWABD_Anchor.SetCaption(NewCaption: string);
  10207. begin
  10208.    FCaption := NewCaption;
  10209.    FWidth := Length(Caption) * PIXELS_PER_CHAR_X;
  10210.    FHeight := PIXELS_PER_CHAR_Y + 1;
  10211.    Changed;
  10212. end;
  10213.  
  10214. function TWABD_Anchor.Object_To_Control(AOwner: TWinControl): TControl;
  10215. var
  10216.    nl : TJumpLabel;
  10217. begin
  10218.    nl := TJumpLabel.Create(AOwner);
  10219.    nl.CanClick    := True;
  10220.    nl.JumpDest    := FDest;
  10221.    {$IFDEF VER100}
  10222.    nl.Cursor      := crHandPoint;
  10223.    {$ENDIF}
  10224.    nl.AutoSize    := False;
  10225.    nl.Name        := Name;
  10226.    nl.Caption     := Caption;
  10227.    nl.Font.Style  := nl.Font.Style + [fsUnderLine];
  10228.    nl.Font.Size   := 9;
  10229.    nl.Font.Color  := clBlue;
  10230.    nl.Transparent := True;
  10231.    nl.JumpOut     := True;
  10232.    Result := nl;
  10233. end;
  10234.  
  10235.  
  10236. // TWABD_HotSpot
  10237.  
  10238. destructor TWABD_HotSpot.Destroy;
  10239. var
  10240.    OldChange : TNotifyEvent;
  10241. begin
  10242.    OldChange := FChange;
  10243.    inherited;
  10244.    if Assigned(OldChange) then OldChange(nil);
  10245. end;
  10246.  
  10247. procedure TWABD_HotSpot.SetX1(i: integer);
  10248. begin
  10249.    FX1 := i;
  10250.    Changed;
  10251. end;
  10252.  
  10253. procedure TWABD_HotSpot.SetY1(i: integer);
  10254. begin
  10255.    FY1 := i;
  10256.    Changed;
  10257. end;
  10258.  
  10259. procedure TWABD_HotSpot.SetX2(i: integer);
  10260. begin
  10261.    FX2 := i;
  10262.    Changed;
  10263. end;
  10264.  
  10265. procedure TWABD_HotSpot.SetY2(i: integer);
  10266. begin
  10267.    FY2 := i;
  10268.    Changed;
  10269. end;
  10270.  
  10271. procedure TWABD_HotSpot.SetName(const Value: TComponentName);
  10272. begin
  10273.    inherited;
  10274. end;
  10275.  
  10276. procedure TWABD_HotSpot.Changed;
  10277. begin
  10278.    if Assigned(OnChange) then OnChange(Self);
  10279. end;
  10280.  
  10281.  
  10282. // TWABD_Base_Image
  10283.  
  10284. constructor TWABD_Base_Image.Create(AOwner: TComponent);
  10285. begin
  10286.    inherited;
  10287.    FHotSpots  := TWABD_HotSpots.Create;
  10288.    FHotSpots.ParImage := Self;
  10289.    FAutoSize  := true;
  10290.    FImgWidth  := 0;
  10291.    FImgHeight := 0;
  10292.    FWidth     := 150;
  10293.    FHeight    := 150;
  10294.    FClickable := true;
  10295.    FSubmitTo  := nil;
  10296.    FSetup     := nil;
  10297.    FDest      := '';
  10298. end;
  10299.  
  10300. destructor  TWABD_Base_Image.Destroy;
  10301. var
  10302.    i:integer;
  10303.    c:TComponent;
  10304.    h:TWABD_Hotspot;
  10305. begin
  10306.    // Check if any hotspots pointing on this image, delete them.
  10307.    if Owner<>nil then
  10308.    begin
  10309.         for i:=Owner.Componentcount-1 downto 0 do
  10310.         begin
  10311.              c:=Owner.Components[i];
  10312.              if c is TWABD_Hotspot then
  10313.              begin
  10314.                   h:=c as TWABD_Hotspot;
  10315.                   if h.FImParent=self then Owner.RemoveComponent(c);
  10316.              end;
  10317.         end;
  10318.    end;
  10319.    FHotspots.Free;
  10320.    inherited;
  10321. end;
  10322.  
  10323. function TWABD_Base_Image.LocalImagePath:string;
  10324. begin
  10325.      if FSetup=nil then
  10326.         Result:=FImageFile
  10327.      else
  10328.          Result:=FSetup.GetLocalImagePath+FImageFile;
  10329. end;
  10330.  
  10331. function TWABD_Base_Image.ImagePath:string;
  10332. begin
  10333.      if FSetup=nil then
  10334.         Result:=FImageFile
  10335.      else
  10336.          Result:=FSetup.GetImagePath+FImageFile;
  10337. end;
  10338.  
  10339. procedure TWABD_Base_Image.Notification(AComponent: TComponent; Operation: TOperation);
  10340. begin
  10341.     inherited;
  10342.     if (Operation=opRemove) then
  10343.     begin
  10344.         if (AComponent=FSubmitTo) then FSubmitTo:=nil
  10345.         else if AComponent=FSetup then FSetup:=nil;
  10346.     end;
  10347. end;
  10348.  
  10349. procedure TWABD_Base_Image.SetHotSpots(HS: TWABD_HotSpots);
  10350. begin
  10351.    // Do Nothing
  10352. end;
  10353.  
  10354. procedure TWABD_Base_Image.SetImageFile(filename:TFileName);
  10355. begin
  10356.      FImageFile:=ExtractFilename(filename);
  10357.      if FAutoSize then UpdateImageSize;
  10358. end;
  10359.  
  10360. function TWABD_Base_Image.Object_To_HTML: string;
  10361. var
  10362.    p : string;
  10363.    sevent:string;
  10364.    href:string;
  10365.    w,h,t:string;
  10366. begin
  10367.    if RunningLocal then
  10368.       p := 'file://' + LocalImagePath
  10369.    else
  10370.       p := ImagePath;
  10371.  
  10372.    if FHeight>0 then h:=' HEIGHT='+inttostr(FHeight)
  10373.    else h:='';
  10374.    if FWidth>0 then w:=' WIDTH='+inttostr(FWidth)
  10375.    else w:='';
  10376.    if FTitle<>'' then t:=' TITLE="'+FTitle+'"'
  10377.    else t:='';
  10378.  
  10379.    Result := '<IMG SRC="'+p+'" ALT="'+ASCII_To_HTML(AltText)+'"'+h+w+t+'>';
  10380.    if FClickable then begin
  10381.       sevent:=GenerateEventScript;
  10382.  
  10383.       if FDest<>'' then
  10384.          href:=FDest
  10385.       else
  10386.          href:=format('%s?%s='+WABD_SES_ID_STR_FORMAT+'&%s.X=0&%s.Y=0',
  10387.             [DLLName,WABD_SES_ID_STR,SessionID,GetParentForm.Name,Name,Name]);
  10388.  
  10389.       if (FSubmitTo<>nil) or (FDest<>'') then
  10390.          Result:=format('<A HREF="%s" TARGET="%s" %s>%s</A>',[href,FSubmitTo.FFrameName,sevent,Result])
  10391.       else
  10392.          Result := '<INPUT TYPE=IMAGE NAME='+Name+' SRC="'+p+'" ALT="'+ASCII_To_HTML(AltText)+'" '+sevent+h+w+'>';
  10393.    end;
  10394. end;
  10395.  
  10396. function TWABD_Base_Image.Object_To_WML: string;
  10397. var
  10398.    p : string;
  10399.    w,h:string;
  10400.    a : string;
  10401. begin
  10402.    if RunningLocal then
  10403.       p := 'file://' + LocalImagePath
  10404.    else
  10405.       p := ImagePath;
  10406.  
  10407.    if FHeight>0 then h:=' height="'+inttostr(FHeight)+'"'
  10408.    else h:='';
  10409.    if FWidth>0 then w:=' width="'+inttostr(FWidth)+'"'
  10410.    else w:='';
  10411.    case FVertAlign of
  10412.       alvTop: a:=' align="top"';
  10413.       alvMiddle: a:=' align="middle"';
  10414.       alvBottom: a:=' align="bottom"';
  10415.       alvNone: a:='';
  10416.       else a:='';
  10417.    end;
  10418.  
  10419.    Result := '<img src="/'+p+'" alt="'+ASCII_To_HTML(AltText)+'"'+h+w+a+'/>';
  10420. end;
  10421.  
  10422. procedure TWABD_Base_Image.HTML_To_Object(FormVal: string);
  10423. begin
  10424.     // Nothing.
  10425. end;
  10426.  
  10427. procedure TWABD_Base_Image.SetName(const Value: TComponentName);
  10428. begin
  10429.    if (not (csLoading in ComponentState)) and ((FAltText='') or (FAltText=Name)) then FAltText := Value;
  10430.    inherited;
  10431. end;
  10432.  
  10433. procedure TWABD_Base_Image.UpdateImageSize;
  10434. var
  10435.    f : string;
  10436.    p : TPicture;
  10437. begin
  10438.      f := LocalImagePath;
  10439.      if FileExists(f) then begin
  10440.         p := TPicture.Create;
  10441.         try
  10442.            p.LoadFromFile(f);
  10443.            FImgWidth := p.Width;
  10444.            FImgHeight := p.Height;
  10445.            FWidth:=p.Width;
  10446.            FHeight:=p.Height;
  10447.         except
  10448.            on e: Exception do begin end;
  10449.         end;
  10450.         p.Free;
  10451.      end;
  10452.      Changed;
  10453. end;
  10454.  
  10455. procedure TWABD_Base_Image.SetImgWidth(w: integer);
  10456. begin
  10457.    FImgWidth := w;
  10458.    Changed;
  10459. end;
  10460.  
  10461. procedure TWABD_Base_Image.SetImgHeight(h: integer);
  10462. begin
  10463.    FImgHeight := h;
  10464.    Changed;
  10465. end;
  10466.  
  10467. procedure TWABD_Base_Image.UpdateImage;
  10468. begin
  10469. // Do nothing.
  10470. end;
  10471.  
  10472. function TWABD_Base_Image.Object_To_Control(AOwner: TWinControl): TControl;
  10473. var
  10474.    ni : TImage;
  10475.    bm : TBitmap;
  10476. begin
  10477. //showmessage('begin Object to control');
  10478.    ni := TImage.Create(AOwner);
  10479.    ni.Parent := AOwner;
  10480.    ni.Name   := Name;
  10481.    try
  10482.       ni.Picture.LoadFromFile(LocalImagePath);
  10483. {
  10484.       if ni.Picture.Width>0 then begin
  10485.          FImgWidth:=ni.Picture.Width;
  10486.          FImgHeight:=ni.Picture.Height;
  10487.          FWidth:=FImgWidth;
  10488.          FHeight:=FImgHeight;
  10489.       end;
  10490. }
  10491.    except
  10492.       on e: Exception do begin end;
  10493.    end;
  10494.    if ni.Picture.Width = 0 then begin
  10495.       bm := TBitmap.Create;
  10496.       bm.Width := Width;
  10497.       bm.Height := Height;
  10498.       bm.Canvas.TextOut(0, 0, 'Unable to load Bitmap: ');
  10499.       bm.Canvas.TextOut(0, 25, LocalImagePath);
  10500.       ni.Picture.Bitmap := bm;
  10501.       bm.Free;
  10502.    end;
  10503.    Result := ni;
  10504. //showmessage('end Object to control');
  10505. end;
  10506.  
  10507. procedure TWABD_Base_Image.MouseDown(x, y: integer);
  10508. var
  10509.    i  : integer;
  10510.    c  : TComponent;
  10511.    h  : TWABD_HotSpot;
  10512.    R  : TRect;
  10513.    pt : TPoint;
  10514. begin
  10515.    pt := Point(x, y);
  10516.    Assert(Owner<>nil, Format('Image %s has no Owner', [Name]));
  10517.    for i := 0 to Owner.ComponentCount-1 do begin
  10518.       c := Owner.Components[i];
  10519.       if (c is TWABD_HotSpot) then begin
  10520.          h := c as TWABD_HotSpot;
  10521.          R := Rect(h.X1, h.Y1, h.X2, h.Y2);
  10522.          if (h.ImageParent = Self) and PtInRect(R, pt) then begin
  10523.             if Assigned(h.OnUserClick) then h.OnUserClick(h);
  10524.             exit;
  10525.          end;
  10526.       end;
  10527.    end;
  10528.  
  10529.    if Assigned(OnMouseDown) then OnMouseDown(Self, x, y);
  10530.    if Assigned(OnUserClick) then OnUserClick(Self);
  10531. end;
  10532.  
  10533.  
  10534. // TWABD_LiveImage
  10535.  
  10536. constructor TWABD_LiveImage.Create(AOwner: TComponent);
  10537. begin
  10538.    inherited;
  10539.    FDirty     := True;
  10540.    WroteFile  := False;
  10541.    FImgWidth  := 200;
  10542.    FWidth     := 200;
  10543.    FImgHeight := 100;
  10544.    FHeight    := 100;
  10545.    FImgType   := liAuto;
  10546.    FSafeBmp   := TBitmap.Create;
  10547.    FSafeBmp.PixelFormat := Graphics.pf8bit;           // This is the safest format
  10548.    FSafeBmp.Width:=FImgWidth;
  10549.    FSafeBmp.Height:=FImgHeight;
  10550.    FSafeBmp.Handletype := bmDIB;
  10551.    FSafeBmp.Dormant;
  10552. end;
  10553.  
  10554. destructor TWABD_LiveImage.Destroy;
  10555. begin
  10556.    if WroteFile then DeleteFile(PChar(GetFileName));
  10557.    FSafeBmp.Free;
  10558.    inherited;
  10559. end;
  10560.  
  10561. procedure TWABD_LiveImage.SetPixelFormat(pf:TPixelFormat);
  10562. begin
  10563.     FSafeBmp.PixelFormat:=pf;
  10564. end;
  10565.  
  10566. procedure TWABD_LiveImage.SetTransMode(mode:TTransparentMode);
  10567. begin
  10568.     FSafeBmp.TransparentMode:=mode;
  10569. end;
  10570.  
  10571. procedure TWABD_LiveImage.SetTransColor(color:TColor);
  10572. begin
  10573.     FSafeBmp.TransparentColor:=color;
  10574. end;
  10575.  
  10576. function TWABD_LiveImage.GetPixelFormat:TPixelFormat;
  10577. begin
  10578.     Result:=FSafeBmp.PixelFormat;
  10579. end;
  10580.  
  10581. function TWABD_LiveImage.GetTransMode:TTransparentMode;
  10582. begin
  10583.     Result:=FSafeBmp.TransparentMode;
  10584. end;
  10585.  
  10586. function TWABD_LiveImage.GetTransColor:TColor;
  10587. begin
  10588.     Result:=FSafeBmp.TransparentColor;
  10589. end;
  10590.  
  10591. function TWABD_LiveImage.GetFileName: string;
  10592. begin
  10593.    Result := LocalImagePath;
  10594. end;
  10595.  
  10596. procedure TWABD_LiveImage.SetImgWidth(w: integer);
  10597. begin
  10598.    inherited;
  10599.    if not (csLoading in ComponentState) then
  10600.    begin
  10601.         FSafeBmp.Width:=FImgWidth;
  10602.         FSafeBmp.Height:=FImgHeight;
  10603.         FDirty:=true;
  10604.    end;
  10605. end;
  10606.  
  10607. procedure TWABD_LiveImage.SetImgHeight(h: integer);
  10608. begin
  10609.    inherited;
  10610.    if not (csLoading in ComponentState) then
  10611.    begin
  10612.         FSafeBmp.Width:=FImgWidth;
  10613.         FSafeBmp.Height:=FImgHeight;
  10614.         FDirty:=true;
  10615.    end;
  10616. end;
  10617.  
  10618. function TWABD_LiveImage.GetSafeBitmap: TBitmap;
  10619. begin
  10620.    FDirty := True;      // Assume it gets modified
  10621.    Result := FSafeBmp;
  10622. end;
  10623.  
  10624. function TWABD_LiveImage.GetCanvas: TCanvas;
  10625. begin
  10626.    FDirty := True;
  10627.    Result := FSafeBmp.canvas;
  10628. end;
  10629.  
  10630. procedure TWABD_LiveImage.Loaded;
  10631. begin
  10632.    inherited;
  10633.    FSafeBmp.Width:=FImgWidth;
  10634.    FSafeBmp.Height:=FImgHeight;
  10635.    Changed;
  10636. end;
  10637.  
  10638. function TWABD_LiveImage.DetermineImageType:TLiveImageType;
  10639. begin
  10640.      // If specified directly.
  10641.      if ImageType<>liAuto then
  10642.      begin
  10643.           Result:=ImageType;
  10644.           exit;
  10645.      end;
  10646.  
  10647.      // Check if WML request.
  10648.      if (Session<>nil) and (Session.Request<>nil)
  10649.         and (Session.Request.RequestType=WABD_REQUESTTYPE_WML) then
  10650.         Result:=liWBMP
  10651.  
  10652.      // Some sort of HTML request. Determine from image layout.
  10653.      else if PixelFormat in [pf1bit, pf4bit, pf8bit] then Result:=liGIF
  10654.      else Result:=liJPEG;
  10655. end;
  10656.  
  10657. function TWABD_LiveImage.GetNewName: string;
  10658. var
  10659.    ext      : string;
  10660. begin
  10661.    case DetermineImageType of
  10662.         liBMP: ext := '.bmp';
  10663.         liJPEG: ext := '.jpg';
  10664.         liGIF: ext := '.gif';
  10665.         liWBMP: ext := '.wbmp';
  10666.    end;
  10667.  
  10668.    if (Session<>nil) and (Session.SessionMgr<>nil) then
  10669.       Result := Format('I%7.7x%s', [ Session.SessionMgr.DrawSequenceValue(WABD_IMAGE_SEQUENCE), ext])
  10670.    else
  10671.       Result := 'I'+Name+ext;
  10672. end;
  10673.  
  10674. procedure TWABD_LiveImage.UpdateImage;
  10675. var
  10676.    gif:TGIFImage;
  10677.    jpg:TJPEGImage;
  10678.    wbmp:TkbmWAPBitmap;
  10679.    Ext:TGIFGraphicControlExtension;
  10680.    i:integer;
  10681. begin
  10682.    if FDirty then begin
  10683.       try
  10684.          DeleteFile(PChar(GetFileName));
  10685.       except
  10686.       end;
  10687.       WroteFile := False;
  10688.       FFileName := GetNewName;
  10689.       ImageFile := FFileName;
  10690.  
  10691.       case DetermineImageType of
  10692.            liBMP: FSafeBmp.savetofile(GetFileName);
  10693.            liGIF:
  10694.                 begin
  10695.                  gif:=TGIFImage.Create;
  10696.                  try
  10697.                     gif.Assign(FSafeBmp);
  10698.  
  10699.                     // Create an extension to set the transparency flag
  10700.                     gif.OptimizeColorMap;
  10701.                     Ext := TGIFGraphicControlExtension.Create(GIF.Images[0]);
  10702.                     if TransparentMode = tmAuto then
  10703.                     begin
  10704.                          Ext.TransparentColorIndex :=
  10705.                              gif.Images[0].ActiveColorMap[gif.Images[0].Pixels[0, gif.Height-1]];
  10706.                          Ext.Transparent := true;
  10707.                     end
  10708.                     else
  10709.                     begin
  10710.                          i:=gif.GlobalColorMap.IndexOf(TransparentColor and $00FFFFFF);
  10711.                          Ext.Transparent:=(i>=0);
  10712.                          Ext.TransparentColorIndex := i; //gif.Images[0].ActiveColorMap[i];
  10713.                     end;
  10714.                     gif.Images[0].Extensions.Add(Ext);
  10715.                     gif.Images[0].Interlaced := FInterlaced;
  10716.                     gif.SaveToFile(GetFileName);
  10717.                  finally
  10718.                     gif.free;
  10719.                  end;
  10720.                 end;
  10721.            liJPEG:
  10722.                 begin
  10723.                  jpg:=TJPEGImage.Create;
  10724.                  try
  10725.                     jpg.Assign(FSafeBmp);
  10726.                     jpg.SaveToFile(GetFileName);
  10727.                  finally
  10728.                     jpg.free;
  10729.                  end;
  10730.                 end;
  10731.            liWBMP:
  10732.                 begin
  10733.                  wbmp:=TkbmWAPBitmap.Create;
  10734.                  try
  10735.                     wbmp.Assign(FSafeBmp);
  10736.                     wbmp.PixelFormat:=pf1Bit;
  10737.                     wbmp.Monochrome:=true;
  10738.                     wbmp.SaveToFile(GetFileName);
  10739.                  finally
  10740.                     wbmp.free;
  10741.                  end;
  10742.                 end;
  10743.       end;
  10744.       WroteFile := True;
  10745.       FDirty := False;
  10746.    end;
  10747.    inherited;
  10748. end;
  10749.  
  10750. function TWABD_LiveImage.Object_To_HTML: string;
  10751. begin
  10752.    UpdateImage;
  10753.    if FAutoSize then
  10754.    begin
  10755.         FWidth:=FImgWidth;
  10756.         FHeight:=FImgHeight;
  10757.    end;
  10758.    Result := inherited Object_To_HTML;
  10759. end;
  10760.  
  10761. function TWABD_LiveImage.Object_To_WML: string;
  10762. begin
  10763.    UpdateImage;
  10764.    if FAutoSize then
  10765.    begin
  10766.         FWidth:=FImgWidth;
  10767.         FHeight:=FImgHeight;
  10768.    end;
  10769.    Result := inherited Object_To_WML;
  10770. end;
  10771.  
  10772. function TWABD_LiveImage.Object_To_Control(AOwner: TWinControl): TControl;
  10773. var
  10774.    ni : TImage;
  10775.    bm : Graphics.TBitmap;
  10776. begin
  10777. //   SaveImage;
  10778.    ni := TImage.Create(AOwner);
  10779.    ni.Parent := AOwner;
  10780.    ni.Name   := Name;
  10781.    bm := TBitmap.Create;
  10782.    bm.Width := Width;
  10783.    bm.Height := Height;
  10784.  
  10785.    if not FSafeBMP.Empty then bm.assign(FSafeBMP);
  10786.  
  10787.    with bm.Canvas do begin
  10788.       Font.Name := 'Times New Roman';
  10789.       Font.Size := 24;
  10790.       Font.Style := Font.Style + [fsItalic, fsBold];
  10791.       Brush.Style := bsClear;
  10792.  
  10793.       Font.Color := clLtGray;
  10794.       bm.Canvas.TextOut(8, 8, 'Live   Image');
  10795.  
  10796.       Font.Color := clBlue;
  10797.       bm.Canvas.TextOut(5, 5, 'Live   Image');
  10798.    end;
  10799.    ni.Picture.Bitmap:=bm;
  10800.    bm.free;
  10801.    Result := ni;
  10802. end;
  10803.  
  10804. // TWABD_Chart
  10805. procedure TWABD_Chart.Loaded;
  10806. begin
  10807.    inherited;
  10808. end;
  10809.  
  10810. procedure TWABD_Chart.Notification(AComponent: TComponent; Operation: TOperation);
  10811. begin
  10812.     inherited;
  10813.     if (Operation=opRemove) and (AComponent=FChart) then FChart:=nil;
  10814. end;
  10815.  
  10816. procedure TWABD_Chart.SetChart(Chart: TCustomChart);
  10817. begin
  10818.      FChart:=Chart;
  10819.      FChart.BufferedDisplay:=false;
  10820. end;
  10821.  
  10822. constructor TWABD_Chart.Create(AOwner: TComponent);
  10823. begin
  10824.    inherited;
  10825.    FChart:=nil;
  10826. end;
  10827.  
  10828. destructor TWABD_Chart.Destroy;
  10829. begin
  10830.    inherited;
  10831. end;
  10832.  
  10833. function TWABD_Chart.Object_To_HTML: string;
  10834. var
  10835.    i:integer;
  10836.    r:TRect;
  10837. begin
  10838.      if FChart<>nil then
  10839.      begin
  10840.           // Draw the object.
  10841.           FChart.Width:=Width;
  10842.           FChart.Height:=Height;
  10843. //          FChart.Repaint;
  10844.           for i:=0 to FChart.SeriesCount-1 do
  10845.               if FChart.Series[i].Active then FChart.Series[i].RefreshSeries;
  10846.  
  10847.           r:=canvas.ClipRect;
  10848.           FChart.draw(canvas,r);
  10849. //FChart.SaveToBitmapFile('c:\kbm.bmp'); // KBM DEBUG
  10850.      end;
  10851.      Result:=inherited Object_To_HTML;
  10852. //ShowMessage('Canvas cliprect='+inttostr(r.Left)+','+inttostr(r.top)+'-'+inttostr(r.right)+','+inttostr(r.bottom));
  10853. end;
  10854.  
  10855. function TWABD_Chart.Object_To_WML: string;
  10856. var
  10857.    i:integer;
  10858.    r:TRect;
  10859. begin
  10860.      if FChart<>nil then
  10861.      begin
  10862.           // Draw the object.
  10863.           FChart.Width:=Width;
  10864.           FChart.Height:=Height;
  10865. //          FChart.Repaint;
  10866.           for i:=0 to FChart.SeriesCount-1 do
  10867.               if FChart.Series[i].Active then FChart.Series[i].RefreshSeries;
  10868.  
  10869.           r:=canvas.ClipRect;
  10870.           FChart.draw(canvas,r);
  10871. //FChart.SaveToBitmapFile('c:\kbm.bmp'); // KBM DEBUG
  10872.      end;
  10873.      Result:=inherited Object_To_WML;
  10874. end;
  10875.  
  10876. function TWABD_Chart.Object_To_Control(AOwner: TWinControl): TControl;
  10877. var
  10878.    img:TImage;
  10879.    i:integer;
  10880. begin
  10881.    img:=inherited Object_To_Control(AOwner) as TImage;
  10882.    if FChart<>nil then begin
  10883.       for i:=0 to FChart.SeriesCount-1 do
  10884.           FChart.Series[i].RefreshSeries;
  10885.       FChart.ReCalcWidthHeight;
  10886.       FChart.draw(img.picture.bitmap.canvas,img.picture.bitmap.canvas.ClipRect);
  10887.    end
  10888.    else begin
  10889.       with img.picture.bitmap.canvas do begin
  10890.          Font.Name := 'Times New Roman';
  10891.          Font.Size := 24;
  10892.          Font.Style := Font.Style + [fsItalic, fsBold];
  10893.          Brush.Style := bsSolid;
  10894.          Font.Color := clLtGray;
  10895.          TextOut(6, 8, 'Chart');
  10896.          Brush.Style := bsClear;
  10897.          Font.Color := clBlue;
  10898.          TextOut(3, 5, 'Chart');
  10899.       end;
  10900.    end;
  10901.    Result:=img;
  10902. end;
  10903.  
  10904. procedure TWABD_Chart.HTML_To_Object(FormVal: string);
  10905. begin
  10906.     // Nothing.
  10907. end;
  10908.  
  10909. procedure TWABD_Chart.MouseDown(x, y: integer);
  10910. var
  10911.    i: longint;
  10912.    p: TPoint;
  10913.    lstlabel:TChartValueList;
  10914.    lstvalue:TChartValueList;
  10915.    ser: TChartSeries;
  10916. begin
  10917.     // Check chart if a bar has been clicked.
  10918.     if (FChart <> nil) and assigned(FOnChartPointClick) then
  10919.     begin
  10920.          ser:=FChart.SeriesList[0];
  10921.          with FChart,ser do
  10922.          begin
  10923.               p.X:=x;
  10924.               p.Y:=y;
  10925.               i:=Clicked(p.x,p.y);
  10926.  
  10927.               if i>=0 then
  10928.               begin
  10929.                 lstValue:=MandatoryValueList; // Some series have inverted X,Y coordinates. This is safe.
  10930.                 if lstvalue=YValues then
  10931.                    lstlabel:=XValues
  10932.                 else
  10933.                    lstlabel:=YValues;
  10934.                 FOnChartPointClick(self, i, lstlabel.Value[i], lstvalue.Value[i], XLabel[i]);
  10935.               end;
  10936.          end;
  10937.     end;
  10938.  
  10939.     inherited;
  10940. end;
  10941.  
  10942. // TWABD_Label
  10943.  
  10944. constructor TWABD_Label.Create(AOwner: TComponent);
  10945. begin
  10946.    inherited;
  10947.    FFontSize   := 3;
  10948.    FFontColor  := clNone;
  10949.    FBold       := False;
  10950.    FItalic     := False;
  10951.    FUnderline  := False;
  10952.    FCanClick   := False;
  10953. end;
  10954.  
  10955. destructor TWABD_Label.Destroy;
  10956. begin
  10957.    inherited;
  10958. end;
  10959.  
  10960. procedure TWABD_Label.Notification(AComponent: TComponent; Operation: TOperation);
  10961. begin
  10962.     inherited;
  10963.     if (Operation=opRemove) and (AComponent=FSubmitTo) then FSubmitTo:=nil;
  10964. end;
  10965.  
  10966. function TWABD_Label.Object_To_HTML: string;
  10967. var
  10968.    SizeStr  : string;
  10969.    ColStr   : string;
  10970.    s        : string;
  10971. begin
  10972.    Result := ASCII_To_HTML(Caption);
  10973.    if Bold      then Result := '<B>' + Result + '</B>';
  10974.    if Italic    then Result := '<I>' + Result + '</I>';
  10975.    if Underline then Result := '<U>' + Result + '</U>';
  10976.    if FontSize<>3 then SizeStr := ' SIZE='+IntToStr(FontSize);
  10977.    if FontColor<>clNone then ColStr := ' COLOR='+ColorToHTML(FontColor,'"');
  10978.    if (SizeStr<>'') or (ColStr<>'') then
  10979.       Result := '<FONT'+SizeStr+ColStr+'>' + Result + '</FONT>';
  10980.  
  10981.    if CanClick then
  10982.    begin
  10983.         if FSubmitTo<>nil then
  10984.            s:=' TARGET="'+FSubmitTo.FFrameName+'"'
  10985.         else
  10986.           s:='';
  10987.         Result := '<A HREF='+GetHRef(GetParentForm,self,WABD_LABEL_STR,Name)+s+'>'+Result+'</A>';
  10988.    end;
  10989. end;
  10990.  
  10991. function TWABD_Label.Object_To_WML: string;
  10992. begin
  10993.    Result := ASCII_To_HTML(Caption);
  10994.    if Bold      then Result := '<b>' + Result + '</b>';
  10995.    if Italic    then Result := '<I>' + Result + '</i>';
  10996.    if Underline then Result := '<u>' + Result + '</u>';
  10997.    if FontSize<3 then Result := ' <small>' + Result + '</small>';
  10998.    if FontSize>3 then Result := ' <big>' + Result + '</big>';
  10999.    if FontColor=clRed then Result := ' <em>' + Result + '</em>'
  11000.    else if FontColor=clBlue then Result := ' <strong>' + Result + '</strong>';
  11001. end;
  11002.  
  11003. procedure TWABD_Label.HTML_To_Object(FormVal: string);
  11004. begin
  11005.     // Nothing.
  11006. end;
  11007.  
  11008. procedure TWABD_Label.SetName(const Value: TComponentName);
  11009. begin
  11010.    if (not (csLoading in ComponentState)) and ((FCaption='') or (FCaption=Name)) then Caption := Value;
  11011.    inherited;
  11012. end;
  11013.  
  11014. procedure TWABD_Label.SetBold(NewBold: boolean);
  11015. begin
  11016.    FBold := NewBold;
  11017.    UpdateWidHgt;
  11018.    Changed;
  11019. end;
  11020.  
  11021. procedure TWABD_Label.UpdateWidHgt;
  11022. var
  11023.    m : double;
  11024. begin
  11025. //   FWidth := Length(FCaption) * (PIXELS_PER_CHAR_X + 1);
  11026. //   FHeight := PIXELS_PER_CHAR_Y - 3;
  11027.  
  11028.    if FBold then m := 1.25 else m := 1.0;
  11029.  
  11030.    // Now update based on the FontSize
  11031.    FWidth  := Round(Length(FCaption) * XLabPointSizes[FFontSize] * m);
  11032.    FHeight := Round(YLabPointSizes[FFontSize] * m);
  11033. end;
  11034.  
  11035. procedure TWABD_Label.SetCaption(NewCaption: string);
  11036. begin
  11037.    FCaption := NewCaption;
  11038.    UpdateWidHgt;
  11039.    Changed;
  11040. end;
  11041.  
  11042. function TWABD_Label.Object_To_Control(AOwner: TWinControl): TControl;
  11043. var
  11044.    nl : TJumpLabel;
  11045. begin
  11046.    nl := TJumpLabel.Create(AOwner);
  11047.    nl.AutoSize    := True;
  11048.    nl.Font.Size   := LabPointSizes[FontSize];
  11049.    nl.Font.Name   := 'Arial';
  11050.    if FontColor<>clNone then nl.Font.Color  := FontColor;
  11051.    if Bold then nl.Font.Style := nl.Font.Style + [fsBold];
  11052.    if Italic then nl.Font.Style := nl.Font.Style + [fsItalic];
  11053.    if Underline then nl.Font.Style := nl.Font.Style + [fsUnderline];
  11054.    nl.Name        := Name;
  11055.    nl.Caption     := Caption;
  11056.    nl.Transparent := True;
  11057.    nl.CanClick    := CanClick;
  11058.    nl.JumpOut     := False;
  11059.    Result := nl;
  11060. end;
  11061.  
  11062. procedure TWABD_Label.SetFontSize(NewSize: integer);
  11063. begin
  11064.    if NewSize < 1 then NewSize := 1;
  11065.    if NewSize > 7 then NewSize := 7;
  11066.    FFontSize := NewSize;
  11067.    UpdateWidHgt;
  11068.    Changed;
  11069. end;
  11070.  
  11071.  
  11072. // TWABD_LinesObject
  11073.  
  11074. constructor TWABD_LinesObject.Create(AOwner: TComponent);
  11075. begin
  11076.    inherited;
  11077.    FLines := TStringList.Create;
  11078. end;
  11079.  
  11080. destructor TWABD_LinesObject.Destroy;
  11081. begin
  11082.    FLines.Free;
  11083.    inherited;
  11084. end;
  11085.  
  11086. procedure TWABD_LinesObject.SetLines(NewLines: TStringList);
  11087. begin
  11088.    FLines.Assign(NewLines);
  11089. end;
  11090.  
  11091. procedure TWABD_LinesObject.SetName(const Value: TComponentName);
  11092. begin
  11093.    if (not (csLoading in ComponentState)) and ((FLines.Text='') or (FLines.Text=Name)) then FLines.Text := Value;
  11094.    inherited;
  11095. end;
  11096.  
  11097. // TWABD_SelLinesObject
  11098.  
  11099. constructor TWABD_SelLinesObject.Create(AOwner: TComponent);
  11100. begin
  11101.    inherited;
  11102.    FSelList:=TList.Create;
  11103.    FOldSelList:=TList.Create;
  11104.    FLines.OnChange:=OnChangeHandler;
  11105. end;
  11106.  
  11107. destructor TWABD_SelLinesObject.Destroy;
  11108. begin
  11109.      FSelList.Free;
  11110.      FOldSelList.Free;
  11111.      inherited;
  11112. end;
  11113.  
  11114. procedure TWABD_SelLinesObject.Clear;
  11115. begin
  11116.      ClearListSelected(FSelList);
  11117.      ClearListSelected(FOldSelList);
  11118.      Lines.Clear;
  11119. end;
  11120.  
  11121. procedure TWABD_SelLinesObject.OnChangeHandler(Sender:TObject);
  11122. begin
  11123.      ClearListSelected(FSelList);
  11124.      if Assigned(FOnChange) then FOnChange(Sender);
  11125. end;
  11126.  
  11127. function TWABD_SelLinesObject.GetChanged:boolean;
  11128. begin
  11129.      Result:=not EqualListSelected(FSelList,FOldSelList);
  11130. end;
  11131.  
  11132. function  TWABD_SelLinesObject.GetText(Index:integer):string;
  11133. var
  11134.     j:integer;
  11135.     s:string;
  11136. begin
  11137.     if (Index>=0) and (Index<Lines.Count) then
  11138.     begin
  11139.         s:=Lines[Index];
  11140.         j:=pos('=',s);
  11141.         if j<>0 then
  11142.             Result:=copy(s,1,j-1)
  11143.         else
  11144.             Result:=s;
  11145.     end
  11146.     else Result:='';
  11147. end;
  11148.  
  11149. function  TWABD_SelLinesObject.GetSelText:string;
  11150. begin
  11151.      Result:=GetText(SelIndex);
  11152. end;
  11153.  
  11154. function  TWABD_SelLinesObject.GetSelDesc:string;
  11155. begin
  11156.      Result:=GetDesc(SelIndex);
  11157. end;
  11158.  
  11159. function  TWABD_SelLinesObject.GetOldSelText:string;
  11160. begin
  11161.      Result:=GetText(OldSelIndex);
  11162. end;
  11163.  
  11164. function  TWABD_SelLinesObject.GetOldSelDesc:string;
  11165. begin
  11166.      Result:=GetDesc(OldSelIndex);
  11167. end;
  11168.  
  11169. function  TWABD_SelLinesObject.GetDesc(Index:integer):string;
  11170. var
  11171.     j:integer;
  11172.     s:string;
  11173. begin
  11174.     if (Index>=0) and (Index<Lines.Count) then begin
  11175.         s:=Lines[Index];
  11176.         j:=pos('=',s);
  11177.         Result:='';
  11178.         if j<>0 then Result:=copy(s,j+1,length(s));
  11179.         if Result='' then Result:=s;
  11180.     end
  11181.     else Result:='';
  11182. end;
  11183.  
  11184. procedure TWABD_SelLinesObject.SetSelIndex(i:integer);
  11185. begin
  11186.     ClearListSelected(FSelList);
  11187.     SetListSelected(FSelList,i,true);
  11188. end;
  11189.  
  11190. function  TWABD_SelLinesObject.GetSelIndex:integer;
  11191. var
  11192.    i:integer;
  11193. begin
  11194.      Result:=-1;
  11195.      for i:=0 to FSelList.Count-1 do
  11196.          if FSelList.Items[i]=Pointer(1) then
  11197.          begin
  11198.               Result:=i;
  11199.               break;
  11200.          end;
  11201. end;
  11202.  
  11203. procedure TWABD_SelLinesObject.SetOldSelIndex(i:integer);
  11204. begin
  11205.     ClearListSelected(FSelList);
  11206.     SetListSelected(FSelList,i,true);
  11207. end;
  11208.  
  11209. function  TWABD_SelLinesObject.GetOldSelIndex:integer;
  11210. var
  11211.    i:integer;
  11212. begin
  11213.      Result:=-1;
  11214.      for i:=0 to FOldSelList.Count-1 do
  11215.          if FOldSelList.Items[i]=Pointer(1) then
  11216.          begin
  11217.               Result:=i;
  11218.               break;
  11219.          end;
  11220. end;
  11221.  
  11222. procedure TWABD_SelLinesObject.SetSelText(s:string);
  11223. var
  11224.     i,j:integer;
  11225.     v,v1,v2:string;
  11226. begin
  11227.     for i:=0 to Lines.Count-1 do
  11228.     begin
  11229.         v:=Lines[i];
  11230.         j:=pos('=',v);
  11231.         if j<>0 then
  11232.         begin
  11233.              v2:=copy(v,j+1,length(v));
  11234.              v1:=copy(v,1,j-1);
  11235.         end
  11236.         else begin
  11237.              v2:=v;
  11238.              v1:=v;
  11239.         end;
  11240.         if (s=v1) or (s=v2) then begin
  11241.            SelIndex:=i;
  11242.            exit;
  11243.         end;
  11244.     end;
  11245.     SelIndex:=-1;
  11246. end;
  11247.  
  11248. procedure   TWABD_SelLinesObject.SetListSelected(AList:TList; Index:integer; Value:boolean);
  11249. begin
  11250.      if (Index<0) or (Index>=Lines.Count) then exit;
  11251.      if AList.Count<=Index then AList.Count:=Index+1;
  11252.      if Value then
  11253.         AList.Items[Index]:=pointer(1)
  11254.      else
  11255.         AList.Items[Index]:=pointer(0);
  11256. end;
  11257.  
  11258. function    TWABD_SelLinesObject.GetListSelected(AList:TList; Index:integer):boolean;
  11259. begin
  11260.      Result:=false;
  11261.      if (Index<0) or (Index>=Lines.Count) then exit;
  11262.      if AList.Count<=Index then exit;
  11263.      Result:=AList.Items[Index] = pointer(1);
  11264. end;
  11265.  
  11266. procedure   TWABD_SelLinesObject.ClearListSelected(AList:TList);
  11267. begin
  11268.      AList.Clear;
  11269. end;
  11270.  
  11271. procedure   TWABD_SelLinesObject.CopyListSelected(Src,Dst:TList);
  11272. var
  11273.    i:integer;
  11274. begin
  11275.      Dst.Count:=Src.Count;
  11276.      for i:=0 to Src.Count-1 do
  11277.          Dst.Items[i]:=Src.Items[i];
  11278. end;
  11279.  
  11280. function    TWABD_SelLinesObject.EqualListSelected(AList1,AList2:TList):boolean;
  11281. var
  11282.    i:integer;
  11283. begin
  11284.      Result:=false;
  11285.      if AList1.Count<>AList2.Count then exit;
  11286.      Result:=true;
  11287.      for i:=0 to AList1.Count-1 do
  11288.      begin
  11289.           if AList1.Items[i]<>ALIst2.Items[i] then
  11290.           begin
  11291.                Result:=false;
  11292.                break;
  11293.           end;
  11294.      end;
  11295. end;
  11296.  
  11297. procedure   TWABD_SelLinesObject.SetSelected(Index:integer; Value:boolean);
  11298. begin
  11299.      SetListSelected(FSelList,Index,Value);
  11300. end;
  11301.  
  11302. function    TWABD_SelLinesObject.GetSelected(Index:integer):boolean;
  11303. begin
  11304.      Result:=GetListSelected(FSelList,Index);
  11305. end;
  11306.  
  11307. procedure   TWABD_SelLinesObject.SetOldSelected(Index:integer; Value:boolean);
  11308. begin
  11309.      SetListSelected(FOldSelList,Index,Value);
  11310. end;
  11311.  
  11312. function    TWABD_SelLinesObject.GetOldSelected(Index:integer):boolean;
  11313. begin
  11314.      Result:=GetListSelected(FOldSelList,Index);
  11315. end;
  11316.  
  11317. // TWABD_Memo
  11318.  
  11319. constructor TWABD_Memo.Create(AOwner: TComponent);
  11320. begin
  11321.    inherited;
  11322.    Rows := 5;
  11323.    Cols := 20;
  11324. end;
  11325.  
  11326. function TWABD_Memo.Object_To_HTML: string;
  11327. var
  11328.    i : integer;
  11329.    s : string;
  11330. begin
  11331.    s := Format('<TEXTAREA NAME=%s COLS=%d ROWS=%d', [Name, Cols, Rows]);
  11332.    s:=s+GenerateOptionHTML+GenerateEventScript;
  11333.    s:=s+' WRAP=';
  11334.    if WordWrap=taOff then s:=s+'OFF'
  11335.    else if WordWrap=taOut then s:=s+'VIRTUAL'
  11336.    else s:=s+'PHYSICAL';
  11337.    if FTitle<>'' then s:=s+' TITLE="'+FTitle+'"';
  11338.    s:=s+'>'+CR;
  11339.    for i := 0 to Lines.Count-1 do begin
  11340.       s := s + ASCII_To_HTML(Lines[i]) + CR;
  11341.    end;
  11342.    Result := s + '</TEXTAREA>';
  11343. end;
  11344.  
  11345. function TWABD_Memo.Object_To_WML: string;
  11346. var
  11347.    r : string;
  11348. begin
  11349.    r := '<input type="text" name="' + Name + '" ';
  11350.    r := r + 'value="' + ASCII_To_HTML(FLines.Text) + '" ';
  11351.    r := r + 'size="20"';
  11352.    if trim(FTitle)<>'' then r:=r+' title="'+FTitle+'"';
  11353.    r := r + ' emptyok="true"';
  11354.    r := r + '/>';
  11355.    Result := r;
  11356. end;
  11357.  
  11358. function  TWABD_Memo.Object_To_WML_Postfield: string;
  11359. begin
  11360.      Result:='<postfield name="'+Name+'" value="$('+Name+')"/>'+CR;
  11361. end;
  11362.  
  11363. procedure TWABD_Memo.HTML_To_Object(FormVal: string);
  11364. begin
  11365.    Lines.Text := FormVal;
  11366. end;
  11367.  
  11368. procedure TWABD_Memo.SetCols(NewCols: integer);
  11369. begin
  11370.    FCols := NewCols;
  11371.    FWidth := FCols * PIXELS_PER_CHAR_X;
  11372.    Changed;
  11373. end;
  11374.  
  11375. procedure TWABD_Memo.SetRows(NewRows: integer);
  11376. begin
  11377.    FRows := NewRows;
  11378.    FHeight := FRows * PIXELS_PER_CHAR_Y;
  11379.    Changed;
  11380. end;
  11381.  
  11382. function TWABD_Memo.Object_To_Control(AOwner: TWinControl): TControl;
  11383. var
  11384.    nm : TMemo;
  11385. begin
  11386.    nm := TMemo.Create(AOwner);
  11387.    nm.Parent      := AOwner;
  11388.    nm.Name        := Name;
  11389.    nm.Lines.Text  := Lines.Text;
  11390.    Result := nm;
  11391. end;
  11392.  
  11393.  
  11394. // TWABD_Edit
  11395.  
  11396. constructor TWABD_Edit.Create(AOwner: TComponent);
  11397. begin
  11398.    inherited;
  11399.    Size  := 10;
  11400.    FPass := False;
  11401.    FOldText := '';
  11402.    FFormat := '';
  11403.    FEmptyOK := true;
  11404. end;
  11405.  
  11406. destructor TWABD_Edit.Destroy;
  11407. begin
  11408.    inherited;
  11409. end;
  11410.  
  11411. function TWABD_Edit.Object_To_HTML: string;
  11412. var
  11413.    r : string;
  11414. begin
  11415.    if not IsPassword then
  11416.       r := '<INPUT TYPE=TEXT '
  11417.    else
  11418.       r := '<INPUT TYPE=PASSWORD ';
  11419.    r := r + 'NAME=' + Name + ' ';
  11420.    r := r + 'VALUE="' + ASCII_To_HTML(Text) + '" ';
  11421.    r := r + 'SIZE='+inttostr(Size);
  11422.    if FTitle<>'' then r:=r+' TITLE="'+FTitle+'"';
  11423.    if FReadOnly and (not FDisabled) then
  11424.    begin
  11425.         if (Session<>nil) and (Session.Request<>nil) and (Session.Request.Browser=WABD_BrowserIExplorer) and (Session.Request.BrowserVersion>=4.0) then
  11426.            r := r + ' READONLY'
  11427.         else
  11428.            r := r + ' DISABLED';
  11429.    end;
  11430.  
  11431.    r := r + GenerateOptionHTML+GenerateEventScript;
  11432.  
  11433.    if MaxLength > 0 then
  11434.       r := r + ' MAXLENGTH='+inttostr(MaxLength);
  11435.    r := r + '>';
  11436.    Result := r;
  11437. end;
  11438.  
  11439. function TWABD_Edit.Object_To_WML: string;
  11440. var
  11441.    r : string;
  11442. begin
  11443.    if not IsPassword then
  11444.       r := '<input type="text" '
  11445.    else
  11446.       r := '<input type="password" ';
  11447.    r := r + 'name="' + Name + '" ';
  11448.    r := r + 'value="' + ASCII_To_HTML(Text) + '" ';
  11449.    r := r + 'size="'+inttostr(Size)+'"';
  11450.    if trim(FTitle)<>'' then r:=r+' title="'+FTitle+'"';
  11451.    if MaxLength > 0 then
  11452.       r := r + ' maxlength="'+inttostr(MaxLength)+'"';
  11453.    if EmptyOK then
  11454.       r := r + ' emptyok="true"';
  11455.    if trim(FFormat)<>'' then
  11456.       r := r + ' format="'+FFormat+'"';
  11457.    r := r + '/>';
  11458.    Result := r;
  11459. end;
  11460.  
  11461. function  TWABD_Edit.Object_To_WML_Postfield: string;
  11462. begin
  11463.      Result:='<postfield name="'+Name+'" value="$('+Name+')"/>'+CR;
  11464. end;
  11465.  
  11466. procedure TWABD_Edit.HTML_To_Object(FormVal: string);
  11467. begin
  11468.    Text := FormVal;
  11469. end;
  11470.  
  11471. procedure TWABD_Edit.SetName(const Value: TComponentName);
  11472. begin
  11473.    if (not (csLoading in ComponentState)) and ((FText = '') or (FText=Name)) then Text := Value;
  11474.    inherited;
  11475. end;
  11476.  
  11477. procedure TWABD_Edit.SetText(s:string);
  11478. begin
  11479.    FOldText:=Text;
  11480.    FText:=s;
  11481. end;
  11482.  
  11483. procedure TWABD_Edit.SetSize(NewSize: integer);
  11484. begin
  11485.    FSize := NewSize;
  11486.    FWidth := FSize * PIXELS_PER_CHAR_X + 8;
  11487.    FHeight := PIXELS_PER_CHAR_Y + 6;
  11488.    Changed;
  11489. end;
  11490.  
  11491. function TWABD_Edit.Object_To_Control(AOwner: TWinControl): TControl;
  11492. var
  11493.    ne : TEdit;
  11494. begin
  11495.    ne := TEdit.Create(AOwner);
  11496.    ne.Parent := AOwner;
  11497.    ne.Name   := Name;      // Just in case Text is blank, so it doesn't get reset to the Name in SetName
  11498.    ne.Text   := Text;
  11499.    if IsPassword then ne.PasswordChar := '*';
  11500.    Result := ne;
  11501. end;
  11502.  
  11503. // TWABD_UploadFile
  11504.  
  11505. constructor TWABD_UploadFile.Create(AOwner: TComponent);
  11506. begin
  11507.    inherited;
  11508.    Size:=10;
  11509.    FAcceptMimeTypes:=TStringList.Create;
  11510. end;
  11511.  
  11512. destructor TWABD_UploadFile.Destroy;
  11513. begin
  11514.    FAcceptMimeTypes.free;
  11515.    inherited;
  11516. end;
  11517.  
  11518. procedure TWABD_UploadFile.SetSize(NewSize: integer);
  11519. begin
  11520.    FSize := NewSize;
  11521.    FWidth := FSize * PIXELS_PER_CHAR_X + 8;
  11522.    FHeight := PIXELS_PER_CHAR_Y + 6;
  11523.    Changed;
  11524. end;
  11525.  
  11526. function TWABD_UploadFile.Object_To_HTML: string;
  11527. var
  11528.    r : string;
  11529. begin
  11530.    r := '<INPUT TYPE=FILE ';
  11531.    r := r + 'NAME=' + Name + ' ';
  11532.    r := r + 'VALUE="' + ASCII_To_HTML(ClientFileName) + '" ';
  11533.    r := r + 'ACCEPT="'+FAcceptMimeTypes.Text+'" ';
  11534.    r := r + 'SIZE='+inttostr(Size);
  11535.    if FReadOnly and (not FDisabled) then
  11536.    begin
  11537.         if (Session<>nil) and (Session.Request<>nil) and (Session.Request.Browser=WABD_BrowserIExplorer) and (Session.Request.BrowserVersion>=4.0) then
  11538.            r := r + ' READONLY'
  11539.         else
  11540.            r := r + ' DISABLED';
  11541.    end;
  11542.    if FTitle<>'' then r:=r+' TITLE="'+FTitle+'"';
  11543.  
  11544.    r := r + GenerateOptionHTML + GenerateEventScript;
  11545.    r := r + '>';
  11546.  
  11547.    // Set flag on form that encoding type should be changed.
  11548.    GetParentForm.FUploadFileOnForm:=true;
  11549.    Result := r;
  11550. end;
  11551.  
  11552. procedure TWABD_UploadFile.HTML_To_Object(FormVal: string);
  11553. var
  11554.    lst:TStringList;
  11555. begin
  11556.      // Set parameters.
  11557.      lst:=TStringList.Create;
  11558.      try
  11559.         WABD_SplitString(PChar(FormVal),';',lst);
  11560.         if lst.Count<=0 then exit;
  11561.         FLocalFileName:=lst.Strings[0];
  11562.         FClientFileName:=lst.Values['filename'];
  11563.         FMimeType:=lst.Values['Mime'];
  11564.      finally
  11565.         lst.Free;
  11566.      end;
  11567. end;
  11568.  
  11569. function TWABD_UploadFile.Object_To_Control(AOwner: TWinControl): TControl;
  11570. var
  11571.    ne : TEdit;
  11572. begin
  11573.    ne := TEdit.Create(AOwner);
  11574.    ne.Parent := AOwner;
  11575.    ne.Name   := Name;      // Just in case Text is blank, so it doesn't get reset to the Name in SetName
  11576.  
  11577. //   ne.Text   := Value;
  11578.    Result := ne;
  11579. end;
  11580.  
  11581.  
  11582. // TWABD_ComboBox
  11583.  
  11584. constructor TWABD_ComboBox.Create(AOwner: TComponent);
  11585. begin
  11586.    inherited;
  11587.    FWidth := PIXELS_PER_CHAR_X * 15;
  11588.    FHeight := PIXELS_PER_CHAR_Y + 6;
  11589. end;
  11590.  
  11591. destructor TWABD_ComboBox.Destroy;
  11592. begin
  11593.    inherited;
  11594. end;
  11595.  
  11596. function TWABD_ComboBox.Object_To_HTML: string;
  11597. var
  11598.    i,j : integer;
  11599.    s,s1 : string;
  11600. begin
  11601.    s:='<SELECT NAME='+Name+' SIZE=1';
  11602.    s:=s+GenerateOptionHTML+GenerateEventScript;
  11603.    if FTitle<>'' then s:=s+' TITLE="'+FTitle+'"';
  11604.    s:=s+'>'+CR;
  11605.  
  11606.    for i := 0 to Lines.Count-1 do begin
  11607.       s := s + '<OPTION';
  11608.       if Selected[i] then s := s+' SELECTED';
  11609.  
  11610.       s1:=Lines[i];
  11611.       j:=pos('=',s1);
  11612.       if j<>0 then
  11613.          s:=s+' VALUE="'+copy(s1,1,j-1)+'">' + ASCII_To_HTML(copy(s1,j+1,length(s1))) + CR
  11614.       else
  11615.          s:=s+'>' + ASCII_To_HTML(s1) + CR;
  11616.    end;
  11617.    if Lines.Count = 0 then s:=s + '<OPTION> ' + CR; // otherwise there will be no ComboBox!
  11618.  
  11619.    Result := s + '</SELECT>'+CR;
  11620.    if (Button<>nil) and (AutoButton) then Result:=Result+Button.Object_To_HTML;
  11621. end;
  11622.  
  11623. function TWABD_ComboBox.Object_To_WML: string;
  11624. var
  11625.    i,j  : integer;
  11626.    s,s1 : string;
  11627.    opt  : string;
  11628. begin
  11629.    s:='<select name="'+Name+'"';
  11630.    if FTitle<>'' then s:=s+' title="'+FTitle+'"';
  11631.    s:=s+' ivalue="'+inttostr(SelIndex+1)+'"';
  11632.    opt:='';
  11633.    for i := 0 to Lines.Count-1 do
  11634.    begin
  11635.         s1:=Lines[i];
  11636.         opt:=opt + '<option';
  11637.         j:=pos('=',s1);
  11638.         if j<>0 then
  11639.            opt:=opt+' value="'+copy(s1,1,j-1)+'">' + ASCII_To_HTML(copy(s1,j+1,length(s1)))
  11640.         else
  11641.            opt:=opt+'>'+ASCII_To_HTML(s1);
  11642.         opt:=opt+'</option>'+CR;
  11643.    end;
  11644.    s:=s+'>'+CR
  11645.       +opt
  11646.       +'</select>';
  11647.    Result:=s;
  11648. end;
  11649.  
  11650. function  TWABD_ComboBox.Object_To_WML_Postfield: string;
  11651. begin
  11652.      Result:='<postfield name="'+Name+'" value="$('+Name+')"/>'+CR;
  11653. end;
  11654.  
  11655. procedure TWABD_ComboBox.HTML_To_Object(FormVal: string);
  11656. var
  11657.     i,j:integer;
  11658.     v,v1,v2:string;
  11659. begin
  11660.     for i:=0 to Lines.Count-1 do
  11661.     begin
  11662.         v:=Lines[i];
  11663.         j:=pos('=',v);
  11664.         if j<>0 then
  11665.         begin
  11666.              v2:=copy(v,j+1,length(v));
  11667.              v1:=copy(v,1,j-1);
  11668.         end
  11669.         else begin
  11670.              v2:=v;
  11671.              v1:=v;
  11672.         end;
  11673.         if (FormVal=v1) or (FormVal=v2) then
  11674.         begin
  11675.              Selected[i]:=true;
  11676.              exit;
  11677.         end;
  11678.     end;
  11679. end;
  11680.  
  11681. function TWABD_ComboBox.Object_To_Control(AOwner: TWinControl): TControl;
  11682. var
  11683.    ncb : TComboBox;
  11684. begin
  11685.    ncb := TComboBox.Create(AOwner);
  11686.    ncb.Parent     := AOwner;
  11687.    ncb.Name       := Name;
  11688.    ncb.Items.Text := Lines.Text;
  11689.    ncb.ItemIndex  := SelIndex;
  11690.    Result := ncb;
  11691. end;
  11692.  
  11693. // TWABD_Button
  11694.  
  11695. constructor TWABD_Button.Create(AOwner:TComponent);
  11696. begin
  11697.    inherited;
  11698. end;
  11699.  
  11700. destructor TWABD_Button.Destroy;
  11701. begin
  11702.    inherited;
  11703. end;
  11704.  
  11705. function TWABD_Button.Object_To_HTML: string;
  11706. var
  11707.    s,s1:string;
  11708. begin
  11709.    // Depends on if containing Javascript or not.
  11710.    s1:=GenerateEventScript;
  11711.    s:='<INPUT TYPE="SUBMIT" NAME=';
  11712.    if length(s1)>0 then s:=s+Name
  11713.    else s:=s+WABD_BUTTON_STR;
  11714.  
  11715.    s:=s+' VALUE="'+Caption+'"'+GenerateOptionHTML+s1;
  11716.    if FTitle<>'' then s:=s+' TITLE="'+FTitle+'"';
  11717.    s:=s+'>';
  11718.    Result:=s;
  11719. end;
  11720.  
  11721. function TWABD_Button.Object_To_WML: string;
  11722. var
  11723.    f:TWABD_Form;
  11724.    s,s1:string;
  11725. begin
  11726.    f:=GetParentForm;
  11727.    if f<>nil then
  11728.    begin
  11729. //        s1:=URL_To_HTML(format('%s?%s='+WABD_SES_ID_STR_FORMAT+'&%s='+inttostr(WABD_EVENT_USERCLICK)+':%s:&%s=%d',
  11730. //            [DllName,WABD_SES_ID_STR,SessionID,f.Name,WABD_EVENT_ID_STR,Name,WABD_STAMP_STR,Random(100000)]));
  11731.         s1:=DllName;
  11732.         s:='<go href="'+s1+'" method="post">'+CR+
  11733.            format('<postfield name="%s" value="'+WABD_SES_ID_STR_FORMAT+'"/>',[WABD_SES_ID_STR,SessionID,f.Name])+CR+
  11734.            format('<postfield name="%s" value="%d:%s:"/>',[WABD_EVENT_ID_STR,WABD_EVENT_USERCLICK,Name])+CR+
  11735.            format('<postfield name="%s" value="%d"/>',[WABD_STAMP_STR,Random(999999)])+CR+
  11736.            f.FormSections_To_WML_Postfield+
  11737.            '</go>'+CR;
  11738.    end
  11739.    else
  11740.        s:='';
  11741.  
  11742.    Result:='<do type="accept" label="'+Caption+'" name="'+Name+'">'+CR+
  11743.            s+
  11744.            '</do>';
  11745. end;
  11746.  
  11747. procedure TWABD_Button.HTML_To_Object(FormVal: string);
  11748. begin
  11749.    // Nothing.
  11750. end;
  11751.  
  11752. procedure TWABD_Button.SetName(const Value: TComponentName);
  11753. begin
  11754.    if (not (csLoading in ComponentState)) and ((FCaption='') or (FCaption=Name)) then Caption := Value;
  11755.    inherited;
  11756. end;
  11757.  
  11758. procedure TWABD_Button.SetCaption(NewCaption: string);
  11759. begin
  11760.    FCaption := NewCaption;
  11761.    FWidth    := PIXELS_PER_CHAR_X * Length(FCaption) + 5;
  11762.    FHeight   := PIXELS_PER_CHAR_Y + 10;
  11763.    Changed;
  11764. end;
  11765.  
  11766. function TWABD_Button.Object_To_Control(AOwner: TWinControl): TControl;
  11767. var
  11768.    nb : TButton;
  11769. begin
  11770.    nb := TButton.Create(AOwner);
  11771.    nb.Name    := name;
  11772.    nb.Caption := Caption;
  11773.    nb.Default := Default;
  11774.    Result := nb;
  11775. end;
  11776.  
  11777.  
  11778. // TWABD_ListBox
  11779.  
  11780. constructor TWABD_ListBox.Create(AOwner: TComponent);
  11781. begin
  11782.    inherited;
  11783.    Size := 6;
  11784.    FMultiple:=false;
  11785. end;
  11786.  
  11787. destructor TWABD_ListBox.Destroy;
  11788. begin
  11789.    inherited;
  11790. end;
  11791.  
  11792. function TWABD_ListBox.Object_To_HTML: string;
  11793. var
  11794.    i,j : integer;
  11795.    s,s1 : string;
  11796. begin
  11797.    s:='<SELECT NAME='+Name+' SIZE='+inttostr(Size);
  11798.    if FMultiple then s:=s+' MULTIPLE';
  11799.    s:=s+GenerateOptionHTML+GenerateEventScript;
  11800.    if FTitle<>'' then s:=s+' TITLE="'+FTitle+'"';
  11801.    s:=s+'>'+CR;
  11802.  
  11803.    for i := 0 to Lines.Count-1 do begin
  11804.       s1:=Lines[i];
  11805.       s := s + '<OPTION';
  11806.       if Selected[i] then s := s+' SELECTED';
  11807.  
  11808.       j:=pos('=',s1);
  11809.       if j<>0 then
  11810.          s:=s+' VALUE='+copy(s1,1,j-1)+'>' + ASCII_To_HTML(copy(s1,j+1,length(s1))) + CR
  11811.       else
  11812.           s:=s+'>'+ASCII_To_HTML(s1) + CR;
  11813.    end;
  11814.    Result := s + '</SELECT>'+CR;
  11815.    if Button<>nil then Result:=Result+Button.Object_To_HTML;
  11816. end;
  11817.  
  11818. function TWABD_ListBox.Object_To_WML: string;
  11819. var
  11820.    i,j  : integer;
  11821.    s,s1,s2,s3 : string;
  11822.    opt  : string;
  11823.    sel  : string;
  11824. begin
  11825.    s:='<select name="'+Name+'" iname="i'+Name+'"';
  11826.    if FTitle<>'' then s:=s+' title="'+FTitle+'"';
  11827.    opt:='';
  11828.    sel:='';
  11829.    for i := 0 to Lines.Count-1 do
  11830.    begin
  11831.         s1:=Lines[i];
  11832.         j:=pos('=',s1);
  11833.         if j<>0 then
  11834.         begin
  11835.              s2:=copy(s1,1,j-1);
  11836.              s3:=copy(s1,j+1,length(s1));
  11837.         end
  11838.         else
  11839.         begin
  11840.              s2:=s1;
  11841.              s3:=s1;
  11842.         end;
  11843.         opt:=opt+'<option value="'+s2+'">' + ASCII_To_HTML(s3)+'</option>'+CR;
  11844.  
  11845.         if Selected[i] then
  11846.         begin
  11847.              if sel<>'' then sel:=sel+';';
  11848.              sel:=sel+inttostr(i+1);
  11849.         end;
  11850.    end;
  11851.  
  11852.    s:=s+' ivalue="'+sel+'"';
  11853.    if FMultiple then s:=s+' multiple="true"';
  11854.    s:=s+'>'+CR
  11855.       +opt
  11856.       +'</select>';
  11857.    Result:=s;
  11858. end;
  11859.  
  11860. function  TWABD_ListBox.Object_To_WML_Postfield: string;
  11861. begin
  11862.      Result:='<postfield name="'+Name+'" value="$('+Name+')"/>'+CR;
  11863. end;
  11864.  
  11865. procedure TWABD_ListBox.HTML_To_Object(FormVal: string);
  11866. var
  11867.     i,j,k:integer;
  11868.     v,v1,v2:string;
  11869.     lst:TStringList;
  11870. begin
  11871.      lst:=TStringList.Create;
  11872.      try
  11873.         // Support multiple selections in one name=value pair.
  11874.         WABD_SplitString(PChar(FormVal),';',lst);
  11875.  
  11876.         for k:=0 to lst.Count-1 do
  11877.         begin
  11878.              FormVal:=lst.Strings[k];
  11879.  
  11880.              for i:=0 to Lines.Count-1 do
  11881.              begin
  11882.                  v:=Lines[i];
  11883.                  j:=pos('=',v);
  11884.                  if j<>0 then
  11885.                  begin
  11886.                       v2:=copy(v,j+1,length(v));
  11887.                       v1:=copy(v,1,j-1);
  11888.                  end
  11889.                  else begin
  11890.                       v2:=v;
  11891.                       v1:=v;
  11892.                  end;
  11893.  
  11894.                  if (FormVal=v1) or (FormVal=v2) then
  11895.                      Selected[i]:=true;
  11896.              end;
  11897.         end;
  11898.      finally
  11899.         lst.free;
  11900.      end;
  11901. end;
  11902.  
  11903. procedure TWABD_ListBox.SetSize(NewSize: integer);
  11904. begin
  11905.    FSize := NewSize;
  11906.    FWidth := PIXELS_PER_CHAR_X * 15;
  11907.    FHeight := PIXELS_PER_CHAR_Y * FSize + 8;
  11908.    Changed;
  11909. end;
  11910.  
  11911. function TWABD_ListBox.Object_To_Control(AOwner: TWinControl): TControl;
  11912. var
  11913.    nlb   : TListBox;
  11914. begin
  11915.    nlb := TListBox.Create(AOwner);
  11916.    nlb.Parent     := AOwner;
  11917.    nlb.Name       := Name;
  11918.    nlb.Items.Text := Lines.Text;
  11919.    nlb.ItemIndex  := SelIndex;
  11920.    Result := nlb;
  11921. end;
  11922.  
  11923.  
  11924. // TWABD_RadioButton
  11925.  
  11926. constructor TWABD_RadioButton.Create(AOwner: TComponent);
  11927. begin
  11928.    inherited;
  11929.    FGroup:=0;
  11930. end;
  11931.  
  11932. destructor TWABD_RadioButton.Destroy;
  11933. begin
  11934.    inherited;
  11935. end;
  11936.  
  11937. function TWABD_RadioButton.Object_To_HTML: string;
  11938. var
  11939.    ck : string;
  11940.    s  : string;
  11941. begin
  11942.    if Checked then ck := 'CHECKED ' else ck := '';
  11943.    s := Format('<INPUT TYPE=RADIO NAME=%s_%d VALUE=%s %s',[WABD_RADIO_STR, Group, Name, ck]);
  11944.    s:=s+GenerateOptionHTML + GenerateEventScript;
  11945.    if FTitle<>'' then s:=s+' TITLE="'+FTitle+'"';
  11946.    s:=s+'>'+ASCII_To_HTML(Caption);
  11947.    Result:=s;
  11948. end;
  11949.  
  11950. procedure TWABD_RadioButton.HTML_To_Object(FormVal: string);
  11951. begin
  11952.    Checked := (FormVal<>'');
  11953. end;
  11954.  
  11955. procedure TWABD_RadioButton.SetName(const Value: TComponentName);
  11956. begin
  11957.    if (not (csLoading in ComponentState)) and ((FCaption='') or (FCaption=Name)) then Caption := Value;
  11958.    inherited;
  11959. end;
  11960.  
  11961. procedure TWABD_RadioButton.SetCaption(NewCaption: string);
  11962. begin
  11963.    FCaption := NewCaption;
  11964.    FWidth := PIXELS_PER_CHAR_X * Length(FCaption) + 15;
  11965.    FHeight := PIXELS_PER_CHAR_Y + 4;
  11966.    Changed;
  11967. end;
  11968.  
  11969. procedure TWABD_RadioButton.SetChecked(value:boolean);
  11970. begin
  11971.      // If setting check to true, remove checked from other radiobuttons in group.
  11972.      if (not (csLoading in ComponentState)) and value and assigned(parent) then
  11973.         parent.ForEachChild(ResetCheckedProc, pointer(FGroup));
  11974.      FCheck:=value;
  11975. end;
  11976.  
  11977. procedure TWABD_RadioButton.ResetCheckedProc(Child: TWABD_Object; var Stop: boolean; UserData: pointer);
  11978. begin
  11979.      if Child is TWABD_RadioButton then
  11980.      begin
  11981.           if integer(UserData) = (Child as TWABD_RadioButton).Group then (Child as TWABD_RadioButton).FCheck:=false;
  11982.      end;
  11983. end;
  11984.  
  11985. function TWABD_RadioButton.Object_To_Control(AOwner: TWinControl): TControl;
  11986. var
  11987.    nrb : TRadioButton;
  11988. begin
  11989.    nrb := TRadioButton.Create(AOwner);
  11990.    nrb.Parent  := AOwner;
  11991.    nrb.Name    := Name;
  11992.    nrb.Caption := Caption;
  11993.    nrb.Checked := Checked;
  11994.    Result := nrb;
  11995. end;
  11996.  
  11997.  
  11998. // TWABD_CheckBox
  11999.  
  12000. constructor TWABD_CheckBox.Create(AOwner:TComponent);
  12001. begin
  12002.    inherited;
  12003. end;
  12004.  
  12005. destructor TWABD_CheckBox.Destroy;
  12006. begin
  12007.    inherited;
  12008. end;
  12009.  
  12010. function TWABD_CheckBox.Object_To_HTML: string;
  12011. var
  12012.    ck : string;
  12013.    s : string;
  12014. begin
  12015.    if Checked then ck := 'CHECKED ' else ck := '';
  12016.    s := '<INPUT TYPE=CHECKBOX NAME='+Name+' '+ck+' VALUE='+Name;
  12017.    s:=s+GenerateOptionHTML + GenerateEventScript;
  12018.    if FTitle<>'' then s:=s+' TITLE="'+FTitle+'"';
  12019.    s:=s+'>'+ASCII_To_HTML(Caption);
  12020.    Result:=s;
  12021. end;
  12022.  
  12023. function TWABD_CheckBox.Object_To_WML: string;
  12024. var
  12025.    s : string;
  12026.    ck : string;
  12027. begin
  12028.    if Checked then ck:='1' else ck:='2';
  12029.    s := Caption+'<select name="'+Name+'" iname="i'+Name+'" ivalue="'+ck+'"';
  12030.    if FTitle<>'' then s:=s+' title="'+FTitle+'"';
  12031.    s:=s+'>'+CR;
  12032.    s:=s+'<option value="'+Name+'">X</option>'+CR+
  12033.         '<option value="_N">-</option>'+CR;
  12034.    s:=s+'</select>';
  12035.    Result:=s;
  12036. end;
  12037.  
  12038. function  TWABD_CheckBox.Object_To_WML_Postfield: string;
  12039. begin
  12040.      Result:='<postfield name="'+Name+'" value="$('+Name+')"/>'+CR;
  12041. end;
  12042.  
  12043. procedure TWABD_CheckBox.HTML_To_Object(FormVal: string);
  12044. begin
  12045.      if FormVal=Name then Checked := true;
  12046. end;
  12047.  
  12048. procedure TWABD_CheckBox.SetName(const Value: TComponentName);
  12049. begin
  12050.    if (not (csLoading in ComponentState)) and (FCaption = '') then Caption := Value;
  12051.    inherited;
  12052. end;
  12053.  
  12054. procedure TWABD_CheckBox.SetChecked(Check:boolean);
  12055. begin
  12056.    FCheck:=Check;
  12057. end;
  12058.  
  12059. procedure TWABD_CheckBox.SetCaption(NewCaption: string);
  12060. begin
  12061.    FCaption := NewCaption;
  12062.    FWidth := PIXELS_PER_CHAR_X * Length(FCaption) + 15;
  12063.    FHeight := PIXELS_PER_CHAR_Y + 6;
  12064.    Changed;
  12065. end;
  12066.  
  12067. function TWABD_CheckBox.Object_To_Control(AOwner: TWinControl): TControl;
  12068. var
  12069.    nck : TCheckBox;
  12070. begin
  12071.    nck := TCheckBox.Create(AOwner);
  12072.    nck.Parent  := AOwner;
  12073.    nck.Name    := Name;
  12074.    nck.Caption := Caption;
  12075.    nck.Checked := Checked;
  12076.    Result := nck;
  12077. end;
  12078.  
  12079. initialization
  12080.   Randomize;
  12081.  
  12082. end.
  12083.