From 0e067e75b107acfd09ddee63a10f3bd41fe6a797 Mon Sep 17 00:00:00 2001 From: Tristan Marlow Date: Wed, 17 Feb 2016 12:05:46 +0800 Subject: [PATCH 01/15] Version 14.71.0 - 17.02.2016 - by littleearth ============================================================= * Delphi Seattle support [^] EWB_jedi.inc (compiler directives) * IDE crash if EWBEnableFocusControl is set to false. * Interface reference leak changes in Seattle - https://marc.durdin.net/2012/07/understanding-and-correcting-interface-reference-leaks-in-delphis-vcl-olectrls-pas/ --- ChangeLog.txt | 12 + README.markdown | 17 + Source/AppWebUpdater.pas | 2 +- Source/Browse4Folder.pas | 2 +- Source/EWB.IEConst.pas | 1094 ++++++++++ Source/EWBMouseHook.pas | 4 +- Source/EWB_jedi.inc | 436 +++- Source/EditDesigner.pas | 4 +- Source/EmbeddedWB.pas | 4 +- Source/EwbAcc.pas | 2 +- Source/EwbBehaviorsComp.pas | 2 +- Source/EwbControlComponent.pas | 276 +-- Source/EwbCore.pas | 1115 +++++----- Source/EwbCoreTools.pas | 2 +- Source/EwbDDE.pas | 5 +- Source/EwbDisableMouseWheelFix.pas | 2 +- Source/EwbEditors.pas | 6 +- Source/EwbEventsComp.pas | 4 +- Source/EwbFocusControl.pas | 154 +- Source/EwbReg.pas | 154 +- Source/EwbTools.pas | 2080 +++++++++--------- Source/EwbUrl.pas | 4 +- Source/ExportFavorites.pas | 2 +- Source/FavoritesTree.pas | 2 +- Source/FileExtAssociate.pas | 2 +- Source/IEAddress.pas | 10 +- Source/IECache.pas | 2 +- Source/IEDownload.pas | 3182 ++++++++++++++-------------- Source/IEDownloadAcc.pas | 2 +- Source/IEDownloadTools.pas | 2 +- Source/IEGuid.pas | 2 +- Source/IEParser.pas | 2 +- Source/IETravelLog.pas | 2 +- Source/ImportFavorites.pas | 2 +- Source/MenuContext.pas | 4 + Source/RichEditBrowser.pas | 1397 ++++++------ Source/SHDocVw_EWB.pas | 4 +- Source/SecurityManager.pas | 2 +- Source/SendMail_For_Ewb.pas | 36 +- Source/UI_Less.pas | 2 +- 40 files changed, 5959 insertions(+), 4079 deletions(-) create mode 100644 README.markdown create mode 100644 Source/EWB.IEConst.pas diff --git a/ChangeLog.txt b/ChangeLog.txt index d83ab47..b602cc6 100644 --- a/ChangeLog.txt +++ b/ChangeLog.txt @@ -8,6 +8,18 @@ EmbeddedWB Component Pack [%] Fixed [^] Improved/Updated +============================================================= +Version 14.71.0 - 17.02.2016 - by littleearth +============================================================= + +* Delphi Seattle support + [^] EWB_jedi.inc (compiler directives) + +* IDE crash if EWBEnableFocusControl is set to false. + +* Interface reference leak changes in Seattle + - https://marc.durdin.net/2012/07/understanding-and-correcting-interface-reference-leaks-in-delphis-vcl-olectrls-pas/ + ============================================================= Version 14.70.0 - 02.10.2010 - by smot ============================================================= diff --git a/README.markdown b/README.markdown new file mode 100644 index 0000000..3ad066c --- /dev/null +++ b/README.markdown @@ -0,0 +1,17 @@ +EmbeddedWB Component Pack +====================== +EWB is a freeware components package for Borland Delphi 5 to Seattle. +It allow you to create a Web Browser, Chat Client, web updater, Html/Xml Editors and more. + +Orignally developed by: bsalsa productions + +Please read the credits file to find "who did what”. +If you use this componets or any code part you do it on your own responsibility. +There is no guaranty what so ever for none. +Please credit the creators and the contributors of the components. + +Check the mega demo for demonstration of the package capabilities. + +We do need beta testers and developers and someone that can write a help file. + +If you find the component useful, please use GitHub to improve / fix. diff --git a/Source/AppWebUpdater.pas b/Source/AppWebUpdater.pas index 9669c43..16a2bf9 100644 --- a/Source/AppWebUpdater.pas +++ b/Source/AppWebUpdater.pas @@ -41,7 +41,7 @@ interface {$I EWB.inc} uses - Controls, ActiveX, Windows, SysUtils, Classes, LibXmlParser, ComCtrls, UrlMon; + Controls, ActiveX, Windows, SysUtils, Classes, EwbLibXmlParser, ComCtrls, UrlMon; type TErrorMessage = (emCreateSubBackup, emFileCopyError, emXmlError, emFileNotExist, emCreateFolder, diff --git a/Source/Browse4Folder.pas b/Source/Browse4Folder.pas index 3e0c991..b8290e9 100644 --- a/Source/Browse4Folder.pas +++ b/Source/Browse4Folder.pas @@ -92,7 +92,7 @@ TBrowse4Folder = class(TComponent) implementation uses - TypInfo, Registry, Forms, ComObj; + TypInfo, System.Win.Registry, Forms; var lg_StartFolder: string; diff --git a/Source/EWB.IEConst.pas b/Source/EWB.IEConst.pas new file mode 100644 index 0000000..741d0b3 --- /dev/null +++ b/Source/EWB.IEConst.pas @@ -0,0 +1,1094 @@ +//************************************************************** +// * +// IE-Const * +// For Delphi * +// * +// Contributions: * +// Per Linds Larsen * +// Eran Bodankin (bsalsa) bsalsa@gmail.com * +// Thomas Stutz (smot) * +// * +// Updated versions: * +// http://www.bsalsa.com * +//************************************************************** + +{*******************************************************************************} +{LICENSE: +THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, +EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED +WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. +YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE +AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE +AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE +OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED +OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, +INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR +OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, +AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY +DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. + +You may use, change or modify the component under 4 conditions: +1. In your website, add a link to "http://www.bsalsa.com" +2. In your application, add credits to "Embedded Web Browser" +3. Mail me (bsalsa@gmail.com) any code change in the unit + for the benefit of the other users. +4. Please, consider donation in our web site! +{*******************************************************************************} + +unit EWB.IEConst; + +interface + +{$I EWB.inc} + + +// The reason for this file is that some constants are +// missing in previous delphi versions. + +const + ACO_NONE = 0; + ACO_AUTOSUGGEST = $1; + ACO_AUTOAPPEND = $2; + ACO_SEARCH = $4; + ACO_FILTERPREFIXES = $8; + ACO_USETAB = $10; + ACO_UPDOWNKEYDROPSLIST = $20; + ACO_RTLREADING = $40; + ACLO_NONE = 0; {don't enumerate anything} + ACLO_CURRENTDIR = 1; {enumerate current directory} + ACLO_MYCOMPUTER = 2; {enumerate MyComputer} + ACLO_DESKTOP = 4; {enumerate Desktop Folder} + ACLO_FAVORITES = 8; {enumerate Favorites Folder} + ACLO_FILESYSONLY = 16; {enumerate only the file system} + BINDSTATUS_FINDINGRESOURCE = 1; + BINDSTATUS_CONNECTING = 2; + BINDSTATUS_REDIRECTING = 3; + BINDSTATUS_BEGINDOWNLOADDATA = 4; + BINDSTATUS_DOWNLOADINGDATA = 5; + BINDSTATUS_ENDDOWNLOADDATA = 6; + BINDSTATUS_BEGINDOWNLOADCOMPONENTS = 7; + BINDSTATUS_INSTALLINGCOMPONENTS = 8; + BINDSTATUS_ENDDOWNLOADCOMPONENTS = 9; + BINDSTATUS_USINGCACHEDCOPY = 10; + BINDSTATUS_SENDINGREQUEST = 11; + BINDSTATUS_CLASSIDAVAILABLE = 12; + BINDSTATUS_MIMETYPEAVAILABLE = 13; + BINDSTATUS_CACHEFILENAMEAVAILABLE = 14; + BINDSTATUS_BEGINSYNCOPERATION = 15; + BINDSTATUS_ENDSYNCOPERATION = 16; + BINDSTATUS_BEGINUPLOADDATA = 17; + BINDSTATUS_UPLOADINGDATA = 18; + BINDSTATUS_ENDUPLOADINGDATA = 19; + BINDSTATUS_PROTOCOLCLASSID = 20; + BINDSTATUS_ENCODING = 21; + BINDSTATUS_VERFIEDMIMETYPEAVAILABLE = 22; + BINDSTATUS_CLASSINSTALLLOCATION = 23; + BINDSTATUS_DECODING = 24; + BINDSTATUS_LOADINGMIMEHANDLER = 25; + BINDSTATUS_CONTENTDISPOSITIONATTACH = 26; + BINDSTATUS_FILTERREPORTMIMETYPE = 27; + BINDSTATUS_CLSIDCANINSTANTIATE = 28; + BINDSTATUS_IUNKNOWNAVAILABLE = 29; + BINDSTATUS_DIRECTBIND = 30; + BINDSTATUS_RAWMIMETYPE = 31; + BINDSTATUS_PROXYDETECTING = 32; + BINDSTATUS_ACCEPTRANGES = 33; + BINDSTATUS_COOKIE_SENT = 34; + BINDSTATUS_COMPACT_POLICY_RECEIVED = 35; + BINDSTATUS_COOKIE_SUPPRESSED = 36; + BINDSTATUS_COOKIE_STATE_UNKNOWN = 37; + BINDSTATUS_COOKIE_STATE_ACCEPT = 38; + BINDSTATUS_COOKIE_STATE_REJECT = 39; + BINDSTATUS_COOKIE_STATE_PROMPT = 40; + BINDSTATUS_COOKIE_STATE_LEASH = 41; + BINDSTATUS_COOKIE_STATE_DOWNGRADE = 42; + BINDSTATUS_POLICY_HREF = 43; + BINDSTATUS_P3P_HEADER = 44; + BINDSTATUS_SESSION_COOKIE_RECEIVED = 45; + BINDSTATUS_PERSISTENT_COOKIE_RECEIVED = 46; + BINDSTATUS_SESSION_COOKIES_ALLOWED = 47; + BINDSTATUS_CACHECONTROL = 48; + BINDSTATUS_CONTENTDISPOSITIONFILENAME = 49; + BINDSTATUS_MIMETEXTPLAINMISMATCH = 50; + BINDSTATUS_PUBLISHERAVAILABLE = 51; + BINDSTATUS_DISPLAYNAMEAVAILABLE = 52; + BINDSTATUS_SSLUX_NAVBLOCKED = 53; + BINDSTATUS_SERVER_MIMETYPEAVAILABLE = 54; + BINDSTATUS_SNIFFED_CLASSIDAVAILABLE = 55; + BINDSTATUS_64BIT_PROGRESS = 56; + VER_NUM = ' 14.70.0'; + _MaskedChars: string = 'ACFNP'; + ADDRESS_NOT_VALID = 2147221020; //** + ASS_MESS = 'Please assign a WebBrowser before using this feature.'; + CACHEGROUP_ATTRIBUTE_BASIC = $00000001; + CACHEGROUP_ATTRIBUTE_FLAG = $00000002; + CACHEGROUP_ATTRIBUTE_GET_ALL = $FFFFFFFF; + CACHEGROUP_ATTRIBUTE_GROUPNAME = $00000010; + CACHEGROUP_ATTRIBUTE_QUOTA = $00000008; + CACHEGROUP_ATTRIBUTE_STORAGE = $00000020; + CACHEGROUP_ATTRIBUTE_TYPE = $00000004; + CACHEGROUP_FLAG_FLUSHURL_ONDELETE = $00000002; + CACHEGROUP_FLAG_GIDONLY = $00000004; + CACHEGROUP_FLAG_NONPURGEABLE = $00000001; + CACHEGROUP_SEARCH_ALL = $00000000; + CACHEGROUP_SEARCH_BYURL = $00000001; + CACHEGROUP_TYPE_INVALID = $00000001; + CACHEGROUP_READWRITE_MASK = CACHEGROUP_ATTRIBUTE_TYPE or + CACHEGROUP_ATTRIBUTE_QUOTA or CACHEGROUP_ATTRIBUTE_GROUPNAME or + CACHEGROUP_ATTRIBUTE_STORAGE; + CAddMenuExtensionsCommandID = 53; + CContextMenuID = 24641; + CGetMimeSubMenuCommandID = 27; + CIP_NEED_REBOOT_UI_PERMISSION = 9; + comctl32 = 'comctl32.dll'; + CONTEXT_MENU_ANCHOR = 5; + CONTEXT_MENU_CONTROL = 2; + CONTEXT_MENU_DEBUG = 9; + CONTEXT_MENU_DEFAULT = 0; + CONTEXT_MENU_HSCROLL = 11; + CONTEXT_MENU_IMAGE = 1; + CONTEXT_MENU_IMGART = 8; + CONTEXT_MENU_IMGDYNSRC = 7; + CONTEXT_MENU_TABLE = 3; + CONTEXT_MENU_TEXTSELECT = 4; + CONTEXT_MENU_UNKNOWN = 6; + CONTEXT_MENU_VSCROLL = 10; + CP_SYMBOL = 42; + CP_THREAD_ACP = 3; + DISPID_AMBIENT_DLCONTROL = (-5512); + DISPID_AMBIENT_USERAGENT = (-5513); + DOCHOSTUIDBLCLK_DEFAULT = 0; + DOCHOSTUIDBLCLK_SHOWCODE = 2; + DOCHOSTUIDBLCLK_SHOWPROPERTIES = 1; + DOCHOSTUIFLAG_ACTIVATE_CLIENTHIT_ONLY = $0200; + DOCHOSTUIFLAG_CODEPAGELINKEDFONTS = $0800; + DOCHOSTUIFLAG_DIALOG = $0001; + DOCHOSTUIFLAG_DISABLE_HELP_MENU = $0002; + DOCHOSTUIFLAG_DISABLE_OFFSCREEN = $0040; + DOCHOSTUIFLAG_DISABLE_SCRIPT_INACTIVE = $0010; + DOCHOSTUIFLAG_DIV_BLOCKDEFAULT = $0100; + DOCHOSTUIFLAG_ENABLE_FORMS_AUTOCOMPLETE = $4000; + DOCHOSTUIFLAG_ENABLE_INPLACE_NAVIGATION = $10000; + DOCHOSTUIFLAG_FLAT_SCROLLBAR = $0080; + DOCHOSTUIFLAG_IME_ENABLE_RECONVERSION = $20000; + DOCHOSTUIFLAG_NO3DBORDER = $0004; + DOCHOSTUIFLAG_OPENNEWWIN = $0020; + DOCHOSTUIFLAG_OVERRIDEBEHAVIORFACTORY = $0400; + DOCHOSTUIFLAG_SCROLL_NO = $0008; + DOCHOSTUIFLAG_URL_ENCODING_DISABLE_UTF8 = $1000; + DOCHOSTUIFLAG_URL_ENCODING_ENABLE_UTF8 = $2000; + DOCHOSTUITYPE_AUTHOR = 1; + DOCHOSTUITYPE_BROWSE = 0; + ERROR_INTERNET_FORTEZZA_LOGIN_NEEDED = 12054; + INTERNET_ERROR_BASE = 12000; + ERROR_INTERNET_OUT_OF_HANDLES = INTERNET_ERROR_BASE + 1; + ERROR_INTERNET_TIMEOUT = INTERNET_ERROR_BASE + 2; + ERROR_INTERNET_EXTENDED_ERROR = INTERNET_ERROR_BASE + 3; + ERROR_INTERNET_INTERNAL_ERROR = INTERNET_ERROR_BASE + 4; + ERROR_INTERNET_INVALID_URL = INTERNET_ERROR_BASE + 5; + ERROR_INTERNET_UNRECOGNIZED_SCHEME = INTERNET_ERROR_BASE + 6; + ERROR_INTERNET_NAME_NOT_RESOLVED = INTERNET_ERROR_BASE + 7; + ERROR_INTERNET_PROTOCOL_NOT_FOUND = INTERNET_ERROR_BASE + 8; + ERROR_INTERNET_INVALID_OPTION = INTERNET_ERROR_BASE + 9; + ERROR_INTERNET_BAD_OPTION_LENGTH = INTERNET_ERROR_BASE + 10; + ERROR_INTERNET_OPTION_NOT_SETTABLE = INTERNET_ERROR_BASE + 11; + ERROR_INTERNET_SHUTDOWN = INTERNET_ERROR_BASE + 12; + ERROR_INTERNET_INCORRECT_USER_NAME = INTERNET_ERROR_BASE + 13; + ERROR_INTERNET_INCORRECT_PASSWORD = INTERNET_ERROR_BASE + 14; + ERROR_INTERNET_LOGIN_FAILURE = INTERNET_ERROR_BASE + 15; + ERROR_INTERNET_INVALID_OPERATION = INTERNET_ERROR_BASE + 16; + ERROR_INTERNET_OPERATION_CANCELLED = INTERNET_ERROR_BASE + 17; + ERROR_INTERNET_INCORRECT_HANDLE_TYPE = INTERNET_ERROR_BASE + 18; + ERROR_INTERNET_INCORRECT_HANDLE_STATE = INTERNET_ERROR_BASE + 19; + ERROR_INTERNET_NOT_PROXY_REQUEST = INTERNET_ERROR_BASE + 20; + ERROR_INTERNET_REGISTRY_VALUE_NOT_FOUND = INTERNET_ERROR_BASE + 21; + ERROR_INTERNET_BAD_REGISTRY_PARAMETER = INTERNET_ERROR_BASE + 22; + ERROR_INTERNET_NO_DIRECT_ACCESS = INTERNET_ERROR_BASE + 23; + ERROR_INTERNET_NO_CONTEXT = INTERNET_ERROR_BASE + 24; + ERROR_INTERNET_NO_CALLBACK = INTERNET_ERROR_BASE + 25; + ERROR_INTERNET_REQUEST_PENDING = INTERNET_ERROR_BASE + 26; + ERROR_INTERNET_INCORRECT_FORMAT = INTERNET_ERROR_BASE + 27; + ERROR_INTERNET_ITEM_NOT_FOUND = INTERNET_ERROR_BASE + 28; + ERROR_INTERNET_CANNOT_CONNECT = INTERNET_ERROR_BASE + 29; + ERROR_INTERNET_CONNECTION_ABORTED = INTERNET_ERROR_BASE + 30; + ERROR_INTERNET_CONNECTION_RESET = INTERNET_ERROR_BASE + 31; + ERROR_INTERNET_FORCE_RETRY = INTERNET_ERROR_BASE + 32; + ERROR_INTERNET_INVALID_PROXY_REQUEST = INTERNET_ERROR_BASE + 33; + ERROR_INTERNET_HANDLE_EXISTS = INTERNET_ERROR_BASE + 36; + ERROR_INTERNET_SEC_CERT_DATE_INVALID = INTERNET_ERROR_BASE + 37; + ERROR_INTERNET_SEC_CERT_CN_INVALID = INTERNET_ERROR_BASE + 38; + ERROR_INTERNET_HTTP_TO_HTTPS_ON_REDIR = INTERNET_ERROR_BASE + 39; + ERROR_INTERNET_HTTPS_TO_HTTP_ON_REDIR = INTERNET_ERROR_BASE + 40; + ERROR_INTERNET_MIXED_SECURITY = INTERNET_ERROR_BASE + 41; + ERROR_INTERNET_CHG_POST_IS_NON_SECURE = INTERNET_ERROR_BASE + 42; + ERROR_INTERNET_POST_IS_NON_SECURE = INTERNET_ERROR_BASE + 43; + ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED = INTERNET_ERROR_BASE + 44; + ERROR_INTERNET_INVALID_CA = INTERNET_ERROR_BASE + 45; + ERROR_INTERNET_CLIENT_AUTH_NOT_SETUP = INTERNET_ERROR_BASE + 46; + ERROR_INTERNET_ASYNC_THREAD_FAILED = INTERNET_ERROR_BASE + 47; + ERROR_INTERNET_REDIRECT_SCHEME_CHANGE = INTERNET_ERROR_BASE + 48; + ERROR_INTERNET_DIALOG_PENDING = INTERNET_ERROR_BASE + 49; + ERROR_INTERNET_RETRY_DIALOG = INTERNET_ERROR_BASE + 50; + ERROR_INTERNET_HTTPS_HTTP_SUBMIT_REDIR = INTERNET_ERROR_BASE + 52; + ERROR_INTERNET_INSERT_CDROM = INTERNET_ERROR_BASE + 53; + E_PENDING = $8000000A; + IED_INFO = ' IEDownload http://bsalsa.com/'; + EWB_INFO = ' EmbeddedWB http://bsalsa.com/'; + EXPLORE_COMMAND = 2; + FEATURE_FROM_PROCESS = $00000002; + FEATURE_FROM_REGISTRY = $00000004; + FEATURE_FROM_THREAD = $00000001; + FEATURE_FROM_THREAD_INTERNET = $00000040; + FEATURE_FROM_THREAD_INTRANET = $00000010; + FEATURE_FROM_THREAD_LOCALMACHINE = $00000008; + FEATURE_FROM_THREAD_RESTRICTED = $00000080; + FEATURE_FROM_THREAD_TRUSTED = $00000020; + FIND_COMMAND = 3; + Free_Index = 73; + GROUP_OWNER_STORAGE_SIZE = 4; + GROUPNAME_MAX_LENGTH = 120; + hhctrl = 'hhctrl.ocx'; + HoursPerDay = 24; + HTMLID_FIND = 1; + HTMLID_OPTIONS = 3; + HTMLID_VIEWSOURCE = 2; + HTTP_QUERY_FLAG_COALESCE = $10000000; + HTTP_QUERY_FLAG_NUMBER = $20000000; + HTTP_QUERY_FLAG_REQUEST_HEADERS = $80000000; + HTTP_QUERY_FLAG_SYSTEMTIME = $40000000; + HTTP_QUERY_MODIFIER_FLAGS_MASK = (HTTP_QUERY_FLAG_REQUEST_HEADERS or + HTTP_QUERY_FLAG_SYSTEMTIME or HTTP_QUERY_FLAG_NUMBER or + HTTP_QUERY_FLAG_COALESCE); + ID_EDITMODE = 32801; + ID_IE_CONTEXTMENU_ADDFAV = 2261; + ID_IE_CONTEXTMENU_NEWWINDOW = 2137; + ID_IE_CONTEXTMENU_REFRESH = 6042; + ID_IE_F5_REFRESH = 6041; // added by smot + ID_IE_FILE_ADDLOCAL = 377; + ID_IE_FILE_ADDTRUST = 376; + ID_IE_FILE_IMPORTEXPORT = 374; + ID_IE_FILE_NEWCALL = 395; + ID_IE_FILE_NEWMAIL = 279; + ID_IE_FILE_NEWPEOPLE = 390; + ID_IE_FILE_NEWPUBLISHINFO = 387; + ID_IE_FILE_NEWWINDOW = 275; + ID_IE_FILE_PAGESETUP = 259; + ID_IE_FILE_PRINT = 260; + ID_IE_FILE_PRINTPREVIEW = 277; + ID_IE_FILE_SENDDESKTOPSHORTCUT = 284; + ID_IE_FILE_SENDLINK = 283; + ID_IE_FILE_SENDPAGE = 282; + ID_IE_HELP_BESTPAGE = 346; + ID_IE_HELP_ENHANCEDSECURITY = 375; + ID_IE_HELP_FAQ = 343; + ID_IE_HELP_FEEDBACK = 345; + ID_IE_HELP_FREESTUFF = 341; + ID_IE_HELP_HELPINDEX = 337; + ID_IE_HELP_MSHOME = 348; + ID_IE_HELP_NETSCAPEUSER = 351; + ID_IE_HELP_ONLINESUPPORT = 344; + ID_IE_HELP_PRODUCTUPDATE = 342; + ID_IE_HELP_SEARCHWEB = 347; + ID_IE_HELP_STARTPAGE = 350; + ID_IE_HELP_VERSIONINFO = 336; + ID_IE_HELP_VISITINTERNET = 349; + ID_IE_HELP_WEBTUTORIAL = 338; + IDM_1D = 2170; + IDM_ADDFAVORITES = 2261; + IDM_ADDRESS = 2189; + IDM_ADDTOFAVOURITES = 2261; + IDM_ALIGNBOTTOM = 1; + IDM_ALIGNHORIZONTALCENTERS = 2; + IDM_ALIGNLEFT = 3; + IDM_ALIGNRIGHT = 4; + IDM_ALIGNTOGRID = 5; + IDM_ALIGNTOP = 6; + IDM_ALIGNVERTICALCENTERS = 7; + IDM_APPLYHEADING1 = 2255; + IDM_APPLYHEADING2 = 2256; + IDM_APPLYHEADING3 = 2257; + IDM_APPLYNORMAL = 2254; + IDM_ARRANGEBOTTOM = 8; + IDM_ARRANGERIGHT = 9; + IDM_AUTODETECT = 2329; + IDM_BACK = 2282; + IDM_BACKCOLOR = 51; + IDM_BASELINEFONT1 = 2141; + IDM_BASELINEFONT3 = 2143; + IDM_BASELINEFONT4 = 2144; + IDM_BASELINEFONT5 = 2145; + IDM_BLINK = 2190; + IDM_BLOCKFMT = 2234; + IDM_BOLD = 52; + IDM_BOOKMARK = 2123; + IDM_BORDERCOLOR = 53; + IDM_BREAKATNEXT = 2311; + IDM_BRINGFORWARD = 10; + IDM_BRINGTOFRONT = 11; + IDM_BROWSEMODE = 2126; + IDM_BUTTON = 2167; + IDM_CANCEL = 89; + IDM_CAPTIONINSERT = 2203; + IDM_CELLINSERT = 2202; + IDM_CELLMERGE = 2204; + IDM_CELLPROPERTIES = 2211; + IDM_CELLSELECT = 2206; + IDM_CELLSPLIT = 2205; + IDM_CENTERALIGNPARA = 2250; + IDM_CENTERHORIZONTALLY = 12; + IDM_CENTERVERTICALLY = 13; + IDM_CHANGECASE = 2246; + IDM_CHANGEFONT = 2240; + IDM_CHANGEFONTSIZE = 2241; + IDM_CHECKBOX = 2163; + IDM_CHISELED = 64; + IDM_CLEARSELECTION = 2007; + IDM_CODE = 14; + IDM_COLUMNINSERT = 2213; + IDM_COLUMNSELECT = 2208; + IDM_COMMENT = 2173; + IDM_COMPOSESETTINGS = 2318; + IDM_CONTEXTMENU = 2280; + IDM_CONVERTOBJECT = 82; + IDM_COPY = 15; + IDM_COPYBACKGROUND = 2265; + IDM_COPYCONTENT = 2291; + IDM_COPYFORMAT = 2237; + IDM_COPYSHORTCUT = 2262; + IDM_CREATELINK = 2290; + IDM_CREATESHORTCUT = 2266; + IDM_CUSTOMCONTROL = 83; + IDM_CUSTOMIZEITEM = 84; + IDM_CUT = 16; + IDM_DECFONTSIZE = 2243; + IDM_DECFONTSIZE1PT = 2245; + IDM_DELETE = 17; + IDM_DELETEWORD = 92; + IDM_DIV = 2191; + IDM_DOCPROPERTIES = 2260; + IDM_DROPDOWNBOX = 2165; + IDM_DYNSRCPLAY = 2271; + IDM_DYNSRCSTOP = 2272; + IDM_EDITMODE = 2127; + IDM_EDITSOURCE = 2122; + IDM_ENABLE_INTERACTION = 2302; + IDM_ENCODING = 2292; + IDM_ETCHED = 65; + IDM_FILE = 2172; + IDM_FIND = 67; + IDM_FLAT = 54; + IDM_FOLLOW_ANCHOR = 2008; + IDM_FOLLOWLINKC = 2136; + IDM_FOLLOWLINKN = 2137; + IDM_FONT = 90; + IDM_FONTNAME = 18; + IDM_FONTSIZE = 19; + IDM_FORECOLOR = 55; + IDM_FORM = 2181; + IDM_FORMATMARK = 2132; + IDM_FORWARD = 2283; + IDM_GETBLOCKFMTS = 2233; + IDM_GETBYTESDOWNLOADED = 2331; + IDM_GETZOOM = 68; + IDM_GOBACKWARD = 2282; + IDM_GOFORWARD = 2283; + IDM_GOTO = 2239; + IDM_GROUP = 20; + IDM_HELP_ABOUT = 2221; + IDM_HELP_CONTENT = 2220; + IDM_HELP_README = 2222; + IDM_HORIZONTALLINE = 2150; + IDM_HORIZSPACECONCATENATE = 21; + IDM_HORIZSPACEDECREASE = 22; + IDM_HORIZSPACEINCREASE = 23; + IDM_HORIZSPACEMAKEEQUAL = 24; + IDM_HTMLCONTAIN = 2159; + IDM_HTMLEDITMODE = 2316; + IDM_HTMLSOURCE = 2157; + IDM_HYPERLINK = 2124; + IDM_IFRAME = 2158; + IDM_IMAGE = 2168; + IDM_IMAGEMAP = 2171; + IDM_IMGARTPLAY = 2274; + IDM_IMGARTREWIND = 2276; + IDM_IMGARTSTOP = 2275; + IDM_IMPORT = 86; + IDM_INCFONTSIZE = 2242; + IDM_INCFONTSIZE1PT = 2244; + IDM_INDENT = 2186; + IDM_INSERTOBJECT = 25; + IDM_INSFIELDSET = 2119; + IDM_INSINPUTBUTTON = 2115; + IDM_INSINPUTHIDDEN = 2312; + IDM_INSINPUTIMAGE = 2114; + IDM_INSINPUTPASSWORD = 2313; + IDM_INSINPUTRESET = 2116; + IDM_INSINPUTSUBMIT = 2117; + IDM_INSINPUTUPLOAD = 2118; + IDM_ITALIC = 56; + IDM_JAVAAPPLET = 2175; + IDM_JUSTIFYCENTER = 57; + IDM_JUSTIFYFULL = 50; + IDM_JUSTIFYGENERAL = 58; + IDM_JUSTIFYLEFT = 59; + IDM_JUSTIFYRIGHT = 60; + IDM_LANGUAGE = 2292; + IDM_LAUNCHDEBUGGER = 2310; + IDM_LEFTALIGNPARA = 2251; + IDM_LINEBREAKBOTH = 2154; + IDM_LINEBREAKLEFT = 2152; + IDM_LINEBREAKNORMAL = 2151; + IDM_LINEBREAKRIGHT = 2153; + IDM_LIST = 2183; + IDM_LISTBOX = 2166; + IDM_MARQUEE = 2182; + IDM_MENUEXT_COUNT = 3733; + IDM_MENUEXT_FIRST__ = 3700; + IDM_MENUEXT_LAST__ = 3732; + IDM_MIMECSET__FIRST__ = 3609; + IDM_MIMECSET__LAST__ = 3640; + IDM_MOVE = 88; + IDM_MULTILEVELREDO = 30; + IDM_MULTILEVELUNDO = 44; + IDM_NEW = 2001; + IDM_NEWPAGE = 87; + IDM_NOACTIVATEDESIGNTIMECONTROLS = 2333; + IDM_NOACTIVATEJAVAAPPLETS = 2334; + IDM_NOACTIVATENORMALOLECONTROLS = 2332; + IDM_NONBREAK = 2155; + IDM_OBJECT = 2169; + IDM_OBJECTVERBLIST0 = 72; + IDM_OBJECTVERBLIST1 = 73; + IDM_OBJECTVERBLIST2 = 74; + IDM_OBJECTVERBLIST3 = 75; + IDM_OBJECTVERBLIST4 = 76; + IDM_OBJECTVERBLIST5 = 77; + IDM_OBJECTVERBLIST6 = 78; + IDM_OBJECTVERBLIST7 = 79; + IDM_OBJECTVERBLIST8 = 80; + IDM_OBJECTVERBLIST9 = 81; + IDM_OPEN = 2000; + IDM_OPENINNEWWINDOW = 2137; + IDM_OPENLINK = 2136; + IDM_OPTIONS = 2135; + IDM_ORDERLIST = 2184; + IDM_OUTDENT = 2187; + IDM_OVERWRITE = 2314; + IDM_PAGE = 2267; + IDM_PAGEBREAK = 2177; + IDM_PAGEINFO = 2231; + IDM_PAGESETUP = 2004; + IDM_PARAGRAPH = 2180; + IDM_PARSECOMPLETE = 2315; + IDM_PASTE = 26; + IDM_PASTEFORMAT = 2238; + IDM_PASTEINSERT = 2120; + IDM_PASTESPECIAL = 2006; + IDM_PERSISTSTREAMSYNC = 2341; + IDM_PLUGIN = 2176; + IDM_PREFORMATTED = 2188; + IDM_PRESTOP = 2284; + IDM_PRINT = 27; + IDM_PRINTPREVIEW = 2003; + IDM_PRINTQUERYJOBSPENDING = 2277; + IDM_PRINTTARGET = 2273; + IDM_PROPERTIES = 28; + IDM_RADIOBUTTON = 2164; + IDM_RAISED = 61; + IDM_RCINSERT = 2201; + IDM_REDO = 29; + IDM_REFRESH = 2300; + IDM_REGISTRYREFRESH = 2317; + IDM_REMOVEFORMAT = 2230; + IDM_REMOVEPARAFORMAT = 2253; + IDM_RENAME = 85; + IDM_REPLACE = 2121; + IDM_RIGHTALIGNPARA = 2252; + IDM_ROWINSERT = 2212; + IDM_ROWSELECT = 2207; + IDM_SAVE = 70; + IDM_SAVEAS = 71; + IDM_SAVEBACKGROUND = 2263; + IDM_SAVECOPYAS = 2002; + IDM_SAVEPICTURE = 2270; + IDM_SAVETARGET = 2268; + IDM_SCRIPT = 2174; + IDM_SCRIPTDEBUGGER = 2330; + IDM_SELECTALL = 31; + IDM_SENDBACKWARD = 32; + IDM_SENDTOBACK = 33; + IDM_SETASBACKGROUND = 2264; + IDM_SETASDESKTOPITEM = 2278; + IDM_SETDIRTY = 2342; + IDM_SETWALLPAPER = 2264; + IDM_SHADOWED = 66; + IDM_SHOWALIGNEDSITETAGS = 2321; + IDM_SHOWALLTAGS = 2320; + IDM_SHOWAREATAGS = 2325; + IDM_SHOWCOMMENTTAGS = 2324; + IDM_SHOWGRID = 69; + IDM_SHOWHIDE_CODE = 2235; + IDM_SHOWMISCTAGS = 2327; + IDM_SHOWPICTURE = 2269; + IDM_SHOWSCRIPTTAGS = 2322; + IDM_SHOWSPECIALCHAR = 2249; + IDM_SHOWSTYLETAGS = 2323; + IDM_SHOWTABLE = 34; + IDM_SHOWUNKNOWNTAGS = 2326; + IDM_SHOWWBRTAGS = 2340; + IDM_SHOWZEROBORDERATDESIGNTIME = 2328; + IDM_SIZETOCONTROL = 35; + IDM_SIZETOCONTROLHEIGHT = 36; + IDM_SIZETOCONTROLWIDTH = 37; + IDM_SIZETOFIT = 38; + IDM_SIZETOGRID = 39; + IDM_SNAPTOGRID = 40; + IDM_SPECIALCHAR = 2156; + IDM_SPELL = 2005; + IDM_STATUSBAR = 2131; + IDM_STOP = 2138; + IDM_STOPDOWNLOAD = 2301; + IDM_STRIKETHROUGH = 91; + IDM_SUBSCRIPT = 2247; + IDM_SUNKEN = 62; + IDM_SUPERSCRIPT = 2248; + IDM_TABLE = 2236; + IDM_TABLEINSERT = 2200; + IDM_TABLEPROPERTIES = 2210; + IDM_TABLESELECT = 2209; + IDM_TABORDER = 41; + IDM_TELETYPE = 2232; + IDM_TEXTAREA = 2162; + IDM_TEXTBOX = 2161; + IDM_TEXTONLY = 2133; + IDM_TOOLBARS = 2130; + IDM_TOOLBOX = 42; + IDM_TRIED_CONSTRAIN = 12; //[in,VT_BOOL] + IDM_TRIED_DELETECELLS = 21; + IDM_TRIED_DELETECOLS = 17; + IDM_TRIED_DELETEROWS = 16; + IDM_TRIED_INSERTCELL = 20; + IDM_TRIED_INSERTCOL = 15; + IDM_TRIED_INSERTROW = 14; + IDM_TRIED_INSERTTABLE = 22; //[in, VT_ARRAY] + IDM_TRIED_IS_1D_ELEMENT = 0; //[out,VT_BOOL] + IDM_TRIED_IS_2D_ELEMENT = 1; //[out,VT_BOOL] + IDM_TRIED_LAST_CID = IDM_TRIED_INSERTTABLE; //WARNING WARNING WARNING!!! Don't forget to modify IDM_TRIED_LAST_CID + IDM_TRIED_LOCK_ELEMENT = 5; + IDM_TRIED_MAKE_ABSOLUTE = 4; + IDM_TRIED_MERGECELLS = 18; + IDM_TRIED_NUDGE_ELEMENT = 2; //[in,VT_BYREF VARIANT.byref=LPPOINT] + IDM_TRIED_SEND_BACKWARD = 8; + IDM_TRIED_SEND_BEHIND_1D = 10; + IDM_TRIED_SEND_FORWARD = 9; + IDM_TRIED_SEND_FRONT_1D = 11; + IDM_TRIED_SEND_TO_BACK = 6; + IDM_TRIED_SEND_TO_FRONT = 7; + IDM_TRIED_SET_2D_DROP_MODE = 13; //[in,VT_BOOL] + IDM_TRIED_SET_ALIGNMENT = 3; //[in,VT_BYREF VARIANT.byref=LPPOINT] + IDM_TRIED_SPLITCELL = 19; + IDM_UNBOOKMARK = 2128; + IDM_UNDERLINE = 63; + IDM_UNDO = 43; + IDM_UNGROUP = 45; + IDM_UNKNOWN = 0; + IDM_UNLINK = 2125; + IDM_UNORDERLIST = 2185; + IDM_VERTSPACECONCATENATE = 46; + IDM_VERTSPACEDECREASE = 47; + IDM_VERTSPACEINCREASE = 48; + IDM_VERTSPACEMAKEEQUAL = 49; + IDM_VIEWSOURCE = 2139; + IDM_ZOOMPERCENT = 50; + IDM_ZOOMPOPUP = 2140; + IE_PPREVIEWCLASS = 'Internet Explorer_TridentDlgFrame'; + InchToMetric = 25.4; + INET_E_AUTHENTICATION_REQUIRED = -2146697207; + INET_E_CANNOT_CONNECT = -2146697212; + INET_E_CANNOT_INSTANTIATE_OBJECT = -2146697200; + INET_E_CANNOT_LOAD_DATA = -2146697201; + INET_E_CANNOT_LOCK_REQUEST = -2146697194; + INET_E_CANNOT_REPLACE_SFP_FILE = -2146697448; + INET_E_CODE_DOWNLOAD_DECLINED = -2146697960; + INET_E_CONNECTION_TIMEOUT = -2146697205; //** + INET_E_DATA_NOT_AVAILABLE = -2146697209; + INET_E_DOWNLOAD_FAILURE = -2146697208; + INET_E_INVALID_REQUEST = -2146697204; + INET_E_INVALID_URL = -2146697214; + INET_E_NO_SESSION = -2146697213; + INET_E_NO_VALID_MEDIA = -2146697206; + INET_E_OBJECT_NOT_FOUND = -2146697210; + INET_E_REDIRECT_FAILED = -2146697196; + INET_E_REDIRECT_TO_DIR = -2146697195; + INET_E_RESOURCE_NOT_FOUND = -2146697211; //** + INET_E_RESULT_DISPATCHED = -2146697704; + INET_E_SECURITY_PROBLEM = -2146697202; //** + INET_E_TERMINATED_BIND = -2146697192; + INET_E_UNKNOWN_PROTOCOL = -2146697203; + INET_E_USE_EXTEND_BINDING = -2146697193; + INTERNET_OPTION_PER_CONNECTION_OPTION = 75; + INTERNET_OPTION_REFRESH = 37; + INTERNET_OPTION_SETTINGS_CHANGED = 39; + INTERNET_PER_CONN_AUTOCONFIG_URL = 4; + INTERNET_PER_CONN_AUTODISCOVERY_FLAGS = 5; + INTERNET_PER_CONN_FLAGS = 1; + INTERNET_PER_CONN_PROXY_BYPASS = 3; + INTERNET_PER_CONN_PROXY_SERVER = 2; + INTERNET_SCHEME_PARTIAL = -2; + INTERNET_SCHEME_UNKNOWN = -1; + INTERNET_SCHEME_DEFAULT = 0; + INTERNET_SCHEME_FTP = 1; + INTERNET_SCHEME_GOPHER = 2; + INTERNET_SCHEME_HTTP = 3; + INTERNET_SCHEME_HTTPS = 4; + INTERNET_SCHEME_FILE = 5; + INTERNET_SCHEME_NEWS = 6; + INTERNET_SCHEME_MAILTO = 7; + INTERNET_SCHEME_SOCKS = 8; + INTERNET_SCHEME_JAVASCRIPT = 9; + INTERNET_SCHEME_VBSCRIPT = 10; + INTERNET_SCHEME_RES = 11; + INTERNET_SCHEME_FIRST = INTERNET_SCHEME_FTP; + INTERNET_SCHEME_LAST = INTERNET_SCHEME_MAILTO; + INTERNET_SCHEME_ABOUT = 24; + INTERNET_SCHEME_COOKIE = 25; + INTERNET_SCHEME_CUSTOM_FIRST = INTERNET_SCHEME_ABOUT; + INTERNET_SCHEME_CUSTOM_LAST = INTERNET_SCHEME_COOKIE; + INTERNET_STATE_CONNECTED = $1; + INTERNET_STATE_DISCONNECTED_BY_USER = $10; + INSTALL_SCOPE_INVALID = 0; + INSTALL_SCOPE_MACHINE = 1; + INSTALL_SCOPE_USER = 2; + ISDigit = ['0'..'9', '-', '+']; + ISO_FORCE_DISCONNECTED = $1; + IURL_INVOKECOMMAND_FL_ALLOW_UI = $0001; + IURL_INVOKECOMMAND_FL_DDEWAIT = $0004; // pass DDEWAIT to ShellExec + IURL_INVOKECOMMAND_FL_USE_DEFAULT_VERB = $0002; // Ignore pcszVerb + IURL_SETURL_FL_GUESS_PROTOCOL = $0001; // Guess protocol if missing + IURL_SETURL_FL_USE_DEFAULT_PROTOCOL = $0002; // Use default protocol if missing + MIMEASSOCDLG_FL_REGISTER_ASSOC = $0001; + MinsPerHour = 60; + MOUSE_XBUTTONNEXT = $20000; + MOUSE_XBUTTONPREV = $10000; + MSecsPerSec = 1000; + navAllowAutosearch = $00000010; + navBrowserBar = $00000020; + navNoHistory = $00000002; + navNoReadFromCache = $00000004; + navNoWriteToCache = $00000008; + navOpenInNewWindow = $00000001; + NO_COMMAND = 0; + PathDelim = {$IFDEF MSWINDOWS} '\'; {$ELSE} '/'; {$ENDIF} + PROXY_TYPE_AUTO_DETECT = $00000008; + PROXY_TYPE_AUTO_PROXY_URL = $00000004; + PROXY_TYPE_DIRECT = $00000001; + PROXY_TYPE_PROXY = $00000002; + QUERY_EXPIRATION_DATE = 1; + QUERY_TIME_OF_LAST_CHANGE = 2; + QUERY_CONTENT_ENCODING = 3; + QUERY_CONTENT_TYPE = 4; + QUERY_REFRESH = 5; + QUERY_RECOMBINE = 6; + QUERY_CAN_NAVIGATE = 7; + QUERY_USES_NETWORK = 8; + QUERY_IS_CACHED = 9; + QUERY_IS_INSTALLEDENTRY = 10; + QUERY_IS_CACHED_OR_MAPPED = 11; + QUERY_USES_CACHE = 12; + QUERY_IS_SECURE = 13; + QUERY_IS_SAFE = 14; + QUERY_USES_HISTORYFOLDER = 15; + QUICK_LAUNCH_ROOT = 'Software\MicroSoft\Windows\CurrentVersion\GrpConv'; + READYSTATE_COMPLETE = $00000004; + READYSTATE_INTERACTIVE = $00000003; + READYSTATE_LOADED = $00000002; + READYSTATE_LOADING = $00000001; + READYSTATE_UNINITIALIZED = $00000000; + RegMail = 'Software\Microsoft\Windows\CurrentVersion\UnreadMail\'; + SecsPerMin = 60; + SHACF_AUTOAPPEND_FORCE_OFF = $80000000; // Ignore the registry default and force the feature off. (Also know as AutoComplete) + SHACF_AUTOAPPEND_FORCE_ON = $40000000; // Ignore the registry default and force the feature on. (Also know as AutoComplete) + SHACF_AUTOSUGGEST_FORCE_OFF = $20000000; // Ignore the registry default and force the feature off. + SHACF_AUTOSUGGEST_FORCE_ON = $10000000; // Ignore the registry default and force the feature on. + SHACF_DEFAULT = $00000000; // Currently (SHACF_FILESYSTEM | SHACF_URLALL) + SHACF_FILESYSTEM = $00000001; // This includes the File System as well as the rest of the shell (Desktop\My Computer\Control Panel\) + SHACF_URLHISTORY = $00000002; // URLs in the User's History + SHACF_URLMRU = $00000004; // URLs in the User's Recently Used list. + SHACF_USETAB = $00000008; + SHACF_URLALL = (SHACF_URLHISTORY + SHACF_URLMRU); + SHELL_FOLDERS_ROOT = 'Software\MicroSoft\Windows\CurrentVersion\Explorer'; + Shell32 = 'shell32.dll'; + SHFreeShared_Index = 523; + SHLockShared_Index = 521; + SHUnlockShared_Index = 522; + SITE_ADDRESS = 'http://bsalsa.com/'; + STATURL_QUERYFLAG_ISCACHED = $00010000; + STATURL_QUERYFLAG_NOTITLE = $00040000; + STATURL_QUERYFLAG_NOURL = $00020000; + STATURL_QUERYFLAG_TOPLEVEL = $00080000; + STATURLFLAG_ISCACHED = $00000001; + STATURLFLAG_ISTOPLEVEL = $00000002; + TLEF_ABSOLUTE = $00000031; + TLEF_INCLUDE_UNINVOKEABLE = $00000040; + TLEF_RELATIVE_BACK = $00000010; + TLEF_RELATIVE_FORE = $00000020; + TLEF_RELATIVE_INCLUDE_CURRENT = $00000001; + TRANSLATEURL_FL_GUESS_PROTOCOL = $0001; // Guess protocol if missing + TRANSLATEURL_FL_USE_DEFAULT_PROTOCOL = $0002; // Use default protocol if missing + UNKNOWN_RESPOND = 262632; + URLACTION_CLIENT_CERT_PROMPT = $00001A04; + URLACTION_COOKIES = $00001A02; + URLACTION_COOKIES_SESSION = $00001A03; + URLACTION_CROSS_DOMAIN_DATA = $00001406; + URLACTION_HTML_SUBFRAME_NAVIGATE = $00001607; + URLACTION_HTML_USERDATA_SAVE = $00001606; + URLACTION_SCRIPT_PASTE = $00001407; + URLASSOCDLG_FL_REGISTER_ASSOC = $0002; + URLASSOCDLG_FL_USE_DEFAULT_NAME = $0001; + urldll = 'url.dll'; + UrlMonLib = 'URLMON.DLL'; + URL_MK_LEGACY = 0; + URL_MK_UNIFORM = 1; + URL_MK_NO_CANONICALIZE = 2; + URLPOLICY_ACTIVEX_CHECK_LIST = $00010000; + URLTEMPLATE_MEDLOW = $10500; + USER_AGENT_IE6 = 'User-agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)'; + USER_AGENT_IE7 = 'User-agent: Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1)'; + USER_AGENT_PATH = '\Software\Microsoft\Windows\CurrentVersion\Internet Settings\User Agent\Post Platform'; + VER_GREATER_EQUAL = 3; + VER_MAJORVERSION = $0000002; + VER_MINORVERSION = $0000001; + VER_SERVICEPACKMAJOR = $0000020; + VER_SERVICEPACKMINOR = $0000010; + VIEW_COMMAND = 1; + WEB_SITE = 'Help & Support: http://www.bsalsa.com/'; + WM_USER = $0400; + WM_USER_STARTWALKING = WM_USER + 1; + WM_XBUTTONDBLCLK = $020D; + WM_XBUTTONDOWN = $020B; + WM_XBUTTONUP = $020C; + +const + MinsPerDay = HoursPerDay * MinsPerHour; + SecsPerDay = MinsPerDay * SecsPerMin; + MSecsPerDay = SecsPerDay * MSecsPerSec; + +const + INTERNET_CONNECTION_MODEM = 1; +{$EXTERNALSYM INTERNET_CONNECTION_MODEM} + INTERNET_CONNECTION_LAN = 2; +{$EXTERNALSYM INTERNET_CONNECTION_LAN} + INTERNET_CONNECTION_PROXY = 4; +{$EXTERNALSYM INTERNET_CONNECTION_PROXY} + INTERNET_CONNECTION_MODEM_BUSY = 8; +{$EXTERNALSYM INTERNET_CONNECTION_MODEM_BUSY} + INTERNET_RAS_INSTALLED = 16; +{$EXTERNALSYM INTERNET_RAS_INSTALLED} + INTERNET_CONNECTION_OFFLINE = 32; +{$EXTERNALSYM INTERNET_CONNECTION_OFFLINE} + INTERNET_CONNECTION_CONFIGURED = 64; +{$EXTERNALSYM INTERNET_CONNECTION_CONFIGURED} + +{$EXTERNALSYM MAX_SIZE_SECURITY_ID} + MAX_SIZE_SECURITY_ID = 512; +{$EXTERNALSYM PUAF_DEFAULT} + PUAF_DEFAULT = $00000000; +{$EXTERNALSYM PUAF_NOUI} + PUAF_NOUI = $00000001; +{$EXTERNALSYM PUAF_ISFILE} + PUAF_ISFILE = $00000002; +{$EXTERNALSYM PUAF_WARN_IF_DENIED} + PUAF_WARN_IF_DENIED = $00000004; +{$EXTERNALSYM PUAF_FORCEUI_FOREGROUND} + PUAF_FORCEUI_FOREGROUND = $00000008; +{$EXTERNALSYM PUAF_CHECK_TIFS} + PUAF_CHECK_TIFS = $00000010; +{$EXTERNALSYM SZM_CREATE} + SZM_CREATE = $00000000; +{$EXTERNALSYM SZM_DELETE} + SZM_DELETE = $00000001; +{$EXTERNALSYM URLACTION_MIN} + URLACTION_MIN = $00001000; +{$EXTERNALSYM URLACTION_DOWNLOAD_MIN} + URLACTION_DOWNLOAD_MIN = $00001000; +{$EXTERNALSYM URLACTION_DOWNLOAD_SIGNED_ACTIVEX} + URLACTION_DOWNLOAD_SIGNED_ACTIVEX = $00001001; +{$EXTERNALSYM URLACTION_DOWNLOAD_UNSIGNED_ACTIVEX} + URLACTION_DOWNLOAD_UNSIGNED_ACTIVEX = $00001004; +{$EXTERNALSYM URLACTION_DOWNLOAD_CURR_MAX} + URLACTION_DOWNLOAD_CURR_MAX = $00001004; +{$EXTERNALSYM URLACTION_DOWNLOAD_MAX} + URLACTION_DOWNLOAD_MAX = $000011FF; +{$EXTERNALSYM URLACTION_ACTIVEX_MIN} + URLACTION_ACTIVEX_MIN = $00001200; +{$EXTERNALSYM URLACTION_ACTIVEX_RUN} + URLACTION_ACTIVEX_RUN = $00001200; +{$EXTERNALSYM URLACTION_ACTIVEX_OVERRIDE_OBJECT_SAFETY} + URLACTION_ACTIVEX_OVERRIDE_OBJECT_SAFETY = $00001201; +{$EXTERNALSYM URLACTION_ACTIVEX_OVERRIDE_DATA_SAFETY} + URLACTION_ACTIVEX_OVERRIDE_DATA_SAFETY = $00001202; +{$EXTERNALSYM URLACTION_ACTIVEX_OVERRIDE_SCRIPT_SAFETY} + URLACTION_ACTIVEX_OVERRIDE_SCRIPT_SAFETY = $00001203; +{$EXTERNALSYM URLACTION_SCRIPT_OVERRIDE_SAFETY} + URLACTION_SCRIPT_OVERRIDE_SAFETY = $00001401; // +{$EXTERNALSYM URLACTION_ACTIVEX_CONFIRM_NOOBJECTSAFETY} + URLACTION_ACTIVEX_CONFIRM_NOOBJECTSAFETY = $00001204; +{$EXTERNALSYM URLACTION_ACTIVEX_TREATASUNTRUSTED} + URLACTION_ACTIVEX_TREATASUNTRUSTED = $00001205; +{$EXTERNALSYM URLACTION_ACTIVEX_CURR_MAX} + URLACTION_ACTIVEX_CURR_MAX = $00001205; +{$EXTERNALSYM URLACTION_ACTIVEX_MAX} + URLACTION_ACTIVEX_MAX = $000013FF; +{$EXTERNALSYM URLACTION_SCRIPT_MIN} + URLACTION_SCRIPT_MIN = $00001400; +{$EXTERNALSYM URLACTION_SCRIPT_RUN} + URLACTION_SCRIPT_RUN = $00001400; +{$EXTERNALSYM URLACTION_SCRIPT_JAVA_USE} + URLACTION_SCRIPT_JAVA_USE = $00001402; +{$EXTERNALSYM URLACTION_SCRIPT_SAFE_ACTIVEX} + URLACTION_SCRIPT_SAFE_ACTIVEX = $00001405; +{$EXTERNALSYM URLACTION_SCRIPT_CURR_MAX} + URLACTION_SCRIPT_CURR_MAX = $00001405; +{$EXTERNALSYM URLACTION_SCRIPT_MAX} + URLACTION_SCRIPT_MAX = $000015FF; +{$EXTERNALSYM URLACTION_HTML_MIN} + URLACTION_HTML_MIN = $00001600; +{$EXTERNALSYM URLACTION_HTML_SUBMIT_FORMS} + URLACTION_HTML_SUBMIT_FORMS = $00001601; // aggregate next two +{$EXTERNALSYM URLACTION_HTML_SUBMIT_FORMS_FROM} + URLACTION_HTML_SUBMIT_FORMS_FROM = $00001602; // +{$EXTERNALSYM URLACTION_HTML_SUBMIT_FORMS_TO} + URLACTION_HTML_SUBMIT_FORMS_TO = $00001603; // +{$EXTERNALSYM URLACTION_HTML_FONT_DOWNLOAD} + URLACTION_HTML_FONT_DOWNLOAD = $00001604; +{$EXTERNALSYM URLACTION_HTML_JAVA_RUN} + URLACTION_HTML_JAVA_RUN = $00001605; // derive from Java custom policy; +{$EXTERNALSYM URLACTION_HTML_CURR_MAX} + URLACTION_HTML_CURR_MAX = $00001605; +{$EXTERNALSYM URLACTION_HTML_MAX} + URLACTION_HTML_MAX = $000017FF; +{$EXTERNALSYM URLACTION_SHELL_MIN} + URLACTION_SHELL_MIN = $00001800; +{$EXTERNALSYM URLACTION_SHELL_INSTALL_DTITEMS} + URLACTION_SHELL_INSTALL_DTITEMS = $00001800; +{$EXTERNALSYM URLACTION_SHELL_MOVE_OR_COPY} + URLACTION_SHELL_MOVE_OR_COPY = $00001802; +{$EXTERNALSYM URLACTION_SHELL_FILE_DOWNLOAD} + URLACTION_SHELL_FILE_DOWNLOAD = $00001803; +{$EXTERNALSYM URLACTION_SHELL_VERB} + URLACTION_SHELL_VERB = $00001804; +{$EXTERNALSYM URLACTION_SHELL_WEBVIEW_VERB} + URLACTION_SHELL_WEBVIEW_VERB = $00001805; +{$EXTERNALSYM URLACTION_SHELL_CURR_MAX} + URLACTION_SHELL_CURR_MAX = $00001805; +{$EXTERNALSYM URLACTION_SHELL_MAX} + URLACTION_SHELL_MAX = $000019FF; +{$EXTERNALSYM URLACTION_NETWORK_MIN} + URLACTION_NETWORK_MIN = $00001A00; +{$EXTERNALSYM URLACTION_CREDENTIALS_USE} + URLACTION_CREDENTIALS_USE = $00001A00; +{$EXTERNALSYM URLPOLICY_CREDENTIALS_SILENT_LOGON_OK} + URLPOLICY_CREDENTIALS_SILENT_LOGON_OK = $00000000; +{$EXTERNALSYM URLPOLICY_CREDENTIALS_MUST_PROMPT_USER} + URLPOLICY_CREDENTIALS_MUST_PROMPT_USER = $00010000; +{$EXTERNALSYM URLPOLICY_CREDENTIALS_CONDITIONAL_PROMPT} + URLPOLICY_CREDENTIALS_CONDITIONAL_PROMPT = $00020000; +{$EXTERNALSYM URLPOLICY_CREDENTIALS_ANONYMOUS_ONLY} + URLPOLICY_CREDENTIALS_ANONYMOUS_ONLY = $00030000; +{$EXTERNALSYM URLACTION_AUTHENTICATE_CLIENT} + URLACTION_AUTHENTICATE_CLIENT = $00001A01; +{$EXTERNALSYM URLPOLICY_AUTHENTICATE_CLEARTEXT_OK} + URLPOLICY_AUTHENTICATE_CLEARTEXT_OK = $00000000; +{$EXTERNALSYM URLPOLICY_AUTHENTICATE_CHALLENGE_RESPONSE} + URLPOLICY_AUTHENTICATE_CHALLENGE_RESPONSE = $00010000; +{$EXTERNALSYM URLPOLICY_AUTHENTICATE_MUTUAL_ONLY} + URLPOLICY_AUTHENTICATE_MUTUAL_ONLY = $00030000; +{$EXTERNALSYM URLACTION_NETWORK_CURR_MAX} + URLACTION_NETWORK_CURR_MAX = $00001A01; +{$EXTERNALSYM URLACTION_NETWORK_MAX} + URLACTION_NETWORK_MAX = $00001BFF; +{$EXTERNALSYM URLACTION_JAVA_MIN} + URLACTION_JAVA_MIN = $00001C00; +{$EXTERNALSYM URLACTION_JAVA_PERMISSIONS} + URLACTION_JAVA_PERMISSIONS = $00001C00; +{$EXTERNALSYM URLPOLICY_JAVA_PROHIBIT} + URLPOLICY_JAVA_PROHIBIT = $00000000; +{$EXTERNALSYM URLPOLICY_JAVA_HIGH} + URLPOLICY_JAVA_HIGH = $00010000; +{$EXTERNALSYM URLPOLICY_JAVA_MEDIUM} + URLPOLICY_JAVA_MEDIUM = $00020000; +{$EXTERNALSYM URLPOLICY_JAVA_LOW} + URLPOLICY_JAVA_LOW = $00030000; +{$EXTERNALSYM URLPOLICY_JAVA_CUSTOM} + URLPOLICY_JAVA_CUSTOM = $00800000; +{$EXTERNALSYM URLACTION_JAVA_CURR_MAX} + URLACTION_JAVA_CURR_MAX = $00001C00; +{$EXTERNALSYM URLACTION_JAVA_MAX} + URLACTION_JAVA_MAX = $00001CFF; +{$EXTERNALSYM URLACTION_INFODELIVERY_MIN} + URLACTION_INFODELIVERY_MIN = $00001D00; +{$EXTERNALSYM URLACTION_INFODELIVERY_NO_ADDING_CHANNELS} + URLACTION_INFODELIVERY_NO_ADDING_CHANNELS = $00001D00; +{$EXTERNALSYM URLACTION_INFODELIVERY_NO_EDITING_CHANNELS} + URLACTION_INFODELIVERY_NO_EDITING_CHANNELS = $00001D01; +{$EXTERNALSYM URLACTION_INFODELIVERY_NO_REMOVING_CHANNELS} + URLACTION_INFODELIVERY_NO_REMOVING_CHANNELS = $00001D02; +{$EXTERNALSYM URLACTION_INFODELIVERY_NO_ADDING_SUBSCRIPTIONS} + URLACTION_INFODELIVERY_NO_ADDING_SUBSCRIPTIONS = $00001D03; +{$EXTERNALSYM URLACTION_INFODELIVERY_NO_EDITING_SUBSCRIPTIONS} + URLACTION_INFODELIVERY_NO_EDITING_SUBSCRIPTIONS = $00001D04; +{$EXTERNALSYM URLACTION_INFODELIVERY_NO_REMOVING_SUBSCRIPTIONS} + URLACTION_INFODELIVERY_NO_REMOVING_SUBSCRIPTIONS = $00001D05; +{$EXTERNALSYM URLACTION_INFODELIVERY_NO_CHANNEL_LOGGING} + URLACTION_INFODELIVERY_NO_CHANNEL_LOGGING = $00001D06; +{$EXTERNALSYM URLACTION_INFODELIVERY_CURR_MAX} + URLACTION_INFODELIVERY_CURR_MAX = $00001D06; +{$EXTERNALSYM URLACTION_INFODELIVERY_MAX} + URLACTION_INFODELIVERY_MAX = $00001DFF; +{$EXTERNALSYM URLACTION_CHANNEL_SOFTDIST_MIN} + URLACTION_CHANNEL_SOFTDIST_MIN = $00001E00; +{$EXTERNALSYM URLACTION_CHANNEL_SOFTDIST_PERMISSIONS} + URLACTION_CHANNEL_SOFTDIST_PERMISSIONS = $00001E05; +{$EXTERNALSYM URLPOLICY_CHANNEL_SOFTDIST_PROHIBIT} + URLPOLICY_CHANNEL_SOFTDIST_PROHIBIT = $00010000; +{$EXTERNALSYM URLPOLICY_CHANNEL_SOFTDIST_PRECACHE} + URLPOLICY_CHANNEL_SOFTDIST_PRECACHE = $00020000; +{$EXTERNALSYM URLPOLICY_CHANNEL_SOFTDIST_AUTOINSTALL} + URLPOLICY_CHANNEL_SOFTDIST_AUTOINSTALL = $00030000; +{$EXTERNALSYM URLACTION_CHANNEL_SOFTDIST_MAX} + URLACTION_CHANNEL_SOFTDIST_MAX = $00001EFF; +{$EXTERNALSYM URLPOLICY_ALLOW} + URLPOLICY_ALLOW = $00; +{$EXTERNALSYM URLPOLICY_QUERY} + URLPOLICY_QUERY = $01; +{$EXTERNALSYM URLPOLICY_DISALLOW} + URLPOLICY_DISALLOW = $03; +{$EXTERNALSYM URLPOLICY_NOTIFY_ON_ALLOW} + URLPOLICY_NOTIFY_ON_ALLOW = $10; +{$EXTERNALSYM URLPOLICY_NOTIFY_ON_DISALLOW} + URLPOLICY_NOTIFY_ON_DISALLOW = $20; +{$EXTERNALSYM URLPOLICY_LOG_ON_ALLOW} + URLPOLICY_LOG_ON_ALLOW = $40; +{$EXTERNALSYM URLPOLICY_LOG_ON_DISALLOW} + URLPOLICY_LOG_ON_DISALLOW = $80; +{$EXTERNALSYM URLPOLICY_MASK_PERMISSIONS} + URLPOLICY_MASK_PERMISSIONS = $0F; +{$EXTERNALSYM URLZONE_PREDEFINED_MIN} + URLZONE_PREDEFINED_MIN = 0; +{$EXTERNALSYM URLZONE_LOCAL_MACHINE} + URLZONE_LOCAL_MACHINE = 0; +{$EXTERNALSYM URLZONE_INTRANET} + URLZONE_INTRANET = URLZONE_LOCAL_MACHINE + 1; +{$EXTERNALSYM URLZONE_TRUSTED} + URLZONE_TRUSTED = URLZONE_INTRANET + 1; +{$EXTERNALSYM URLZONE_INTERNET} + URLZONE_INTERNET = URLZONE_TRUSTED + 1; +{$EXTERNALSYM URLZONE_UNTRUSTED} + URLZONE_UNTRUSTED = URLZONE_INTERNET + 1; +{$EXTERNALSYM URLZONE_PREDEFINED_MAX} + URLZONE_PREDEFINED_MAX = 999; +{$EXTERNALSYM URLZONE_USER_MIN} + URLZONE_USER_MIN = 1000; +{$EXTERNALSYM URLZONE_USER_MAX} + URLZONE_USER_MAX = 10000; +{$EXTERNALSYM URLTEMPLATE_CUSTOM} + URLTEMPLATE_CUSTOM = $00000000; +{$EXTERNALSYM URLTEMPLATE_PREDEFINED_MIN} + URLTEMPLATE_PREDEFINED_MIN = $00010000; +{$EXTERNALSYM URLTEMPLATE_LOW} + URLTEMPLATE_LOW = $00010000; +{$EXTERNALSYM URLTEMPLATE_MEDIUM} + URLTEMPLATE_MEDIUM = $00011000; +{$EXTERNALSYM URLTEMPLATE_HIGH} + URLTEMPLATE_HIGH = $00012000; +{$EXTERNALSYM URLTEMPLATE_PREDEFINED_MAX} + URLTEMPLATE_PREDEFINED_MAX = $00020000; +{$EXTERNALSYM MAX_ZONE_PATH} + MAX_ZONE_PATH = 260; +{$EXTERNALSYM MAX_ZONE_DESCRIPTION} + MAX_ZONE_DESCRIPTION = 200; +{$EXTERNALSYM ZAFLAGS_CUSTOM_EDIT} + ZAFLAGS_CUSTOM_EDIT = $00000001; +{$EXTERNALSYM ZAFLAGS_ADD_SITES} + ZAFLAGS_ADD_SITES = $00000002; +{$EXTERNALSYM ZAFLAGS_REQUIRE_VERIFICATION} + ZAFLAGS_REQUIRE_VERIFICATION = $00000004; +{$EXTERNALSYM ZAFLAGS_INCLUDE_PROXY_OVERRIDE} + ZAFLAGS_INCLUDE_PROXY_OVERRIDE = $00000008; +{$EXTERNALSYM ZAFLAGS_INCLUDE_INTRANET_SITES} + ZAFLAGS_INCLUDE_INTRANET_SITES = $00000010; +{$EXTERNALSYM ZAFLAGS_NO_UI} + ZAFLAGS_NO_UI = $00000020; +{$EXTERNALSYM ZAFLAGS_SUPPORTS_VERIFICATION} + ZAFLAGS_SUPPORTS_VERIFICATION = $00000040; +{$EXTERNALSYM ZAFLAGS_UNC_AS_INTRANET} + ZAFLAGS_UNC_AS_INTRANET = $00000080; +{$EXTERNALSYM URLZONEREG_DEFAULT} + URLZONEREG_DEFAULT = 0; +{$EXTERNALSYM URLZONEREG_HKLM} + URLZONEREG_HKLM = URLZONEREG_DEFAULT + 1; +{$EXTERNALSYM URLZONEREG_HKCU} + URLZONEREG_HKCU = URLZONEREG_HKLM + 1; + +const + IID_IWebBrowserEventsService: TGUID = '{87CC5D04-EAFA-4833-9820-8F986530CC00}'; + IID_ITravelLogEntry: TGUID = '{7EBFDD87-AD18-11d3-A4C5-00C04F72D6B8}'; + IID_IEnumTravelLogEntry: TGUID = '{7EBFDD85-AD18-11d3-A4C5-00C04F72D6B8}'; + IID_ITravelLogStg: TGUID = '{7EBFDD80-AD18-11d3-A4C5-00C04F72D6B8}'; + IID_IInputObjectSite: TGUID = (D1: $F1DB8392; D2: $7331; D3: $11D0; D4: ($8C, + $99, $00, $A0, $C9, $2D, $BF, $E8)); + IID_IQueryInfo: TGUID = (D1: $00021500; D2: $0000; D3: $0000; D4: ($C0, $00, + $00, $00, $00, $00, $00, $46)); + IID_IUniformResourceLocatorA: TGUID = (D1: $FBF23B80; D2: $E3F0; D3: $101B; + D4: ($84, $88, $00, $AA, $00, $3E, $56, $F8)); + IID_IUniformResourceLocatorW: TGUID = (D1: $CABB0DA0; D2: $DA57; D3: $11CF; + D4: ($99, $74, $00, $20, $AF, $D7, $97, $62)); + IID_IUrlHistoryNotify: TGUID = (D1: $BC40BEC1; D2: $C493; D3: $11D0; D4: ($83, + $1B, $00, $C0, $4F, $D5, $AE, $38)); + IID_IUrlHistoryStg: TGUID = (D1: $3C374A41; D2: $BAE4; D3: $11CF; D4: ($BF, + $7D, $00, $AA, $00, $69, $46, $EE)); + IID_IUrlHistoryStg2: TGUID = (D1: $AFA0DC11; D2: $C313; D3: $831A; D4: ($83, + $1A, $00, $C0, $4F, $D5, $AE, $38)); + SID_IHTMLOMWindowServices = '{3050F5FC-98B5-11CF-BB82-00AA00BDCE0B}'; + CLSID_InternetShortCut: TGUID = (d1: $FBF23B40; D2: $E3F0; D3: $101B; D4: + ($84, $88, $00, $AA, $00, $3E, $56, $F8)); + CGID_DocHostCommandHandler: TGUID = (D1: $F38BC242; D2: $B950; D3: $11D1; D4: + ($89, $18, $00, $C0, $4F, $C2, $C8, $36)); + CLSID_CUrlHistory: TGUID = '{3C374A40-BAE4-11CF-BF7D-00AA006946EE}'; + CLSID_ShellUIHelper: TGUID = '{64AB4BB7-111E-11D1-8F79-00C04FC2FBE1}'; + CLSID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}'; + CGID_MSHTML: TGUID = '{DE4BA900-59CA-11CF-9592-444553540000}'; + IID_IoleCommandTarget: TGUID = '{B722BCCB-4E68-101B-A2BC-00AA00404770}'; + GUID_TriEditCommandGroup: TGUID = '{2582F1C0-084E-11d1-9A0E-006097C9B344}'; + IID_IACList: TGUID = '{77A130B0-94FD-11D0-A544-00C04FD7d062}'; + IID_IACList2: TGUID = '{470141a0-5186-11d2-bbb6-0060977b464c}'; + IID_ICustomDoc: TGUID = '{3050f3f0-98b5-11cf-bb82-00aa00bdce0b}'; + IID_IDocHostShowUI: TGUID = '{c4d244b0-d43e-11cf-893b-00aa00bdce1a}'; + IID_IDocHostUIHandler: TGUID = '{bd3f23c0-d43e-11cf-893b-00aa00bdce1a}'; + IID_IDocHostUIHandler2: TGUID = '{3050f6d0-98b5-11cf-bb82-00aa00bdce0b}'; + IID_IDownloadManager: TGUID = (D1: $988934A4; D2: $064B; D3: $11D3; D4: ($BB, + $80, $0, $10, $4B, $35, $E7, $F9)); + IID_IEnumStatUrl: TGUID = (D1: $3C374A42; D2: $BAE4; D3: $11CF; D4: ($BF, $7D, + $00, $AA, $00, $69, $46, $EE)); + IID_IHTMLOMWindowServices: TGUID = '{3050F5FC-98B5-11CF-BB82-00AA00BDCE0B}'; + IID_IHlinkFrame: TGUID = '{79eac9c5-baf9-11ce-8c82-00aa004ba90b}'; + IID_INewWindowManager: TGUID = '{D2BC4C84-3F72-4a52-A604-7BCBF3982CBB}'; + IID_IProtectFocus: TGUID = '{D81F90A3-8156-44F7-AD28-5ABB87003274}'; + SID_STravelLogCursor: TGUID = '{7EBFDD80-AD18-11d3-A4C5-00C04F72D6B8}'; + SID_IEnumStatUrl = '{3C374A42-BAE4-11CF-BF7D-00AA006946EE}'; + SID_IURLHistoryNotify = '{BC40BEC1-C493-11d0-831B-00C04FD5AE38}'; + SID_IUrlHistoryStg = '{3C374A41-BAE4-11CF-BF7D-00AA006946EE}'; + SID_IUrlHistoryStg2 = '{AFA0DC11-C313-11d0-831A-00C04FD5AE38}'; + SID_SDownloadManager = '{988934A4-064B-11D3-BB80-00104B35E7F9}'; + SID_IUniformResourceLocatorA = '{FBF23B80-E3F0-101B-8488-00AA003E56F8}'; + SID_IUniformResourceLocatorW = '{CABB0DA0-DA57-11CF-9974-0020AFD79762}'; +{$IFDEF UNICODE} + SID_IUniformResourceLocator = SID_IUniformResourceLocatorW; +{$ELSE} + SID_IUniformResourceLocator = SID_IUniformResourceLocatorA; +{$ENDIF} + IID_IUniformResourceLocator: TGUID = SID_IUniformResourceLocator; + +implementation + +end. diff --git a/Source/EWBMouseHook.pas b/Source/EWBMouseHook.pas index 150e3e1..06e72a6 100644 --- a/Source/EWBMouseHook.pas +++ b/Source/EWBMouseHook.pas @@ -45,9 +45,9 @@ interface // -- TEWBMouseHook ------------------------------------------------------------ type - TFNMouseProc = function(nCode: Integer; wp: WPARAM; lp: WParam): LRESULT + TFNMouseProc = function(nCode: Integer; wp: WPARAM; lp: LPARAM): LRESULT stdcall; - TFNMouseMethod = function(nCode: Integer; wp: WPARAM; lp: WParam): LRESULT + TFNMouseMethod = function(nCode: Integer; wp: WPARAM; lp: LPARAM): LRESULT stdcall of object; TMouseWheelEvent = procedure(Point: TPoint; hwndFromPoint: HWND; lp: LPARAM; var Handled: Boolean) of object; diff --git a/Source/EWB_jedi.inc b/Source/EWB_jedi.inc index 76c3528..2ed1ace 100644 --- a/Source/EWB_jedi.inc +++ b/Source/EWB_jedi.inc @@ -142,6 +142,22 @@ DELPHI2010 Alias for DELPHI14 DELPHI15 Defined when compiling with Delphi XE for Win32 (Codename FULCRUM) DELPHIXE Alias for DELPHI15 + DELPHI16 Defined when compiling with Delphi XE2 for Win32 (Codename PULSAR) + DELPHIXE2 Alias for DELPHI16 + DELPHI17 Defined when compiling with Delphi XE3 for Win32 (Codename WATERDRAGON) + DELPHIXE3 Alias for DELPHI17 + DELPHI18 Defined when compiling with Delphi XE4 for Win32 (Codename QUINTESSENCE) + DELPHIXE4 Alias for DELPHI18 + DELPHI19 Defined when compiling with Delphi XE5 for Win32 (Codename ZEPHYR) + DELPHIXE5 Alias for DELPHI19 + DELPHI20 Defined when compiling with Delphi XE6 for Win32 (Codename PROTEUS) + DELPHIXE6 Alias for DELPHI20 + DELPHI21 Defined when compiling with Delphi XE7 for Win32 (Codename CARPATHIA) + DELPHIXE7 Alias for DELPHI21 + DELPHI22 Defined when compiling with Delphi XE8 for Win32 (Codename ELBRUS) + DELPHIXE8 Alias for DELPHI22 + DELPHI23 Defined when compiling with Delphi 10 for Win32 (Codename AITANA) + DELPHIX_SEATTLE Alias for DELPHI23 DELPHI1_UP Defined when compiling with Delphi 1 or higher DELPHI2_UP Defined when compiling with Delphi 2 or higher DELPHI3_UP Defined when compiling with Delphi 3 or higher @@ -162,6 +178,22 @@ DELPHI2010_UP Alias for DELPHI14_UP DELPHI15_UP Defined when compiling with Delphi XE for Win32 or higher DELPHIXE_UP Alias for DELPHI15_UP + DELPHI16_UP Defined when compiling with Delphi XE2 for Win32 or higher + DELPHIXE2_UP Alias for DELPHI16_UP + DELPHI17_UP Defined when compiling with Delphi XE3 for Win32 or higher + DELPHIXE3_UP Alias for DELPHI17_UP + DELPHI18_UP Defined when compiling with Delphi XE4 for Win32 or higher + DELPHIXE4_UP Alias for DELPHI18_UP + DELPHI19_UP Defined when compiling with Delphi XE5 for Win32 or higher + DELPHIXE5_UP Alias for DELPHI19_UP + DELPHI20_UP Defined when compiling with Delphi XE6 for Win32 or higher + DELPHIXE6_UP Alias for DELPHI20_UP + DELPHI21_UP Defined when compiling with Delphi XE7 for Win32 or higher + DELPHIXE7_UP Alias for DELPHI21_UP + DELPHI22_UP Defined when compiling with Delphi XE8 for Win32 or higher + DELPHIXE8_UP Alias for DELPHI22_UP + DELPHI23_UP Defined when compiling with Delphi 10 for Win32 or higher + DELPHIX_SEATTLE_UP Alias for DELPHI23_UP - Kylix Versions @@ -198,6 +230,14 @@ DELPHICOMPILER12 Defined when compiling with Delphi Personality of BDS 6.0 DELPHICOMPILER14 Defined when compiling with Delphi Personality of BDS 7.0 DELPHICOMPILER15 Defined when compiling with Delphi Personality of BDS 8.0 + DELPHICOMPILER16 Defined when compiling with Delphi Personality of BDS 9.0 + DELPHICOMPILER17 Defined when compiling with Delphi Personality of BDS 10.0 + DELPHICOMPILER18 Defined when compiling with Delphi Personality of BDS 11.0 + DELPHICOMPILER19 Defined when compiling with Delphi Personality of BDS 12.0 + DELPHICOMPILER20 Defined when compiling with Delphi Personality of BDS 14.0 + DELPHICOMPILER21 Defined when compiling with Delphi Personality of BDS 15.0 + DELPHICOMPILER22 Defined when compiling with Delphi Personality of BDS 16.0 + DELPHICOMPILER23 Defined when compiling with Delphi Personality of BDS 17.0 DELPHICOMPILER1_UP Defined when compiling with Delphi 1 or higher DELPHICOMPILER2_UP Defined when compiling with Delphi 2 or higher DELPHICOMPILER3_UP Defined when compiling with Delphi 3 or higher @@ -212,6 +252,14 @@ DELPHICOMPILER12_UP Defined when compiling with Delphi 2009 for Win32 or higher DELPHICOMPILER14_UP Defined when compiling with Delphi 2010 for Win32 or higher DELPHICOMPILER15_UP Defined when compiling with Delphi XE for Win32 or higher + DELPHICOMPILER16_UP Defined when compiling with Delphi XE2 for Win32 or higher + DELPHICOMPILER17_UP Defined when compiling with Delphi XE3 for Win32 or higher + DELPHICOMPILER18_UP Defined when compiling with Delphi XE4 for Win32 or higher + DELPHICOMPILER19_UP Defined when compiling with Delphi XE5 for Win32 or higher + DELPHICOMPILER20_UP Defined when compiling with Delphi XE6 for Win32 or higher + DELPHICOMPILER21_UP Defined when compiling with Delphi XE7 for Win32 or higher + DELPHICOMPILER22_UP Defined when compiling with Delphi XE8 for Win32 or higher + DELPHICOMPILER23_UP Defined when compiling with Delphi 10 for Win32 or higher - C++Builder Versions @@ -231,6 +279,15 @@ BCB11 Defined when compiling with C++Builder Personality of RAD Studio 2007 (also known as C++Builder 2007) (Codename COGSWELL) BCB12 Defined when compiling with C++Builder Personality of RAD Studio 2009 (also known as C++Builder 2009) (Codename TIBURON) BCB14 Defined when compiling with C++Builder Personality of RAD Studio 2010 (also known as C++Builder 2010) (Codename WEAVER) + BCB15 Defined when compiling with C++Builder Personality of RAD Studio XE (also known as C++Builder XE) (Codename FULCRUM) + BCB16 Defined when compiling with C++Builder Personality of RAD Studio XE2 (also known as C++Builder XE2) (Codename PULSAR) + BCB17 Defined when compiling with C++Builder Personality of RAD Studio XE3 (also known as C++Builder XE3) (Codename WATERDRAGON) + BCB18 Defined when compiling with C++Builder Personality of RAD Studio XE4 (also known as C++Builder XE4) (Codename QUINTESSENCE) + BCB19 Defined when compiling with C++Builder Personality of RAD Studio XE5 (also known as C++Builder XE5) (Codename ZEPHYR) + BCB20 Defined when compiling with C++Builder Personality of RAD Studio XE6 (also known as C++Builder XE6) (Codename PROTEUS) + BCB21 Defined when compiling with C++Builder Personality of RAD Studio XE7 (also known as C++Builder XE7) (Codename CARPATHIA) + BCB22 Defined when compiling with C++Builder Personality of RAD Studio XE8 (also known as C++Builder XE8) (Codename ELBRUS) + BCB23 Defined when compiling with C++Builder Personality of RAD Studio 10 Seattle (also known as C++Builder 10 Seattle) (Codename AITANA) BCB1_UP Defined when compiling with C++Builder 1 or higher BCB3_UP Defined when compiling with C++Builder 3 or higher BCB4_UP Defined when compiling with C++Builder 4 or higher @@ -241,6 +298,14 @@ BCB12_UP Defined when compiling with C++Builder Personality of RAD Studio 2009 or higher BCB14_UP Defined when compiling with C++Builder Personality of RAD Studio 2010 or higher BCB15_UP Defined when compiling with C++Builder Personality of RAD Studio XE or higher + BCB16_UP Defined when compiling with C++Builder Personality of RAD Studio XE2 or higher + BCB17_UP Defined when compiling with C++Builder Personality of RAD Studio XE3 or higher + BCB18_UP Defined when compiling with C++Builder Personality of RAD Studio XE4 or higher + BCB19_UP Defined when compiling with C++Builder Personality of RAD Studio XE5 or higher + BCB20_UP Defined when compiling with C++Builder Personality of RAD Studio XE6 or higher + BCB21_UP Defined when compiling with C++Builder Personality of RAD Studio XE7 or higher + BCB22_UP Defined when compiling with C++Builder Personality of RAD Studio XE8 or higher + BCB23_UP Defined when compiling with C++Builder Personality of RAD Studio 10 or higher - RAD Studio / Borland Developer Studio Versions @@ -262,6 +327,14 @@ BDS6 Defined when compiling with BDS 6.0 (CodeGear RAD Studio 2009) (Codename TIBURON) BDS7 Defined when compiling with BDS 7.0 (Embarcadero RAD Studio 2010) (Codename WEAVER) BDS8 Defined when compiling with BDS 8.0 (Embarcadero RAD Studio XE) (Codename FULCRUM) + BDS9 Defined when compiling with BDS 9.0 (Embarcadero RAD Studio XE2) (Codename PULSAR) + BDS10 Defined when compiling with BDS 10.0 (Embarcadero RAD Studio XE3) (Codename WATERDRAGON) + BDS11 Defined when compiling with BDS 11.0 (Embarcadero RAD Studio XE4) (Codename QUINTESSENCE) + BDS12 Defined when compiling with BDS 12.0 (Embarcadero RAD Studio XE5) (Codename ZEPHYR) + BDS14 Defined when compiling with BDS 14.0 (Embarcadero RAD Studio XE6) (Codename PROTEUS) + BDS15 Defined when compiling with BDS 15.0 (Embarcadero RAD Studio XE7) (Codename CARPATHIA) + BDS16 Defined when compiling with BDS 16.0 (Embarcadero RAD Studio XE8) (Codename ELBRUS) + BDS17 Defined when compiling with BDS 17.0 (Embarcadero RAD Studio 10) (Codename AITANA) BDS2_UP Defined when compiling with BDS 2.0 or higher BDS3_UP Defined when compiling with BDS 3.0 or higher BDS4_UP Defined when compiling with BDS 4.0 or higher @@ -269,6 +342,14 @@ BDS6_UP Defined when compiling with BDS 6.0 or higher BDS7_UP Defined when compiling with BDS 7.0 or higher BDS8_UP Defined when compiling with BDS 8.0 or higher + BDS9_UP Defined when compiling with BDS 9.0 or higher + BDS10_UP Defined when compiling with BDS 10.0 or higher + BDS11_UP Defined when compiling with BDS 11.0 or higher + BDS12_UP Defined when compiling with BDS 12.0 or higher + BDS14_UP Defined when compiling with BDS 14.0 or higher + BDS15_UP Defined when compiling with BDS 15.0 or higher + BDS16_UP Defined when compiling with BDS 16.0 or higher + BDS17_UP Defined when compiling with BDS 17.0 or higher - Compiler Versions @@ -295,6 +376,14 @@ COMPILER12 Defined when compiling with Delphi or C++Builder Personalities of BDS 6.0 COMPILER14 Defined when compiling with Delphi or C++Builder Personalities of BDS 7.0 COMPILER15 Defined when compiling with Delphi or C++Builder Personalities of BDS 8.0 + COMPILER16 Defined when compiling with Delphi or C++Builder Personalities of BDS 9.0 + COMPILER17 Defined when compiling with Delphi or C++Builder Personalities of BDS 10.0 + COMPILER18 Defined when compiling with Delphi or C++Builder Personalities of BDS 11.0 + COMPILER19 Defined when compiling with Delphi or C++Builder Personalities of BDS 12.0 + COMPILER20 Defined when compiling with Delphi or C++Builder Personalities of BDS 14.0 + COMPILER21 Defined when compiling with Delphi or C++Builder Personalities of BDS 15.0 + COMPILER22 Defined when compiling with Delphi or C++Builder Personalities of BDS 16.0 + COMPILER23 Defined when compiling with Delphi or C++Builder Personalities of BDS 17.0 COMPILER1_UP Defined when compiling with Delphi 1 or higher COMPILER2_UP Defined when compiling with Delphi 2 or C++Builder 1 or higher COMPILER3_UP Defined when compiling with Delphi 3 or higher @@ -310,6 +399,14 @@ COMPILER12_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 6.0 or higher COMPILER14_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 7.0 or higher COMPILER15_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 8.0 or higher + COMPILER16_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 9.0 or higher + COMPILER17_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 10.0 or higher + COMPILER18_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 11.0 or higher + COMPILER19_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 12.0 or higher + COMPILER20_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 14.0 or higher + COMPILER21_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 15.0 or higher + COMPILER22_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 16.0 or higher + COMPILER23_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 17.0 or higher - RTL Versions @@ -342,6 +439,14 @@ RTL200_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 6.0 or higher RTL210_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 7.0 or higher RTL220_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 8.0 or higher + RTL230_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 9.0 or higher + RTL240_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 10.0 or higher + RTL250_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 11.0 or higher + RTL260_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 12.0 or higher + RTL270_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 14.0 or higher + RTL280_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 15.0 or higher + RTL290_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 16.0 or higher + RTL300_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 17.0 or higher - CLR Versions @@ -383,6 +488,7 @@ SUPPORTS_NODEFINE Compiler supports the $NODEFINE directive (D4+/BCB3+) SUPPORTS_LONGWORD Compiler supports the LongWord type (unsigned 32 bit) (D4+/BCB4+) SUPPORTS_INT64 Compiler supports the Int64 type (D4+/BCB4+) + SUPPORTS_UINT64 Compiler supports the UInt64 type (D7+) SUPPORTS_DYNAMICARRAYS Compiler supports dynamic arrays (D4+/BCB4+) SUPPORTS_DEFAULTPARAMS Compiler supports default parameters (D4+/BCB4+) SUPPORTS_OVERLOAD Compiler supports overloading (D4+/BCB4+) @@ -433,6 +539,7 @@ HAS_UNIT_GIFIMG Unit GifImg exists (D11+) HAS_UNIT_ANSISTRINGS Unit AnsiStrings exists (D12+) HAS_UNIT_PNGIMAGE Unit PngImage exists (D12+) + HAS_UNIT_CHARACTER Unit Character exists (D12+) XPLATFORM_RTL The RTL supports crossplatform function names (e.g. RaiseLastOSError) (D6+/BCB6+/FPC) SUPPORTS_UNICODE string type is aliased to an unicode string (WideString or UnicodeString) (DX.NET, D12+) SUPPORTS_UNICODE_STRING Compiler supports UnicodeString (D12+) @@ -440,6 +547,17 @@ HAS_UNIT_RTTI Unit RTTI is available (D14+) SUPPORTS_CAST_INTERFACE_TO_OBJ The compiler supports casts from interfaces to objects (D14+) SUPPORTS_DELAYED_LOADING The compiler generates stubs for delaying imported function loads (D14+) + HAS_UNIT_REGULAREXPRESSIONSAPI Unit RegularExpressionsAPI is available (D15+) + HAS_UNIT_SYSTEM_UITYPES Unit System.UITypes is available (D16+) + HAS_UNIT_SYSTEM_ACTIONS Unit System.Actions is available (D17+) + DEPRECATED_SYSUTILS_ANSISTRINGS AnsiString functions from SysUtils are deprecated and moved to System.AnsiStrings (D18+) + HAS_PROPERTY_STYLEELEMENTS TControl has a StyleElements property (D17+) + HAS_AUTOMATIC_DB_FIELDS Database fields are automatically created/refreshed (D20+) + HAS_EARGUMENTEXCEPTION Exception class EArgumentException is available (D14+) + HAS_ENOTIMPLEMENTED Exception class ENotImplemented is available (D15+) + HAS_UNIT_VCL_THEMES Unit Vcl.Themes is available (D16+) + HAS_UNIT_UXTHEME Unit (Vcl.)UxTheme is available (D7+) + HAS_EXCEPTION_STACKTRACE Exception class has the StackTrace propery (D12+) - Compiler Settings @@ -488,9 +606,21 @@ {$DEFINE KYLIX} {$ENDIF LINUX} {$IFNDEF CLR} - {$DEFINE CPU386} // For Borland compilers select the x86 compat assembler by default - {$DEFINE CPU32} // Assume Borland compilers are 32-bit (rather than 64-bit) - {$DEFINE CPUASM} + {$IFNDEF CPUX86} + {$IFNDEF CPUX64} + {$DEFINE CPU386} // For Borland compilers select the x86 compat assembler by default + {$DEFINE CPU32} // Assume Borland compilers are 32-bit (rather than 64-bit) + {$DEFINE CPUASM} + {$ELSE ~CPUX64} + {$DEFINE CPU64} + {$DEFINE CPUASM} + {$DEFINE DELPHI64_TEMPORARY} + {$ENDIF ~CPUX64} + {$ELSE ~CPUX86} + {$DEFINE CPU386} + {$DEFINE CPU32} + {$DEFINE CPUASM} + {$ENDIF ~CPUX86} {$ENDIF ~CLR} {$ENDIF BORLAND} @@ -717,18 +847,138 @@ {$UNDEF UNKNOWN_COMPILER_VERSION} {$ENDIF VER220} + {$IFDEF VER230} // RAD Studio XE2 + {$DEFINE BDS} + {$DEFINE BDS9} + {$DEFINE COMPILER16} + {$IFDEF BCB} + {$DEFINE BCB16} + {$ELSE} + {$DEFINE DELPHI16} + {$DEFINE DELPHIXE2} // synonym to DELPHI16 + {$DEFINE DELPHICOMPILER16} + {$ENDIF BCB} + {$DEFINE RTL230_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER230} + + {$IFDEF VER240} // RAD Studio XE3 + {$DEFINE BDS} + {$DEFINE BDS10} + {$DEFINE COMPILER17} + {$IFDEF BCB} + {$DEFINE BCB17} + {$ELSE} + {$DEFINE DELPHI17} + {$DEFINE DELPHIXE3} // synonym to DELPHI17 + {$DEFINE DELPHICOMPILER17} + {$ENDIF BCB} + {$DEFINE RTL240_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER240} + + {$IFDEF VER250} // RAD Studio XE4 + {$DEFINE BDS} + {$DEFINE BDS11} + {$DEFINE COMPILER18} + {$IFDEF BCB} + {$DEFINE BCB18} + {$ELSE} + {$DEFINE DELPHI18} + {$DEFINE DELPHIXE4} // synonym to DELPHI18 + {$DEFINE DELPHICOMPILER18} + {$ENDIF BCB} + {$DEFINE RTL250_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER250} + + {$IFDEF VER260} // RAD Studio XE5 + {$DEFINE BDS} + {$DEFINE BDS12} + {$DEFINE COMPILER19} + {$IFDEF BCB} + {$DEFINE BCB19} + {$ELSE} + {$DEFINE DELPHI19} + {$DEFINE DELPHIXE5} // synonym to DELPHI19 + {$DEFINE DELPHICOMPILER19} + {$ENDIF BCB} + {$DEFINE RTL260_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER260} + + {$IFDEF VER270} // RAD Studio XE6 + {$DEFINE BDS} + {$DEFINE BDS14} + {$DEFINE COMPILER20} + {$IFDEF BCB} + {$DEFINE BCB20} + {$ELSE} + {$DEFINE DELPHI20} + {$DEFINE DELPHIXE6} // synonym to DELPHI20 + {$DEFINE DELPHICOMPILER20} + {$ENDIF BCB} + {$DEFINE RTL270_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER270} + + {$IFDEF VER280} // RAD Studio XE7 + {$DEFINE BDS} + {$DEFINE BDS15} + {$DEFINE COMPILER21} + {$IFDEF BCB} + {$DEFINE BCB21} + {$ELSE} + {$DEFINE DELPHI21} + {$DEFINE DELPHIXE7} // synonym to DELPHI21 + {$DEFINE DELPHICOMPILER21} + {$ENDIF BCB} + {$DEFINE RTL280_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER280} + + {$IFDEF VER290} // RAD Studio XE8 + {$DEFINE BDS} + {$DEFINE BDS16} + {$DEFINE COMPILER22} + {$IFDEF BCB} + {$DEFINE BCB22} + {$ELSE} + {$DEFINE DELPHI22} + {$DEFINE DELPHIXE8} // synonym to DELPHI22 + {$DEFINE DELPHICOMPILER22} + {$ENDIF BCB} + {$DEFINE RTL290_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER290} + + {$IFDEF VER300} // RAD Studio 10 + {$DEFINE BDS} + {$DEFINE BDS17} + {$DEFINE COMPILER23} + {$IFDEF BCB} + {$DEFINE BCB23} + {$ELSE} + {$DEFINE DELPHI23} + {$DEFINE DELPHIX_SEATTLE} // synonym to DELPHI23 + {$DEFINE DELPHICOMPILER23} + {$ENDIF BCB} + {$DEFINE RTL300_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER290} + {$IFDEF UNKNOWN_COMPILER_VERSION} // adjust for newer version (always use latest version) {$DEFINE BDS} - {$DEFINE BDS7} - {$DEFINE COMPILER15} + {$DEFINE BDS17} + {$DEFINE COMPILER23} {$IFDEF BCB} - {$DEFINE BCB15} + {$DEFINE BCB23} {$ELSE} - {$DEFINE DELPHI15} - {$DEFINE DELPHIXE} // synonym to DELPHI15 - {$DEFINE DELPHICOMPILER15} + {$DEFINE DELPHI23} + {$DEFINE DELPHIX_SEATTLE} // synonym to DELPHI23 + {$DEFINE DELPHICOMPILER23} {$ENDIF BCB} - {$DEFINE RTL220_UP} + {$DEFINE RTL300_UP} {$UNDEF UNKNOWN_COMPILER_VERSION} {$ENDIF} @@ -748,6 +998,14 @@ { DELPHIX_UP from DELPHIX mappings } {------------------------------------------------------------------------------} +{$IFDEF DELPHI23} {$DEFINE DELPHI23_UP} {$ENDIF} +{$IFDEF DELPHI22} {$DEFINE DELPHI22_UP} {$ENDIF} +{$IFDEF DELPHI21} {$DEFINE DELPHI21_UP} {$ENDIF} +{$IFDEF DELPHI20} {$DEFINE DELPHI20_UP} {$ENDIF} +{$IFDEF DELPHI19} {$DEFINE DELPHI19_UP} {$ENDIF} +{$IFDEF DELPHI18} {$DEFINE DELPHI18_UP} {$ENDIF} +{$IFDEF DELPHI17} {$DEFINE DELPHI17_UP} {$ENDIF} +{$IFDEF DELPHI16} {$DEFINE DELPHI16_UP} {$ENDIF} {$IFDEF DELPHI15} {$DEFINE DELPHI15_UP} {$ENDIF} {$IFDEF DELPHI14} {$DEFINE DELPHI14_UP} {$ENDIF} {$IFDEF DELPHI12} {$DEFINE DELPHI12_UP} {$ENDIF} @@ -767,6 +1025,46 @@ { DELPHIX_UP from DELPHIX_UP mappings } {------------------------------------------------------------------------------} +{$IFDEF DELPHI23_UP} + {$DEFINE DELPHIX_SEATTLE_UP} // synonym to DELPHI23_UP + {$DEFINE DELPHI22_UP} +{$ENDIF} + +{$IFDEF DELPHI22_UP} + {$DEFINE DELPHIXE8_UP} // synonym to DELPHI22_UP + {$DEFINE DELPHI21_UP} +{$ENDIF} + +{$IFDEF DELPHI21_UP} + {$DEFINE DELPHIXE7_UP} // synonym to DELPHI21_UP + {$DEFINE DELPHI20_UP} +{$ENDIF} + +{$IFDEF DELPHI20_UP} + {$DEFINE DELPHIXE6_UP} // synonym to DELPHI20_UP + {$DEFINE DELPHI19_UP} +{$ENDIF} + +{$IFDEF DELPHI19_UP} + {$DEFINE DELPHIXE5_UP} // synonym to DELPHI19_UP + {$DEFINE DELPHI18_UP} +{$ENDIF} + +{$IFDEF DELPHI18_UP} + {$DEFINE DELPHIXE4_UP} // synonym to DELPHI18_UP + {$DEFINE DELPHI17_UP} +{$ENDIF} + +{$IFDEF DELPHI17_UP} + {$DEFINE DELPHIXE3_UP} // synonym to DELPHI17_UP + {$DEFINE DELPHI16_UP} +{$ENDIF} + +{$IFDEF DELPHI16_UP} + {$DEFINE DELPHIXE2_UP} // synonym to DELPHI16_UP + {$DEFINE DELPHI15_UP} +{$ENDIF} + {$IFDEF DELPHI15_UP} {$DEFINE DELPHIXE_UP} // synonym to DELPHI15_UP {$DEFINE DELPHI14_UP} @@ -809,6 +1107,14 @@ { BCBX_UP from BCBX mappings } {------------------------------------------------------------------------------} +{$IFDEF BCB23} {$DEFINE BCB23_UP} {$ENDIF} +{$IFDEF BCB22} {$DEFINE BCB22_UP} {$ENDIF} +{$IFDEF BCB21} {$DEFINE BCB21_UP} {$ENDIF} +{$IFDEF BCB20} {$DEFINE BCB20_UP} {$ENDIF} +{$IFDEF BCB19} {$DEFINE BCB19_UP} {$ENDIF} +{$IFDEF BCB18} {$DEFINE BCB18_UP} {$ENDIF} +{$IFDEF BCB17} {$DEFINE BCB17_UP} {$ENDIF} +{$IFDEF BCB16} {$DEFINE BCB16_UP} {$ENDIF} {$IFDEF BCB15} {$DEFINE BCB15_UP} {$ENDIF} {$IFDEF BCB14} {$DEFINE BCB14_UP} {$ENDIF} {$IFDEF BCB12} {$DEFINE BCB12_UP} {$ENDIF} @@ -824,7 +1130,15 @@ { BCBX_UP from BCBX_UP mappings } {------------------------------------------------------------------------------} -{$IFDEF BCB15_UP} {$DEFINE BCB15_UP} {$ENDIF} +{$IFDEF BCB23_UP} {$DEFINE BCB22_UP} {$ENDIF} +{$IFDEF BCB22_UP} {$DEFINE BCB21_UP} {$ENDIF} +{$IFDEF BCB21_UP} {$DEFINE BCB20_UP} {$ENDIF} +{$IFDEF BCB20_UP} {$DEFINE BCB19_UP} {$ENDIF} +{$IFDEF BCB19_UP} {$DEFINE BCB18_UP} {$ENDIF} +{$IFDEF BCB18_UP} {$DEFINE BCB17_UP} {$ENDIF} +{$IFDEF BCB17_UP} {$DEFINE BCB16_UP} {$ENDIF} +{$IFDEF BCB16_UP} {$DEFINE BCB15_UP} {$ENDIF} +{$IFDEF BCB15_UP} {$DEFINE BCB14_UP} {$ENDIF} {$IFDEF BCB14_UP} {$DEFINE BCB12_UP} {$ENDIF} {$IFDEF BCB12_UP} {$DEFINE BCB11_UP} {$ENDIF} {$IFDEF BCB11_UP} {$DEFINE BCB10_UP} {$ENDIF} @@ -838,6 +1152,14 @@ { BDSX_UP from BDSX mappings } {------------------------------------------------------------------------------} +{$IFDEF BDS17} {$DEFINE BDS17_UP} {$ENDIF} +{$IFDEF BDS16} {$DEFINE BDS16_UP} {$ENDIF} +{$IFDEF BDS15} {$DEFINE BDS15_UP} {$ENDIF} +{$IFDEF BDS14} {$DEFINE BDS14_UP} {$ENDIF} +{$IFDEF BDS12} {$DEFINE BDS12_UP} {$ENDIF} +{$IFDEF BDS11} {$DEFINE BDS11_UP} {$ENDIF} +{$IFDEF BDS10} {$DEFINE BDS10_UP} {$ENDIF} +{$IFDEF BDS9} {$DEFINE BDS9_UP} {$ENDIF} {$IFDEF BDS8} {$DEFINE BDS8_UP} {$ENDIF} {$IFDEF BDS7} {$DEFINE BDS7_UP} {$ENDIF} {$IFDEF BDS6} {$DEFINE BDS6_UP} {$ENDIF} @@ -850,6 +1172,14 @@ { BDSX_UP from BDSX_UP mappings } {------------------------------------------------------------------------------} +{$IFDEF BDS17_UP} {$DEFINE BDS16_UP} {$ENDIF} +{$IFDEF BDS16_UP} {$DEFINE BDS15_UP} {$ENDIF} +{$IFDEF BDS15_UP} {$DEFINE BDS14_UP} {$ENDIF} +{$IFDEF BDS14_UP} {$DEFINE BDS12_UP} {$ENDIF} +{$IFDEF BDS12_UP} {$DEFINE BDS11_UP} {$ENDIF} +{$IFDEF BDS11_UP} {$DEFINE BDS10_UP} {$ENDIF} +{$IFDEF BDS10_UP} {$DEFINE BDS9_UP} {$ENDIF} +{$IFDEF BDS9_UP} {$DEFINE BDS8_UP} {$ENDIF} {$IFDEF BDS8_UP} {$DEFINE BDS7_UP} {$ENDIF} {$IFDEF BDS7_UP} {$DEFINE BDS6_UP} {$ENDIF} {$IFDEF BDS6_UP} {$DEFINE BDS5_UP} {$ENDIF} @@ -861,6 +1191,14 @@ { DELPHICOMPILERX_UP from DELPHICOMPILERX mappings } {------------------------------------------------------------------------------} +{$IFDEF DELPHICOMPILER23} {$DEFINE DELPHICOMPILER23_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER22} {$DEFINE DELPHICOMPILER22_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER21} {$DEFINE DELPHICOMPILER21_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER20} {$DEFINE DELPHICOMPILER20_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER19} {$DEFINE DELPHICOMPILER19_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER18} {$DEFINE DELPHICOMPILER18_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER17} {$DEFINE DELPHICOMPILER17_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER16} {$DEFINE DELPHICOMPILER16_UP} {$ENDIF} {$IFDEF DELPHICOMPILER15} {$DEFINE DELPHICOMPILER15_UP} {$ENDIF} {$IFDEF DELPHICOMPILER14} {$DEFINE DELPHICOMPILER14_UP} {$ENDIF} {$IFDEF DELPHICOMPILER12} {$DEFINE DELPHICOMPILER12_UP} {$ENDIF} @@ -880,6 +1218,14 @@ { DELPHICOMPILERX_UP from DELPHICOMPILERX_UP mappings } {------------------------------------------------------------------------------} +{$IFDEF DELPHICOMPILER23_UP} {$DEFINE DELPHICOMPILER22_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER22_UP} {$DEFINE DELPHICOMPILER21_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER21_UP} {$DEFINE DELPHICOMPILER20_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER20_UP} {$DEFINE DELPHICOMPILER19_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER19_UP} {$DEFINE DELPHICOMPILER18_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER18_UP} {$DEFINE DELPHICOMPILER17_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER17_UP} {$DEFINE DELPHICOMPILER16_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER16_UP} {$DEFINE DELPHICOMPILER15_UP} {$ENDIF} {$IFDEF DELPHICOMPILER15_UP} {$DEFINE DELPHICOMPILER14_UP} {$ENDIF} {$IFDEF DELPHICOMPILER14_UP} {$DEFINE DELPHICOMPILER12_UP} {$ENDIF} {$IFDEF DELPHICOMPILER12_UP} {$DEFINE DELPHICOMPILER11_UP} {$ENDIF} @@ -899,6 +1245,14 @@ { COMPILERX_UP from COMPILERX mappings } {------------------------------------------------------------------------------} +{$IFDEF COMPILER23} {$DEFINE COMPILER23_UP} {$ENDIF} +{$IFDEF COMPILER22} {$DEFINE COMPILER22_UP} {$ENDIF} +{$IFDEF COMPILER21} {$DEFINE COMPILER21_UP} {$ENDIF} +{$IFDEF COMPILER20} {$DEFINE COMPILER20_UP} {$ENDIF} +{$IFDEF COMPILER19} {$DEFINE COMPILER19_UP} {$ENDIF} +{$IFDEF COMPILER18} {$DEFINE COMPILER18_UP} {$ENDIF} +{$IFDEF COMPILER17} {$DEFINE COMPILER17_UP} {$ENDIF} +{$IFDEF COMPILER16} {$DEFINE COMPILER16_UP} {$ENDIF} {$IFDEF COMPILER15} {$DEFINE COMPILER15_UP} {$ENDIF} {$IFDEF COMPILER14} {$DEFINE COMPILER14_UP} {$ENDIF} {$IFDEF COMPILER12} {$DEFINE COMPILER12_UP} {$ENDIF} @@ -919,6 +1273,14 @@ { COMPILERX_UP from COMPILERX_UP mappings } {------------------------------------------------------------------------------} +{$IFDEF COMPILER23_UP} {$DEFINE COMPILER22_UP} {$ENDIF} +{$IFDEF COMPILER22_UP} {$DEFINE COMPILER21_UP} {$ENDIF} +{$IFDEF COMPILER21_UP} {$DEFINE COMPILER20_UP} {$ENDIF} +{$IFDEF COMPILER20_UP} {$DEFINE COMPILER19_UP} {$ENDIF} +{$IFDEF COMPILER19_UP} {$DEFINE COMPILER18_UP} {$ENDIF} +{$IFDEF COMPILER18_UP} {$DEFINE COMPILER17_UP} {$ENDIF} +{$IFDEF COMPILER17_UP} {$DEFINE COMPILER16_UP} {$ENDIF} +{$IFDEF COMPILER16_UP} {$DEFINE COMPILER15_UP} {$ENDIF} {$IFDEF COMPILER15_UP} {$DEFINE COMPILER14_UP} {$ENDIF} {$IFDEF COMPILER14_UP} {$DEFINE COMPILER12_UP} {$ENDIF} {$IFDEF COMPILER12_UP} {$DEFINE COMPILER11_UP} {$ENDIF} @@ -938,6 +1300,14 @@ { RTLX_UP from RTLX_UP mappings } {------------------------------------------------------------------------------} +{$IFDEF RTL300_UP} {$DEFINE RTL290_UP} {$ENDIF} +{$IFDEF RTL290_UP} {$DEFINE RTL280_UP} {$ENDIF} +{$IFDEF RTL280_UP} {$DEFINE RTL270_UP} {$ENDIF} +{$IFDEF RTL270_UP} {$DEFINE RTL260_UP} {$ENDIF} +{$IFDEF RTL260_UP} {$DEFINE RTL250_UP} {$ENDIF} +{$IFDEF RTL250_UP} {$DEFINE RTL240_UP} {$ENDIF} +{$IFDEF RTL240_UP} {$DEFINE RTL230_UP} {$ENDIF} +{$IFDEF RTL230_UP} {$DEFINE RTL220_UP} {$ENDIF} {$IFDEF RTL220_UP} {$DEFINE RTL210_UP} {$ENDIF} {$IFDEF RTL210_UP} {$DEFINE RTL200_UP} {$ENDIF} {$IFDEF RTL200_UP} {$DEFINE RTL190_UP} {$ENDIF} @@ -1100,7 +1470,7 @@ {$DEFINE SUPPORTS_SINGLE} {$DEFINE SUPPORTS_DOUBLE} {$DEFINE SUPPORTS_EXTENDED} - {$DEFINE SUPPORTS_PACKAGES} + {$DEFINE SUPPORTS_PACKAGES} {$ENDIF COMPILER1_UP} {$IFDEF COMPILER2_UP} @@ -1154,6 +1524,7 @@ {$IFDEF COMPILER7_UP} {$DEFINE SUPPORTS_UNSAFE_WARNINGS} + {$DEFINE SUPPORTS_UINT64} {$ENDIF COMPILER7_UP} {$IFDEF COMPILER9_UP} @@ -1208,6 +1579,10 @@ {$DEFINE SUPPORTS_DELAYED_LOADING} {$ENDIF COMPILER14_UP} +{$IFDEF COMPILER16_UP} + {$DEFINE USE_64BIT_TYPES} +{$ENDIF COMPILER16_UP} + {$IFDEF RTL130_UP} {$DEFINE HAS_UNIT_CONTNRS} {$ENDIF RTL130_UP} @@ -1224,6 +1599,10 @@ {$DEFINE XPLATFORM_RTL} {$ENDIF RTL140_UP} +{$IFDEF RTL150_UP} + {$DEFINE HAS_UNIT_UXTHEME} +{$ENDIF RTL150_UP} + {$IFDEF RTL170_UP} {$DEFINE HAS_UNIT_HTTPPROD} {$ENDIF RTL170_UP} @@ -1235,8 +1614,38 @@ {$IFDEF RTL200_UP} {$DEFINE HAS_UNIT_ANSISTRINGS} {$DEFINE HAS_UNIT_PNGIMAGE} + {$DEFINE HAS_UNIT_CHARACTER} + {$DEFINE HAS_EXCEPTION_STACKTRACE} {$ENDIF RTL200_UP} +{$IFDEF RTL210_UP} + {$DEFINE HAS_EARGUMENTEXCEPTION} +{$ENDIF RTL210_UP} + +{$IFDEF RTL220_UP} + {$DEFINE HAS_UNIT_REGULAREXPRESSIONSAPI} + {$DEFINE HAS_ENOTIMPLEMENTED} +{$ENDIF RTL220_UP} + +{$IFDEF RTL230_UP} + {$DEFINE HAS_UNITSCOPE} + {$DEFINE HAS_UNIT_SYSTEM_UITYPES} + {$DEFINE HAS_UNIT_VCL_THEMES} +{$ENDIF RTL230_UP} + +{$IFDEF RTL240_UP} + {$DEFINE HAS_UNIT_SYSTEM_ACTIONS} + {$DEFINE HAS_PROPERTY_STYLEELEMENTS} +{$ENDIF RTL240_UP} + +{$IFDEF RTL250_UP} + {$DEFINE DEPRECATED_SYSUTILS_ANSISTRINGS} +{$ENDIF RTL250_UP} + +{$IFDEF RTL270_UP} + {$DEFINE HAS_AUTOMATIC_DB_FIELDS} +{$ENDIF RTL270_UP} + {------------------------------------------------------------------------------} { Cross-platform related defines } {------------------------------------------------------------------------------} @@ -1304,5 +1713,4 @@ // for Delphi/BCB trial versions remove the point from the line below {.$UNDEF SUPPORTS_WEAKPACKAGEUNIT} -{$ENDIF ~JEDI_INC} - +{$ENDIF ~JEDI_INC} \ No newline at end of file diff --git a/Source/EditDesigner.pas b/Source/EditDesigner.pas index a4c83d9..44c0164 100644 --- a/Source/EditDesigner.pas +++ b/Source/EditDesigner.pas @@ -1,4 +1,4 @@ -//*********************************************************** +//*********************************************************** // TEditDesigner * // * // For Delphi * @@ -47,7 +47,7 @@ interface {$I EWB.inc} uses -{$IFDEF USE_Extras}EwbAcc, Graphics, {$ENDIF} +{$IFDEF USE_Extras}Graphics, {$ENDIF} EmbeddedWB, ActiveX, MSHTML_EWB, Classes, Windows; const diff --git a/Source/EmbeddedWB.pas b/Source/EmbeddedWB.pas index bb77095..5108475 100644 --- a/Source/EmbeddedWB.pas +++ b/Source/EmbeddedWB.pas @@ -615,7 +615,7 @@ implementation {$IFDEF USE_EwbDDE} EwbDDE, {$ENDIF} - Registry, CommCtrl, ComObj, ShellAPI, OleServer, IEConst, WinInet; + System.Win.Registry, CommCtrl, System.Win.ComObj, ShellAPI, OleServer, EWB.IEConst, WinInet; var // Boolean variables that must be global to restore settings for MDI cases @@ -2600,7 +2600,9 @@ procedure TEmbeddedWB.SetUserAgentInt; begin FUserAgentInt := FUserAgent; Control.OnAmbientPropertyChange(DISPID_AMBIENT_USERAGENT); + {$IFNDEF DELPHIX_SEATTLE_UP } _Release; + {$ENDIF} end; end; end; diff --git a/Source/EwbAcc.pas b/Source/EwbAcc.pas index 2abdc0e..9fb16ba 100644 --- a/Source/EwbAcc.pas +++ b/Source/EwbAcc.pas @@ -39,7 +39,7 @@ interface {$I EWB.inc} uses - ActiveX, SysUtils, ShlObj, Windows, UrlMon, IEConst; + ActiveX, SysUtils, ShlObj, Windows, UrlMon, EWB.IEConst; type IObjectIdentity = interface diff --git a/Source/EwbBehaviorsComp.pas b/Source/EwbBehaviorsComp.pas index 2a5ff2e..e5e2e6a 100644 --- a/Source/EwbBehaviorsComp.pas +++ b/Source/EwbBehaviorsComp.pas @@ -44,7 +44,7 @@ interface uses {$IFDEF DELPHI6_UP}Variants, {$ENDIF} - Windows, Classes, Graphics, ActiveX, Mshtml_Ewb, EwbAcc, EwbClasses, EwbEvents, + Windows, Classes, Graphics, ActiveX, Mshtml_Ewb, EwbClasses, EwbEvents, EwbEventsComp; type diff --git a/Source/EwbControlComponent.pas b/Source/EwbControlComponent.pas index d19f753..0029dce 100644 --- a/Source/EwbControlComponent.pas +++ b/Source/EwbControlComponent.pas @@ -1,37 +1,37 @@ -//*********************************************************** -// EwbControl component * -// * -// For Delphi 5 to XE * -// Freeware Component * -// by * -// (smot) * -// * -// Documentation and updated versions: * -// * -// http://www.bsalsa.com * -//*********************************************************** -{*******************************************************************************} -{LICENSE: -THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, -EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED -WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. -YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE -AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE -AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE -OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED -OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, -INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR -OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, -AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY -DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. - -You may use, change or modify the component under 4 conditions: -1. In your website, add a link to "http://www.bsalsa.com" -2. In your application, add credits to "Embedded Web Browser" -3. Mail me (bsalsa@gmail.com) any code change in the unit - for the benefit of the other users. -4. Please, consider donation in our web site! -{*******************************************************************************} +// *********************************************************** +// EwbControl component * +// * +// For Delphi 5 to XE * +// Freeware Component * +// by * +// (smot) * +// * +// Documentation and updated versions: * +// * +// http://www.bsalsa.com * +// *********************************************************** +{ ******************************************************************************* } +{ LICENSE: + THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, + EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED + WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. + YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE + AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE + AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE + OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED + OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, + INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR + OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, + AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY + DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. + + You may use, change or modify the component under 4 conditions: + 1. In your website, add a link to "http://www.bsalsa.com" + 2. In your application, add credits to "Embedded Web Browser" + 3. Mail me (bsalsa@gmail.com) any code change in the unit + for the benefit of the other users. + 4. Please, consider donation in our web site! + {******************************************************************************* } unit EwbControlComponent; @@ -42,9 +42,9 @@ interface uses Windows, Messages, SysUtils, Classes, Forms, EWBMouseHook; -{============================================================================} +{ ============================================================================ } // Mouse WheelFix -{============================================================================} +{ ============================================================================ } type TMouseWheelFix = class(TPersistent) private @@ -58,13 +58,13 @@ TMouseWheelFix = class(TPersistent) OnMouseWheel: TMouseWheelEvent; published property Active: Boolean read FActive write SetActive default True; - property ActiveFormOnly: Boolean read FActiveFormOnly write SetActiveFormOnly - default False; + property ActiveFormOnly: Boolean read FActiveFormOnly + write SetActiveFormOnly default False; end; - {============================================================================} + { ============================================================================ } // FocusControl - {============================================================================} + { ============================================================================ } type TFocusControl = class(TPersistent) private @@ -75,73 +75,72 @@ TFocusControl = class(TPersistent) property Active: Boolean read FActive write SetActive default True; end; - {============================================================================} + { ============================================================================ } // OnMessage Handler - {============================================================================} -{ -type - TMessageHandler = class(TPersistent) - private + { ============================================================================ } + { + type + TMessageHandler = class(TPersistent) + private FActive: Boolean; FDesignMode: Boolean; FOnMessage: TMessageEvent; procedure SetActive(const Value: Boolean); - published + published property Active: Boolean read FActive write SetActive default True; - end; -} + end; + } {$IFDEF Enable_InternetFeatures} - {============================================================================} + { ============================================================================ } { Feature Controls } { http://msdn.microsoft.com/en-us/library/ms537169(VS.85).aspx } { TInternetFeatures = ( -FEATURE_OBJECT_CACHING -FEATURE_ZONE_ELEVATION -FEATURE_MIME_HANDLING -FEATURE_MIME_SNIFFING -FEATURE_WINDOW_RESTRICTIONS -FEATURE_WEBOC_POPUPMANAGEMENT -FEATURE_BEHAVIORS -FEATURE_DISABLE_MK_PROTOCOL -FEATURE_LOCALMACHINE_LOCKDOWN -FEATURE_SECURITYBAND -FEATURE_RESTRICT_ACTIVEXINSTALL -FEATURE_VALIDATE_NAVIGATE_URL -FEATURE_RESTRICT_FILEDOWNLOAD -FEATURE_ADDON_MANAGEMENT -FEATURE_PROTOCOL_LOCKDOWN -FEATURE_HTTP_USERNAME_PASSWORD_DISABLE -FEATURE_SAFE_BINDTOOBJECT -FEATURE_UNC_SAVEDFILECHECK -FEATURE_GET_URL_DOM_FILEPATH_UNENCODED -FEATURE_TABBED_BROWSING -FEATURE_SSLUX -FEATURE_DISABLE_NAVIGATION_SOUNDS -FEATURE_DISABLE_LEGACY_COMPRESSION -FEATURE_FORCE_ADDR_AND_STATUS -FEATURE_XMLHTTP -FEATURE_DISABLE_TELNET_PROTOCOL -FEATURE_FEEDS -FEATURE_BLOCK_INPUT_PROMPTS -FEATURE_ENTRY_COUNT); + FEATURE_OBJECT_CACHING + FEATURE_ZONE_ELEVATION + FEATURE_MIME_HANDLING + FEATURE_MIME_SNIFFING + FEATURE_WINDOW_RESTRICTIONS + FEATURE_WEBOC_POPUPMANAGEMENT + FEATURE_BEHAVIORS + FEATURE_DISABLE_MK_PROTOCOL + FEATURE_LOCALMACHINE_LOCKDOWN + FEATURE_SECURITYBAND + FEATURE_RESTRICT_ACTIVEXINSTALL + FEATURE_VALIDATE_NAVIGATE_URL + FEATURE_RESTRICT_FILEDOWNLOAD + FEATURE_ADDON_MANAGEMENT + FEATURE_PROTOCOL_LOCKDOWN + FEATURE_HTTP_USERNAME_PASSWORD_DISABLE + FEATURE_SAFE_BINDTOOBJECT + FEATURE_UNC_SAVEDFILECHECK + FEATURE_GET_URL_DOM_FILEPATH_UNENCODED + FEATURE_TABBED_BROWSING + FEATURE_SSLUX + FEATURE_DISABLE_NAVIGATION_SOUNDS + FEATURE_DISABLE_LEGACY_COMPRESSION + FEATURE_FORCE_ADDR_AND_STATUS + FEATURE_XMLHTTP + FEATURE_DISABLE_TELNET_PROTOCOL + FEATURE_FEEDS + FEATURE_BLOCK_INPUT_PROMPTS + FEATURE_ENTRY_COUNT); } - TInternetFeatureList = ( - ObjectCaching, ZoneElevation, MimeHandling, MimeSniffing, WindowRestrictions, - WebocPopupManagement, Behaviors, DisableMkProtocol, LocalMachineLockDown, - Securityband, RestrictActivexInstall, ValidateNavigateUrl, RestrictFileDownload, - AddonManagement, ProtocolLockdown, HttpUsernamePasswordDisable, SafeBindToObject, - UncSavedFileCheck, GetUrlDomFilePathUnencoded, TabbedBrowsing, Sslux, - DisableNavigationSounds, DisableLegacyCompression, ForceAddrAndStatus, - XmlHttp, DisableTelnetProtocol, Feeds, BlockInputPrompts, EntryCount - ); + TInternetFeatureList = (ObjectCaching, ZoneElevation, MimeHandling, + MimeSniffing, WindowRestrictions, WebocPopupManagement, Behaviors, + DisableMkProtocol, LocalMachineLockDown, Securityband, + RestrictActivexInstall, ValidateNavigateUrl, RestrictFileDownload, + AddonManagement, ProtocolLockdown, HttpUsernamePasswordDisable, + SafeBindToObject, UncSavedFileCheck, GetUrlDomFilePathUnencoded, + TabbedBrowsing, Sslux, DisableNavigationSounds, DisableLegacyCompression, + ForceAddrAndStatus, XmlHttp, DisableTelnetProtocol, Feeds, + BlockInputPrompts, EntryCount); TInternetFeatures = set of TInternetFeatureList; {$ENDIF Enable_InternetFeatures} - -{============================================================================} -// TEwbControl -{============================================================================} + { ============================================================================ } + // TEwbControl + { ============================================================================ } type TEwbControl = class(TComponent) @@ -149,23 +148,23 @@ TEwbControl = class(TComponent) { Private declarations } FMouseWheelFix: TMouseWheelFix; FFocusControl: TFocusControl; - // FMessageHandler: TMessageHandler; - // FOnMessage: TMessageEvent; + // FMessageHandler: TMessageHandler; + // FOnMessage: TMessageEvent; FOnMouseWheel: TMouseWheelEvent; - FDesignMode: Boolean; + // FDesignMode: Boolean; {$IFDEF Enable_InternetFeatures} FInternetFeatures: TInternetFeatures; procedure SetInternetFeatures(const Value: TInternetFeatures); + function DesignMode: Boolean; {$ENDIF} - // procedure DoMessage(var Msg: TMsg; var Handled: Boolean); + // procedure DoMessage(var Msg: TMsg; var Handled: Boolean); protected { Protected declarations } - // procedure ProcessWBEvents(var Msg: TMsg; var Handled: Boolean); + // procedure ProcessWBEvents(var Msg: TMsg; var Handled: Boolean); {$IFDEF Enable_InternetFeatures} procedure UpdateInternetFeatures; procedure SetDefaultInternetFeatures; {$ENDIF} - public { Public declarations } constructor Create(AOwner: TComponent); override; @@ -173,13 +172,13 @@ TEwbControl = class(TComponent) procedure Loaded; override; published { Published declarations } - property MouseWheelFix: TMouseWheelFix read FMouseWheelFix write - FMouseWheelFix; + property MouseWheelFix: TMouseWheelFix read FMouseWheelFix + write FMouseWheelFix; property FocusControl: TFocusControl read FFocusControl write FFocusControl; // property MessageHandler: TMessageHandler read FMessageHandler write FMessageHandler; // property OnMessage: TMessageEvent read FOnMessage write FOnMessage; - property OnMouseWheel: TMouseWheelEvent read FOnMouseWheel write - FOnMouseWheel; + property OnMouseWheel: TMouseWheelEvent read FOnMouseWheel + write FOnMouseWheel; {$IFDEF Enable_InternetFeatures} property InternetFeatures: TInternetFeatures read FInternetFeatures write SetInternetFeatures default []; @@ -189,24 +188,28 @@ TEwbControl = class(TComponent) implementation uses - EwbFocusControl, EwbAcc, IEConst; + EwbFocusControl, EwbAcc, EWB.IEConst; procedure TFocusControl.SetActive(const Value: Boolean); begin FActive := Value; - if not FDesignMode then - TEWBFocusControl.Activate(Value); + try + if not FDesignMode then + TEWBFocusControl.Activate(Value); + except + + end; end; -{procedure TMessageHandler.SetActive(const Value: Boolean); -begin +{ procedure TMessageHandler.SetActive(const Value: Boolean); + begin FActive := Value; if not FDesignMode then begin - if FActive then - Application.OnMessage := FOnMessage; + if FActive then + Application.OnMessage := FOnMessage; end; -end; } + end; } procedure TMouseWheelFix.SetActiveFormOnly(const Value: Boolean); begin @@ -247,30 +250,34 @@ procedure TEwbControl.Loaded; inherited Loaded; if Assigned(OnMouseWheel) then FMouseWheelFix.OnMouseWheel := OnMouseWheel; - { if Assigned(FMessageHandler) then - FMessageHandler.FOnMessage := DoMessage; } + { if Assigned(FMessageHandler) then + FMessageHandler.FOnMessage := DoMessage; } +end; + +function TEwbControl.DesignMode: Boolean; +begin + Result := (csDesigning in ComponentState); end; constructor TEwbControl.Create(AOwner: TComponent); begin inherited Create(AOwner); - FDesignMode := (csDesigning in ComponentState); + // FDesignMode := (csDesigning in ComponentState); FMouseWheelFix := TMouseWheelFix.Create; - FMouseWheelFix.FDesignMode := FDesignMode; - FMouseWheelFix.FActive := True; + FMouseWheelFix.FDesignMode := DesignMode; + FMouseWheelFix.Active := True; FFocusControl := TFocusControl.Create; - FFocusControl.FDesignMode := FDesignMode; - FFocusControl.FActive := True; + FFocusControl.FDesignMode := DesignMode; + FFocusControl.Active := True; {$IFDEF Enable_InternetFeatures} - if FDesignMode then + if DesignMode then SetDefaultInternetFeatures; {$ENDIF} - - { FMessageHandler := TMessageHandler.Create; + { FMessageHandler := TMessageHandler.Create; FMessageHandler.FDesignMode := FDesignMode; FMessageHandler.FOnMessage := DoMessage; @@ -279,14 +286,14 @@ constructor TEwbControl.Create(AOwner: TComponent); destructor TEwbControl.Destroy; begin - if not (csDesigning in ComponentState) then + if not(csDesigning in ComponentState) then begin - { if Assigned(FMessageHandler) then - begin + { if Assigned(FMessageHandler) then + begin FMessageHandler.Active := False; Application.OnMessage := nil; FreeAndNil(FMessageHandler); - end; } + end; } if Assigned(FMouseWheelFix) then begin FMouseWheelFix.Active := False; @@ -309,7 +316,8 @@ procedure TEwbControl.UpdateInternetFeatures; begin if (FInternetFeatures <> []) then for dco := Low(TInternetFeatureList) to High(TInternetFeatureList) do - CoInternetSetFeatureEnabled(TInternetFeature(dco), FEATURE_FROM_PROCESS, (dco in FInternetFeatures)); + CoInternetSetFeatureEnabled(TInternetFeature(dco), FEATURE_FROM_PROCESS, + (dco in FInternetFeatures)); end; procedure TEwbControl.SetInternetFeatures(const Value: TInternetFeatures); @@ -324,25 +332,25 @@ procedure TEwbControl.SetDefaultInternetFeatures; begin FInternetFeatures := []; for dco := Low(TInternetFeatureList) to High(TInternetFeatureList) do - if CoInternetIsFeatureEnabled(TInternetFeature(dco), FEATURE_FROM_PROCESS) = S_OK then + if CoInternetIsFeatureEnabled(TInternetFeature(dco), FEATURE_FROM_PROCESS) = S_OK + then FInternetFeatures := FInternetFeatures + [TInternetFeatureList(dco)]; end; {$ENDIF} - { -procedure TEwbControl.ProcessWBEvents(var Msg: TMsg; var Handled: Boolean); -begin -end; + procedure TEwbControl.ProcessWBEvents(var Msg: TMsg; var Handled: Boolean); + begin + end; -procedure TEwbControl.DoMessage(var Msg: TMsg; var Handled: Boolean); -begin + procedure TEwbControl.DoMessage(var Msg: TMsg; var Handled: Boolean); + begin if Assigned(FOnMessage) then begin - FOnMessage(Msg, Handled); + FOnMessage(Msg, Handled); end; ProcessWBEvents(Msg, Handled); -end; + end; } end. diff --git a/Source/EwbCore.pas b/Source/EwbCore.pas index b52c48e..14bdb75 100644 --- a/Source/EwbCore.pas +++ b/Source/EwbCore.pas @@ -1,40 +1,40 @@ -//************************************************************* -// TEwbCore * -// * -// Freeware Component * -// For Delphi * -// For Delphi 5 to Delphi XE * -// * -// Developing Team: * -// Eran Bodankin (bsalsa) -(bsalsa@gmail.com) * -// Serge Voloshenyuk (SergeV@bsalsa.com) * -// Thomas Stutz (smot777@yahoo.com * -// * -// Documentation and updated versions: * -// * -// http://www.bsalsa.com * -//************************************************************* -{LICENSE: -THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, -EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED -WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. -YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE -AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE -AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE -OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED -OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, -INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR -OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, -AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY -DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. - -You may use/change/modify the component under 4 conditions: -1. In your web site, add a link to "http://www.bsalsa.com" -2. In your application, add credits to "Embedded Web Browser" -3. Mail me (bsalsa@gmail.com) any code change in the unit for the benefit - of the other users. -4. Please, consider donation in our web site! -{*******************************************************************************} +// ************************************************************* +// TEwbCore * +// * +// Freeware Component * +// For Delphi * +// For Delphi 5 to Delphi XE * +// * +// Developing Team: * +// Eran Bodankin (bsalsa) -(bsalsa@gmail.com) * +// Serge Voloshenyuk (SergeV@bsalsa.com) * +// Thomas Stutz (smot777@yahoo.com * +// * +// Documentation and updated versions: * +// * +// http://www.bsalsa.com * +// ************************************************************* +{ LICENSE: + THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, + EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED + WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. + YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE + AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE + AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE + OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED + OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, + INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR + OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, + AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY + DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. + + You may use/change/modify the component under 4 conditions: + 1. In your web site, add a link to "http://www.bsalsa.com" + 2. In your application, add credits to "Embedded Web Browser" + 3. Mail me (bsalsa@gmail.com) any code change in the unit for the benefit + of the other users. + 4. Please, consider donation in our web site! + {******************************************************************************* } unit EwbCore; @@ -45,195 +45,187 @@ interface uses {$IFDEF DELPHI6_UP}Variants, {$ENDIF} Dialogs, Windows, Messages, Classes, MSHTML_EWB, EWBAcc, Controls, Forms, - ExtCtrls, ActiveX, ShlObj, SHDocVw_EWB, UrlMon, IEConst; + ExtCtrls, ActiveX, ShlObj, SHDocVw_EWB, UrlMon, EWB.IEConst; type TCustomEmbeddedWB = class; TOleCmdArray = array of TOleCmd; - TDragDropHandlingType = ( - ddtMS, // Microsoft implementation + TDragDropHandlingType = (ddtMS, // Microsoft implementation ddtMy, // TCustomEmbeddedWB event handlers ddtCustom, // granted by user in OnGetDropTarget event handler ddtNo // No drag and drop ); TDocDesignMode = (ddmOn, ddmOff, ddmInherit, ddmUnknown); - TIEPopupMenu = ( - rcmDefault, - rcmImage, - rcmControl, - rcmTable, - rcmSelText, - rcmAnchor, - rcmUnKnown, - rcmImageArt, - rcmImgDynSrc, - rcmDebug, - rcmAll - ); + TIEPopupMenu = (rcmDefault, rcmImage, rcmControl, rcmTable, rcmSelText, + rcmAnchor, rcmUnKnown, rcmImageArt, rcmImgDynSrc, rcmDebug, rcmAll); TIEPopupMenus = set of TIEPopupMenu; - TIEPopupMenuItem = ( - rcsBack, - rcsForward, - rcsSavePageBkg, - rcsSetAsBkg, - rcsCopyBkg, - rcsSetAsDeskT, - rcsSelectAll, - rcsPaste, - rcsCreateSC, - rcsAddToFav, - rcsEncoding, - rcsRefresh, - rcsViewSource, - rcsProperties, - rcsPrint, - rcsOpenNWindow, - rcsOpenLink - ); + TIEPopupMenuItem = (rcsBack, rcsForward, rcsSavePageBkg, rcsSetAsBkg, + rcsCopyBkg, rcsSetAsDeskT, rcsSelectAll, rcsPaste, rcsCreateSC, rcsAddToFav, + rcsEncoding, rcsRefresh, rcsViewSource, rcsProperties, rcsPrint, + rcsOpenNWindow, rcsOpenLink); TIEPopupMenuItems = set of TIEPopupMenuItem; - {============================================================================} + { ============================================================================ } { Controlling Download and Execution } { http://msdn.microsoft.com/en-us/library/aa770041.aspx } { TDownloadControlOption = ( - DLCTL_DLIMAGES, DLCTL_VIDEOS, DLCTL_BGSOUNDS, - DLCTL_NO_SCRIPTS, DLCTL_NO_JAVA, - DLCTL_NO_RUNACTIVEXCTLS, DLCTL_NO_DLACTIVEXCTLS, - DLCTL_DOWNLOADONLY, - DLCTL_NO_FRAMEDOWNLOAD, - DLCTL_RESYNCHRONIZE, - DLCTL_PRAGMA_NO_CACHE, - DLCTL_NO_BEHAVIORS, DLCTL_NO_METACHARSET, - DLCTL_URL_ENCODING_DISABLE_UTF8, DLCTL_URL_ENCODING_ENABLE_UTF8, - DLCTL_FORCEOFFLINE, DLCTL_NO_CLIENTPULL, - DLCTL_SILENT, DLCTL_OFFLINE); + DLCTL_DLIMAGES, DLCTL_VIDEOS, DLCTL_BGSOUNDS, + DLCTL_NO_SCRIPTS, DLCTL_NO_JAVA, + DLCTL_NO_RUNACTIVEXCTLS, DLCTL_NO_DLACTIVEXCTLS, + DLCTL_DOWNLOADONLY, + DLCTL_NO_FRAMEDOWNLOAD, + DLCTL_RESYNCHRONIZE, + DLCTL_PRAGMA_NO_CACHE, + DLCTL_NO_BEHAVIORS, DLCTL_NO_METACHARSET, + DLCTL_URL_ENCODING_DISABLE_UTF8, DLCTL_URL_ENCODING_ENABLE_UTF8, + DLCTL_FORCEOFFLINE, DLCTL_NO_CLIENTPULL, + DLCTL_SILENT, DLCTL_OFFLINE); } - TDownloadControlOption = ( - DownloadImages, DownloadVideos, DownloadBGSounds, DontExecuteScripts, - DontExecuteJava, DontExecuteActiveX, DontDownloadActiveX, - DownloadButDontDisplay, DontDownloadFrame, CheckPageResynchronize, - DownloadAndIgnoreCache, DontDownloadBehaviors, SuppressedMetaCharset, - DisableUrlIfEncodingUTF8, EnableUrlIfEncodingUTF8, + TDownloadControlOption = (DownloadImages, DownloadVideos, DownloadBGSounds, + DontExecuteScripts, DontExecuteJava, DontExecuteActiveX, + DontDownloadActiveX, DownloadButDontDisplay, DontDownloadFrame, + CheckPageResynchronize, DownloadAndIgnoreCache, DontDownloadBehaviors, + SuppressedMetaCharset, DisableUrlIfEncodingUTF8, EnableUrlIfEncodingUTF8, ForceOfflineMode, DontPerformClientPull, DownloadInSilentMode, WorkOffline); TDownloadControlOptions = set of TDownloadControlOption; { Doc Host Flags: http://msdn.microsoft.com/en-us/library/aa753277.aspx } { TUserInterfaceOption = (DIALOG, DISABLE_HELP_MENU, NO3DBORDER, - SCROLL_NO, DISABLE_SCRIPT_INACTIVE, OPENNEWWIN, DISABLE_OFFSCREEN, - FLAT_SCROLLBAR, DIV_BLOCKDEFAULT, ACTIVATE_CLIENTHIT_ONLY, - OVERRIDEBEHAVIORFACTORY, - CODEPAGELINKEDFONTS, URL_ENCODING_DISABLE_UTF8, - URL_ENCODING_ENABLE_UTF8, - ENABLE_FORMS_AUTOCOMPLETE, ENABLE_INPLACE_NAVIGATION, - IME_ENABLE_RECONVERSION, - THEME, NOTHEME, NOPICS, NO3DOUTERBORDER, DISABLE_EDIT_NS_FIXUP, - LOCAL_MACHINE_ACCESS_CHECK, DISABLE_UNTRUSTEDPROTOCOL, - HOST_NAVIGATES, ENABLE_REDIRECT_NOTIFICATION, USE_WINDOWLESS_SELECTCONTROL, - USE_WINDOWED_SELECTCONTROL, ENABLE_ACTIVEX_INACTIVATE_MODE); + SCROLL_NO, DISABLE_SCRIPT_INACTIVE, OPENNEWWIN, DISABLE_OFFSCREEN, + FLAT_SCROLLBAR, DIV_BLOCKDEFAULT, ACTIVATE_CLIENTHIT_ONLY, + OVERRIDEBEHAVIORFACTORY, + CODEPAGELINKEDFONTS, URL_ENCODING_DISABLE_UTF8, + URL_ENCODING_ENABLE_UTF8, + ENABLE_FORMS_AUTOCOMPLETE, ENABLE_INPLACE_NAVIGATION, + IME_ENABLE_RECONVERSION, + THEME, NOTHEME, NOPICS, NO3DOUTERBORDER, DISABLE_EDIT_NS_FIXUP, + LOCAL_MACHINE_ACCESS_CHECK, DISABLE_UNTRUSTEDPROTOCOL, + HOST_NAVIGATES, ENABLE_REDIRECT_NOTIFICATION, USE_WINDOWLESS_SELECTCONTROL, + USE_WINDOWED_SELECTCONTROL, ENABLE_ACTIVEX_INACTIVATE_MODE); } TUserInterfaceOption = (DisableTextSelect, DisableHelpMenu, DontUse3DBorders, DontUseScrollBars, PostponeScriptUntilActive, ForceOpenNewWindow, - Reserved_OFFSCREEN, - ForceFlatScrollBars, InsertDivTagOnEditMode, ActivateUIOnlyOnDocClick, - ConsultBeforeRetrievingBehavior, - CheckFontSupportsCodePage, DisableSubmitUrlInUTF8, - EnableSubmitUrlInUTF8, + Reserved_OFFSCREEN, ForceFlatScrollBars, InsertDivTagOnEditMode, + ActivateUIOnlyOnDocClick, ConsultBeforeRetrievingBehavior, + CheckFontSupportsCodePage, DisableSubmitUrlInUTF8, EnableSubmitUrlInUTF8, EnablesFormsAutoComplete, ForceSameWindowNavigation, - EmableImeLocalLanguages, - EnableThemes, DisableThemes, DisablePicsRatings, DisableFrameSetBorder, - DisablesAutoNameSpaceCorrection, + EmableImeLocalLanguages, EnableThemes, DisableThemes, DisablePicsRatings, + DisableFrameSetBorder, DisablesAutoNameSpaceCorrection, DisableLocalFileAccess, DisableUntrustedProtocol, - CheckNavigationDelegatedToHost, EnableRedirectNotification, EnableDomWindlessControls, - EnableWindowedControls, ForceUserActivationOnActiveXJava); + CheckNavigationDelegatedToHost, EnableRedirectNotification, + EnableDomWindlessControls, EnableWindowedControls, + ForceUserActivationOnActiveXJava); TUserInterfaceOptions = set of TUserInterfaceOption; - {events} - TMenuPreprocess = procedure(Sender: TObject; ID: DWORD; Menu: HMENU; const Context: IDispatch) of object; + { events } + TMenuPreprocess = procedure(Sender: TObject; ID: DWORD; Menu: HMENU; + const Context: IDispatch) of object; TEWBNotifyEvent = procedure(Sender: TObject; var Rezult: HRESULT) of object; TBoolQueryEvent = procedure(Sender: TObject; var Value: BOOL) of object; - TMaskedCtrlCharEvent = procedure(Sender: TCustomEmbeddedWB; MaskedChar: Char) of object; - TOMWindowMoveEvent = procedure(Sender: TCustomEmbeddedWB; cx, cy: Integer) of object; - - {IDocHostShowUI Interface} - TShowHelpEvent = function(Sender: TObject; HWND: THandle; pszHelpFile: POleStr; uCommand: Integer; - dwData: Longint; ptMouse: TPoint; + TMaskedCtrlCharEvent = procedure(Sender: TCustomEmbeddedWB; MaskedChar: Char) + of object; + TOMWindowMoveEvent = procedure(Sender: TCustomEmbeddedWB; cx, cy: Integer) + of object; + + { IDocHostShowUI Interface } + TShowHelpEvent = function(Sender: TObject; HWND: THandle; + pszHelpFile: POleStr; uCommand: Integer; dwData: Longint; ptMouse: TPoint; var pDispatchObjectHit: IDispatch): HRESULT of object; TShowMessageEvent = function(Sender: TObject; HWND: THandle; - lpstrText: POleStr; lpstrCaption: POleStr; dwType: Longint; lpstrHelpFile: POleStr; - dwHelpContext: Longint; var plResult: LRESULT): HRESULT of object; - {IDocHostUIHandler Interface} - TEnableModelessEvent = procedure(Sender: TCustomEmbeddedWB; const fEnable: BOOL) of object; - TFilterDataObjectEvent = procedure(Sender: TCustomEmbeddedWB; const pDO: IDataObject; - var ppDORet: IDataObject) of object; - TGetDropTargetEvent = procedure(Sender: TCustomEmbeddedWB; var DropTarget: IDropTarget) of object; - TGetExternalEvent = procedure(Sender: TCustomEmbeddedWB; var ppDispatch: IDispatch) of object; - TGetHostInfoEvent = procedure(Sender: TCustomEmbeddedWB; var pInfo: TDOCHOSTUIINFO) of object; - TGetOptionKeyPathEvent = procedure(Sender: TCustomEmbeddedWB; var pchKey: POleStr) of object; - TOnActivateEvent = procedure(Sender: TCustomEmbeddedWB; const fActivate: BOOL) of object; - TResizeBorderEvent = procedure(Sender: TCustomEmbeddedWB; const prcBorder: PRect; - const pUIWindow: IOleInPlaceUIWindow; + lpstrText: POleStr; lpstrCaption: POleStr; dwType: Longint; + lpstrHelpFile: POleStr; dwHelpContext: Longint; var plResult: LRESULT) + : HRESULT of object; + { IDocHostUIHandler Interface } + TEnableModelessEvent = procedure(Sender: TCustomEmbeddedWB; + const fEnable: BOOL) of object; + TFilterDataObjectEvent = procedure(Sender: TCustomEmbeddedWB; + const pDO: IDataObject; var ppDORet: IDataObject) of object; + TGetDropTargetEvent = procedure(Sender: TCustomEmbeddedWB; + var DropTarget: IDropTarget) of object; + TGetExternalEvent = procedure(Sender: TCustomEmbeddedWB; + var ppDispatch: IDispatch) of object; + TGetHostInfoEvent = procedure(Sender: TCustomEmbeddedWB; + var pInfo: TDOCHOSTUIINFO) of object; + TGetOptionKeyPathEvent = procedure(Sender: TCustomEmbeddedWB; + var pchKey: POleStr) of object; + TOnActivateEvent = procedure(Sender: TCustomEmbeddedWB; const fActivate: BOOL) + of object; + TResizeBorderEvent = procedure(Sender: TCustomEmbeddedWB; + const prcBorder: PRect; const pUIWindow: IOleInPlaceUIWindow; const fRameWindow: BOOL) of object; - TShowContextMenuEvent = procedure(Sender: TCustomEmbeddedWB; const dwID: DWORD; const ppt: PPOINT; - const CommandTarget: IUnknown; const Context: IDispatch; var Result: HRESULT) of object; - TShowUIEvent = procedure(Sender: TCustomEmbeddedWB; const dwID: DWORD; const - pActiveObject: IOleInPlaceActiveObject; + TShowContextMenuEvent = procedure(Sender: TCustomEmbeddedWB; + const dwID: DWORD; const ppt: PPOINT; const CommandTarget: IUnknown; + const Context: IDispatch; var Result: HRESULT) of object; + TShowUIEvent = procedure(Sender: TCustomEmbeddedWB; const dwID: DWORD; + const pActiveObject: IOleInPlaceActiveObject; const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame; const pDoc: IOleInPlaceUIWindow; var Rezult: HRESULT) of object; - TTranslateAcceleratorEvent = procedure(Sender: TCustomEmbeddedWB; const lpMsg: PMSG; - const pguidCmdGroup: PGUID; - const nCmdID: DWORD; var Done: Boolean) of object; - TTranslateUrlEvent = procedure(Sender: TCustomEmbeddedWB; const pchURLIn: POleStr; - var ppchURLOut: WideString) of object; + TTranslateAcceleratorEvent = procedure(Sender: TCustomEmbeddedWB; + const lpMsg: PMSG; const pguidCmdGroup: PGUID; const nCmdID: DWORD; + var Done: Boolean) of object; + TTranslateUrlEvent = procedure(Sender: TCustomEmbeddedWB; + const pchURLIn: POleStr; var ppchURLOut: WideString) of object; {$IFDEF USE_IOLECOMMANDTARGET} - TRefreshEvent = procedure(Sender: TCustomEmbeddedWB; CmdID: Integer; var Cancel: Boolean) of object; + TRefreshEvent = procedure(Sender: TCustomEmbeddedWB; CmdID: Integer; + var Cancel: Boolean) of object; {$ENDIF} - {INewWindowManager Interface} - TEvaluateNewWindowEvent = procedure(Sender: TCustomEmbeddedWB; pszUrl, pszName, - pszUrlContext, pszFeatures: LPCWSTR; - fReplace: BOOL; dwFlags, dwUserActionTime: DWORD; var Rezult: HRESULT) of object; - {IDownloadManager Interface} - TDownloadEvent = procedure(Sender: TCustomEmbeddedWB; pmk: IMoniker; pbc: IBindCtx; - dwBindVerb: DWORD; - grfBINDF: DWORD; pBindInfo: PBindInfo; pszHeaders: PWideChar; - pszRedir: PWidechar; uiCP: UINT; var Rezult: HRESULT) of object; - {IAuthenticate Interface} - TAuthenticateEvent = procedure(Sender: TCustomEmbeddedWB; var hwnd: HWnd; + { INewWindowManager Interface } + TEvaluateNewWindowEvent = procedure(Sender: TCustomEmbeddedWB; + pszUrl, pszName, pszUrlContext, pszFeatures: LPCWSTR; fReplace: BOOL; + dwFlags, dwUserActionTime: DWORD; var Rezult: HRESULT) of object; + { IDownloadManager Interface } + TDownloadEvent = procedure(Sender: TCustomEmbeddedWB; pmk: IMoniker; + pbc: IBindCtx; dwBindVerb: DWORD; grfBINDF: DWORD; pBindInfo: pBindInfo; + pszHeaders: PWideChar; pszRedir: PWideChar; uiCP: UINT; var Rezult: HRESULT) + of object; + { IAuthenticate Interface } + TAuthenticateEvent = procedure(Sender: TCustomEmbeddedWB; var HWND: HWND; var szUserName, szPassWord: WideString; var Rezult: HRESULT) of object; - {IZoomEvents Interface} - TZoomPercentChangedEvent = function(Sender: TCustomEmbeddedWB; const ulZoomPercent: uLong): HRESULT of object; - {Script Error handling} + { IZoomEvents Interface } + TZoomPercentChangedEvent = function(Sender: TCustomEmbeddedWB; + const ulZoomPercent: uLong): HRESULT of object; + { Script Error handling } TScriptErrorAction = (eaContinue, eaCancel, eaAskUser); - TScriptErrorEvent = procedure(Sender: TObject; ErrorLine, ErrorCharacter, ErrorCode, ErrorMessage, ErrorUrl: string; + TScriptErrorEvent = procedure(Sender: TObject; + ErrorLine, ErrorCharacter, ErrorCode, ErrorMessage, ErrorUrl: string; var ScriptErrorAction: TScriptErrorAction) of object; - {User Agent Mode Event} + { User Agent Mode Event } TSetUserAgentEvent = function(var UserAgent: string): HRESULT of object; { TCustomEmbeddedWB } - TCustomEmbeddedWB = class(TEWB - , IDispatch // http://msdn.microsoft.com/en-us/library/ms221608.aspx - , IDocHostShowUI // http://msdn.microsoft.com/en-us/library/aa753269.aspx - , IDocHostUIHandler // http://msdn.microsoft.com/en-us/library/aa753260(VS.85).aspx - , IDocHostUIHandler2 // http://msdn.microsoft.com/en-us/library/aa753275(VS.85).aspx - , IDropTarget // http://msdn.microsoft.com/en-us/library/ms679679.aspx + TCustomEmbeddedWB = class(TEWB, IDispatch + // http://msdn.microsoft.com/en-us/library/ms221608.aspx + , IDocHostShowUI // http://msdn.microsoft.com/en-us/library/aa753269.aspx + , IDocHostUIHandler + // http://msdn.microsoft.com/en-us/library/aa753260(VS.85).aspx + , IDocHostUIHandler2 + // http://msdn.microsoft.com/en-us/library/aa753275(VS.85).aspx + , IDropTarget // http://msdn.microsoft.com/en-us/library/ms679679.aspx {$IFDEF USE_IOLECOMMANDTARGET} - , IOleCommandTarget // http://msdn.microsoft.com/en-us/library/ms683797.aspx + , IOleCommandTarget // http://msdn.microsoft.com/en-us/library/ms683797.aspx {$ENDIF} - , IServiceProvider // http://msdn.microsoft.com/en-us/library/cc678965(VS.85).aspx - , INewWindowManager // http://msdn.microsoft.com/en-us/library/bb775418(VS.85).aspx - , IProtectFocus // http://msdn2.microsoft.com/en-us/library/aa361771.aspx - , IDownloadManager // http://msdn.microsoft.com/en-us/library/aa753613(VS.85).aspx - , IHTMLOMWindowServices //http://msdn.microsoft.com/library/default.asp?url=/workshop/browser/hosting/reference/ifaces/IHTMLOMWindowServices/IHTMLOMWindowServices.asp - , IHostBehaviorInit // http://msdn.microsoft.com/en-us/library/aa753687(VS.85).aspx - , IZoomEvents // http://msdn.microsoft.com/en-us/library/aa770056(VS.85).aspx - , IAuthenticate // http://msdn.microsoft.com/en-us/library/ms835407.aspx - ) + , IServiceProvider + // http://msdn.microsoft.com/en-us/library/cc678965(VS.85).aspx + , INewWindowManager + // http://msdn.microsoft.com/en-us/library/bb775418(VS.85).aspx + , IProtectFocus // http://msdn2.microsoft.com/en-us/library/aa361771.aspx + , IDownloadManager + // http://msdn.microsoft.com/en-us/library/aa753613(VS.85).aspx + , IHTMLOMWindowServices + // http://msdn.microsoft.com/library/default.asp?url=/workshop/browser/hosting/reference/ifaces/IHTMLOMWindowServices/IHTMLOMWindowServices.asp + , IHostBehaviorInit + // http://msdn.microsoft.com/en-us/library/aa753687(VS.85).aspx + , IZoomEvents + // http://msdn.microsoft.com/en-us/library/aa770056(VS.85).aspx + , IAuthenticate // http://msdn.microsoft.com/en-us/library/ms835407.aspx + ) private FOnZoomPercentChanged: TZoomPercentChangedEvent; @@ -320,47 +312,52 @@ TCustomEmbeddedWB = class(TEWB function GetBody: IHTMLElement; protected - CurrentHandle: HWND; //jls - procedure CreateWnd; override; //jls - procedure DestroyWnd; override; //jls + CurrentHandle: HWND; // jls + procedure CreateWnd; override; // jls + procedure DestroyWnd; override; // jls protected {$IFDEF RESEARCH_MODE} { IInterface } - function QueryInterface(const IID: TGUID; out Obj): HRESULT; override; stdcall; + function QueryInterface(const IID: TGUID; out Obj): HRESULT; + override; stdcall; {$ENDIF} - {IDispatch Interface} + { IDispatch Interface } function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT; stdcall; - function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT; - stdcall; + function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo) + : HRESULT; stdcall; function GetTypeInfoCount(out Count: Integer): HRESULT; stdcall; function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; - Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT; - stdcall; - {IDocHostShowUI Interface } + Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer) + : HRESULT; stdcall; + { IDocHostShowUI Interface } function ShowHelp(HWND: THandle; pszHelpFile: POleStr; uCommand: Integer; - dwData: Longint; ptMouse: TPoint; var pDispatchObjectHit: IDispatch): HRESULT; stdcall; - function ShowMessage(HWND: THandle; lpstrText: POleStr; lpstrCaption: POleStr; - dwType: Longint; lpstrHelpFile: POleStr; dwHelpContext: Longint; - var plResult: LRESULT): HRESULT; stdcall; - {IDocHostUIHandler Interface} + dwData: Longint; ptMouse: TPoint; var pDispatchObjectHit: IDispatch) + : HRESULT; stdcall; + function ShowMessage(HWND: THandle; lpstrText: POleStr; + lpstrCaption: POleStr; dwType: Longint; lpstrHelpFile: POleStr; + dwHelpContext: Longint; var plResult: LRESULT): HRESULT; stdcall; + { IDocHostUIHandler Interface } function EnableModeless(const fEnable: BOOL): HRESULT; stdcall; - function FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject): HRESULT; stdcall; + function FilterDataObject(const pDO: IDataObject; out ppDORet: IDataObject) + : HRESULT; stdcall; function GetDropTarget(const pDropTarget: IDropTarget; out ppDropTarget: IDropTarget): HRESULT; stdcall; function GetExternal(out ppDispatch: IDispatch): HRESULT; stdcall; function GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT; stdcall; - function GetOptionKeyPath(out pchKey: POleStr; const dw: DWORD): HRESULT; stdcall; + function GetOptionKeyPath(out pchKey: POleStr; const dw: DWORD) + : HRESULT; stdcall; function HideUI: HRESULT; stdcall; function OnDocWindowActivate(const fActivate: BOOL): HRESULT; stdcall; function OnFrameWindowActivate(const fActivate: BOOL): HRESULT; stdcall; - function ResizeBorder(const prcBorder: PRECT; const pUIWindow: - IOleInPlaceUIWindow; - const FrameWindow: BOOL): HRESULT; stdcall; + function ResizeBorder(const prcBorder: PRect; + const pUIWindow: IOleInPlaceUIWindow; const fRameWindow: BOOL) + : HRESULT; stdcall; function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT; - const CommandTarget: IUnknown; const Context: IDispatch): HRESULT; stdcall; - function ShowUI(const dwID: DWORD; const pActiveObject: - IOleInPlaceActiveObject; + const CommandTarget: IUnknown; const Context: IDispatch) + : HRESULT; stdcall; + function ShowUI(const dwID: DWORD; + const pActiveObject: IOleInPlaceActiveObject; const pCommandTarget: IOleCommandTarget; const pFrame: IOleInPlaceFrame; const pDoc: IOleInPlaceUIWindow): HRESULT; stdcall; function TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID; @@ -368,9 +365,10 @@ TCustomEmbeddedWB = class(TEWB function TranslateUrl(const dwTranslate: DWORD; const pchURLIn: POleStr; out ppchURLOut: POleStr): HRESULT; stdcall; function UpdateUI: HRESULT; stdcall; - {IDocHostUIHandler2 Interface} - function GetOverrideKeyPath(out pchKey: POleStr; dw: DWORD): HRESULT; stdcall; - {IDropTarget Interface} + { IDocHostUIHandler2 Interface } + function GetOverrideKeyPath(out pchKey: POleStr; dw: DWORD) + : HRESULT; stdcall; + { IDropTarget Interface } function DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HRESULT; stdcall; function IDropTarget.DragOver = DropTargetDragOver; @@ -380,7 +378,7 @@ TCustomEmbeddedWB = class(TEWB function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HRESULT; stdcall; {$IFDEF USE_IOLECOMMANDTARGET} - {IOleCommandTarget interface} + { IOleCommandTarget interface } function IOleCommandTarget.QueryStatus = CommandTarget_QueryStatus; function CommandTarget_QueryStatus(CmdGroup: PGUID; cCmds: Cardinal; prgCmds: POleCmd; CmdText: POleCmdText): HRESULT; stdcall; @@ -388,36 +386,37 @@ TCustomEmbeddedWB = class(TEWB function CommandTarget_Exec(CmdGroup: PGUID; nCmdID, nCmdexecopt: DWORD; const vaIn: OleVariant; var vaOut: OleVariant): HRESULT; stdcall; {$ENDIF} - {IServiceProvider Interface} - function QueryService(const rsid, iid: TGUID; out Obj): HRESULT; stdcall; - {INewWindowManager Interface} - function EvaluateNewWindow(pszUrl, pszName, pszUrlContext, pszFeatures: LPCWSTR; - fReplace: BOOL; dwFlags, dwUserActionTime: DWORD): HRESULT; stdcall; - {IProtectFocus IE7 interface} + { IServiceProvider Interface } + function QueryService(const rsid, IID: TGUID; out Obj): HRESULT; stdcall; + { INewWindowManager Interface } + function EvaluateNewWindow(pszUrl, pszName, pszUrlContext, + pszFeatures: LPCWSTR; fReplace: BOOL; dwFlags, dwUserActionTime: DWORD) + : HRESULT; stdcall; + { IProtectFocus IE7 interface } function AllowFocusChange(out pfAllow: BOOL): HRESULT; stdcall; - {IDownloadManager Interface} - function Download( - pmk: IMoniker; // Identifies the object to be downloaded + { IDownloadManager Interface } + function Download(pmk: IMoniker; // Identifies the object to be downloaded pbc: IBindCtx; // Stores information used by the moniker to bind dwBindVerb: DWORD; // The action to be performed during the bind grfBINDF: DWORD; // Determines the use of URL encoding during the bind - pBindInfo: PBindInfo; // Used to implement IBindStatusCallback::GetBindInfo - pszHeaders: PWidechar; // Additional headers to use with IHttpNegotiate - pszRedir: PWidechar; // The URL that the moniker is redirected to + pBindInfo: pBindInfo; + // Used to implement IBindStatusCallback::GetBindInfo + pszHeaders: PWideChar; // Additional headers to use with IHttpNegotiate + pszRedir: PWideChar; // The URL that the moniker is redirected to uiCP: UINT // The code page of the object's display name ): HRESULT; stdcall; - {IHostBehaviorInit} + { IHostBehaviorInit } function PopulateNamespaceTable: HRESULT; stdcall; - {IHTMLOMWindowServices Interface} + { IHTMLOMWindowServices Interface } function ResizeBy(const x, y: Integer): HRESULT; stdcall; function ResizeTo(const x, y: Integer): HRESULT; stdcall; function MoveBy(const x, y: Integer): HRESULT; stdcall; function MoveTo(const x, y: Integer): HRESULT; stdcall; - {IZoomEvents interface} + { IZoomEvents interface } function OnZoomPercentChanged(const ulZoomPercent: uLong): HRESULT; stdcall; - {IAuthenticate} - function Authenticate(var hwnd: HWnd; var szUserName, szPassWord: LPWSTR): - HRESULT; stdcall; + { IAuthenticate } + function Authenticate(var HWND: HWND; var szUserName, szPassWord: LPWSTR) + : HRESULT; stdcall; protected FDownloadOptionValue: Longint; FUserInterfaceValue: Cardinal; @@ -428,16 +427,17 @@ TCustomEmbeddedWB = class(TEWB procedure UpdateUserInterfaceValues; function CopyOptionKeyPath(Overrided: Boolean): PWideChar; function DoFilterMsg(const lpMsg: PMSG): Boolean; virtual; - function ScriptErrorHandler(const vaIn: OleVariant; var vaOut: OleVariant): HRESULT; virtual; - function DoQueryService(const rsid, iid: TGUID; var Obj): Boolean; virtual; + function ScriptErrorHandler(const vaIn: OleVariant; var vaOut: OleVariant) + : HRESULT; virtual; + function DoQueryService(const rsid, IID: TGUID; var Obj): Boolean; virtual; function FilterPopupMenu: Boolean; virtual; - procedure DoFilterPopupMenu(Sender: TObject; ID: DWORD; Menu: HMENU; const Context: - IDispatch); virtual; + procedure DoFilterPopupMenu(Sender: TObject; ID: DWORD; Menu: HMENU; + const Context: IDispatch); virtual; procedure MoveParentForm(x, y: Integer; Delta: Boolean); procedure ResizeParentForm(w, h: Integer; Delta: Boolean); public class function dwEffectToStr(Command: Int64): string; - class procedure DropEffect(grfKeyState: Longint; var dwEffect: longint); + class procedure DropEffect(grfKeyState: Longint; var dwEffect: Longint); constructor Create(AOwner: TComponent); override; destructor Destroy; override; function InvokeCommand(CmdGroup: PGUID; Cmd, nCmdexecopt: DWORD; @@ -445,12 +445,12 @@ TCustomEmbeddedWB = class(TEWB function InvokeCommand(CmdGroup: PGUID; Cmd: DWORD): HRESULT; overload; function QueryCommandStatus(CmdGroup: PGUID; cCmds: Cardinal; prgCmds: POleCmd; CmdText: POleCmdText): HRESULT; - function QueryCMDEnabled(CmdGroup: PGUID; cmdID: Cardinal): Boolean; - function QueryCMDLatched(CmdGroup: PGUID; cmdID: Cardinal): Boolean; - function QueryCMDStatus(CmdGroup: PGUID; cmdID: Cardinal): OLECMDF; + function QueryCMDEnabled(CmdGroup: PGUID; CmdID: Cardinal): Boolean; + function QueryCMDLatched(CmdGroup: PGUID; CmdID: Cardinal): Boolean; + function QueryCMDStatus(CmdGroup: PGUID; CmdID: Cardinal): OLECMDF; function QueryCMDArrayStatus(CmdGroup: PGUID; cmds: TOleCmdArray): Boolean; - procedure Client2HostWin(var CX, CY: Integer); + procedure Client2HostWin(var cx, cy: Integer); // just call it in OnClientToHostWindow handler function GetIEWin(const ClassName: string): HWND; @@ -464,130 +464,134 @@ TCustomEmbeddedWB = class(TEWB property Cookie: WideString read _getCookie; property DesignMode: Boolean read FDesignMode write SetDesignMode; - {html functions} + { html functions } property Doc2: IHtmlDocument2 read GetDoc2; property Doc3: IHtmlDocument3 read GetDoc3; property Doc4: IHtmlDocument4 read GetDoc4; property Doc5: IHtmlDocument5 read GetDoc5; - property Body: IHTMLElement read getBody; - property DocDesignMode: TDocDesignMode read getDocDesignMode write - setDocDesignMode; + property Body: IHTMLElement read GetBody; + property DocDesignMode: TDocDesignMode read GetDocDesignMode + write SetDocDesignMode; property CharactersSet: WideString read GetCharSet write SetCharSet; - property ElementByID[const ID: WideString]: IHTMLElement read getElemByID; + property ElementByID[const ID: WideString]: IHTMLElement read GetElemByID; function ScrollToElement(Element: IHTMLElement): Boolean; - function GetElementNamespaceTable(out aTable: IElementNamespaceTable): - Boolean; + function GetElementNamespaceTable(out aTable + : IElementNamespaceTable): Boolean; {$IFDEF RESEARCH_MODE} - property OnQueryInterface: OnQueryInterfaceEvent read FOnQueryInterface write FOnQueryInterface; + property OnQueryInterface: OnQueryInterfaceEvent read FOnQueryInterface + write FOnQueryInterface; {$ENDIF} - property CanGrabFocus: Boolean read FCanGrabFocus write FCanGrabFocus default True; + property CanGrabFocus: Boolean read FCanGrabFocus write FCanGrabFocus + default True; published - property ZoomPercent: Integer read FZoomPercent write SetOpticalZoom default 100; - property OnAllowFocusChange: TBoolQueryEvent read FOnAllowFocusChange write - FOnAllowFocusChange; - property DisableCtrlShortcuts: string read FDisableCtrlShortcuts write FDisableCtrlShortcuts; - property DownloadOptions: TDownloadControlOptions read FDownloadControlOptions - write SetDownloadOptions default [DownloadImages, DownloadVideos, DownloadBGSounds]; - property UserInterfaceOptions: TUserInterfaceOptions read FUserInterfaceOptions - write SetUserInterfaceOptions default []; + property ZoomPercent: Integer read FZoomPercent write SetOpticalZoom + default 100; + property OnAllowFocusChange: TBoolQueryEvent read FOnAllowFocusChange + write FOnAllowFocusChange; + property DisableCtrlShortcuts: string read FDisableCtrlShortcuts + write FDisableCtrlShortcuts; + property DownloadOptions: TDownloadControlOptions + read FDownloadControlOptions write SetDownloadOptions + default [DownloadImages, DownloadVideos, DownloadBGSounds]; + property UserInterfaceOptions: TUserInterfaceOptions + read FUserInterfaceOptions write SetUserInterfaceOptions default []; property HelpFile: string read FHelpFile write FHelpFile; - property OptionKeyPath: string read FOptionKeyPath write FOptionKeyPath; - property OverrideOptionKeyPath: Boolean read FOverOptionKeyPath write - FOverOptionKeyPath default False; - - property DropHandlingType: TDragDropHandlingType read FDropHandlingType write - setDropHandlingType default ddtMS; - property DisabledPopupMenus: TIEPopupMenus - read FDisabledPopupMenus write FDisabledPopupMenus default []; - property FloatingHosting: Boolean read FFloatingHosting write - fFloatingHosting default False; - - property OnGetIDsOfNames: TGetIDsOfNamesEvent read FOnGetIDsOfNames write - FOnGetIdsOfNames; - property OnGetTypeInfo: TGetTypeInfoEvent read FonGetTypeInfo write - FOnGetTypeInfo; - property OnGetTypeInfoCount: TGetTypeInfoCountEvent read FonGetTypeInfoCount + property OptionKeyPath: string read fOptionKeyPath write fOptionKeyPath; + property OverrideOptionKeyPath: Boolean read fOverOptionKeyPath + write fOverOptionKeyPath default False; + + property DropHandlingType: TDragDropHandlingType read FDropHandlingType + write SetDropHandlingType default ddtMS; + property DisabledPopupMenus: TIEPopupMenus read FDisabledPopupMenus + write FDisabledPopupMenus default []; + property FloatingHosting: Boolean read FFloatingHosting + write FFloatingHosting default False; + + property OnGetIDsOfNames: TGetIDsOfNamesEvent read FOnGetIDsOfNames + write FOnGetIDsOfNames; + property OnGetTypeInfo: TGetTypeInfoEvent read FOnGetTypeInfo + write FOnGetTypeInfo; + property OnGetTypeInfoCount: TGetTypeInfoCountEvent read FOnGetTypeInfoCount write FOnGetTypeInfoCount; property OnInvoke: TInvokeEvent read FOnInvoke write FOnInvoke; - property OnShowHelpRequest: TShowHelpEvent read FOnShowHelp write - FOnShowHelp; - property OnShowMessage: TShowMessageEvent read FOnShowMessage write - FOnShowMessage; + property OnShowHelpRequest: TShowHelpEvent read FOnShowHelp + write FOnShowHelp; + property OnShowMessage: TShowMessageEvent read FOnShowMessage + write FOnShowMessage; property OnFilterDataObject: TFilterDataObjectEvent read FOnFilterDataObject write FOnFilterDataObject; - property OnGetExternal: TGetExternalEvent read FOnGetExternal write - FOnGetExternal; - property OnGetHostInfo: TGetHostInfoEvent read FOnGetHostInfo write - FOnGetHostInfo; + property OnGetExternal: TGetExternalEvent read FOnGetExternal + write FOnGetExternal; + property OnGetHostInfo: TGetHostInfoEvent read FOnGetHostInfo + write FOnGetHostInfo; property OnEnableModeless: TEnableModelessEvent read FOnEnableModeless write FOnEnableModeless; {$IFDEF GETKEYPATH_HANDLERS} property OnGetOptionKeyPath: TGetOptionKeyPathEvent read FOnGetOptionKeyPath write FOnGetOptionKeyPath; - property OnGetOverrideKeyPath: TGetOptionKeyPathEvent read - FOnGetOverrideKeyPath - write FOnGetOverrideKeyPath; + property OnGetOverrideKeyPath: TGetOptionKeyPathEvent + read FOnGetOverrideKeyPath write FOnGetOverrideKeyPath; {$ENDIF} - property OnZoomPercentChange: TZoomPercentChangedEvent read FOnZoomPercentChanged write FOnZoomPercentChanged; - property OnGetDropTarget: TGetDropTargetEvent read FOnGetDropTarget write FOnGetDropTarget; + property OnZoomPercentChange: TZoomPercentChangedEvent + read FOnZoomPercentChanged write FOnZoomPercentChanged; + property OnGetDropTarget: TGetDropTargetEvent read FOnGetDropTarget + write FOnGetDropTarget; property OnHideUI: TEWBNotifyEvent read FOnHideUI write FOnHideUI; property OnOnDocWindowActivate: TOnActivateEvent read FOnOnDocWindowActivate write FOnOnDocWindowActivate; - property OnOnFrameWindowActivate: TOnActivateEvent read - FOnOnFrameWindowActivate - write FOnOnFrameWindowActivate; - property OnResizeBorder: TResizeBorderEvent read FOnResizeBorder write - FOnResizeBorder; + property OnOnFrameWindowActivate: TOnActivateEvent + read FOnOnFrameWindowActivate write FOnOnFrameWindowActivate; + property OnResizeBorder: TResizeBorderEvent read FOnResizeBorder + write FOnResizeBorder; property OnShowContextMenu: TShowContextMenuEvent read FOnShowContextmenu write FOnShowContextmenu; property OnShowUI: TShowUIEvent read FOnShowUI write FOnShowUI; - property OnTranslateAccelerator: TTranslateAcceleratorEvent read - FOnTranslateAccelerator - write FOnTranslateAccelerator; + property OnTranslateAccelerator: TTranslateAcceleratorEvent + read FOnTranslateAccelerator write FOnTranslateAccelerator; property OnTranslateUrl: TTranslateUrlEvent read FOnTranslateUrL write FOnTranslateUrL; property OnUpdateUI: TEWBNotifyEvent read FOnUpdateUI write FOnUpdateUI; - property OnDragEnter: TOnDragEnterEvent read FOnDragEnterEvent write - FOnDragEnterEvent; - property OnDragLeave: TNotifyEvent read FOnDragLeaveEvent write - FOnDragLeaveEvent; - property OnDragOver2: TOnDragOverEvent read FOnDragOverEvent write - FOnDragOverEvent; + property OnDragEnter: TOnDragEnterEvent read FOnDragEnterEvent + write FOnDragEnterEvent; + property OnDragLeave: TNotifyEvent read FOnDragLeaveEvent + write FOnDragLeaveEvent; + property OnDragOver2: TOnDragOverEvent read FOnDragOverEvent + write FOnDragOverEvent; property OnDropEvent: TOnDropEvent read FOnDropEvent write FOnDropEvent; - property OnScriptError: TScriptErrorEvent read FOnScriptError write FOnScriptError; + property OnScriptError: TScriptErrorEvent read FOnScriptError + write FOnScriptError; property ScriptErrorAction: TScriptErrorAction read FScriptErrorAction write FScriptErrorAction default eaContinue; {$IFDEF USE_IOLECOMMANDTARGET} property OnRefresh: TRefreshEvent read FOnRefresh write FOnRefresh; property OnStop: TNotifyEvent read FOnStop write FOnStop; property OnUnload: TNotifyEvent read FOnUnload write FOnUnload; - property OnCommandExec: TComTargetExecEvent read FOnCommandExec write - fOnCommandExec; + property OnCommandExec: TComTargetExecEvent read FOnCommandExec + write FOnCommandExec; {$ENDIF} - property OnQueryService: TQueryServiceEvent read FOnQueryService write - FOnQueryService; - property OnEvaluateNewWindow: TEvaluateNewWindowEvent read - FOnEvaluateNewWindow - write FOnEvaluateNewWindow; + property OnQueryService: TQueryServiceEvent read FOnQueryService + write FOnQueryService; + property OnEvaluateNewWindow: TEvaluateNewWindowEvent + read FOnEvaluateNewWindow write FOnEvaluateNewWindow; property OnFileDownload: TDownloadEvent read FOnDownload write FOnDownload; - property OnFilterPopupMenu: TMenuPreprocess read FOnFilterPopupMenu write - FOnFilterPopupMenu; - property OnMaskedCtrlChar: TMaskedCtrlCharEvent read FOnMaskedCtrlChar write - FOnMaskedCtrlChar; + property OnFilterPopupMenu: TMenuPreprocess read FOnFilterPopupMenu + write FOnFilterPopupMenu; + property OnMaskedCtrlChar: TMaskedCtrlCharEvent read FOnMaskedCtrlChar + write FOnMaskedCtrlChar; property OnMove: TOMWindowMoveEvent read FOnMove write FOnMove; property OnMoveBy: TOMWindowMoveEvent read FOnMoveBy write FOnMoveBy; property OnResize: TOMWindowMoveEvent read FOnResize write FOnResize; property OnResizeBy: TOMWindowMoveEvent read FOnResizeBy write FOnResizeBy; - property OnPopulateNSTable: TNotifyEvent read FOnPopulateNSTable write - FOnPopulateNSTable; - property OnAuthenticate: TAuthenticateEvent read FOnAuthenticate write - FOnAuthenticate; + property OnPopulateNSTable: TNotifyEvent read FOnPopulateNSTable + write FOnPopulateNSTable; + property OnAuthenticate: TAuthenticateEvent read FOnAuthenticate + write FOnAuthenticate; property OnPreRefresh: TNotifyEvent read FOnPreRefresh write FOnPreRefresh; end; @@ -598,29 +602,27 @@ TEwbCore = class(TCustomEmbeddedWB) property DisableCtrlShortcuts stored IsCtrlCharMask; end; - //this two functions for using in custom OnShowContextMenu handler. + // this two functions for using in custom OnShowContextMenu handler. function IsSeTIEPopupMenus(ID: DWORD; rcm: TIEPopupMenus): Boolean; function ShowRightClickMenu(Sender: TObject; dwID: DWORD; - const Target: IUnknown; const Context: IDispatch; - const ppt: PPOINT; - const EncodingSubMenu: OleVariant; - preprocess: TMenuPreprocess = nil): Boolean; + const Target: IUnknown; const Context: IDispatch; const ppt: PPOINT; + const EncodingSubMenu: OleVariant; preprocess: TMenuPreprocess = nil) + : Boolean; implementation uses - SysUtils, ComObj, EwbCoreTools, Registry; + SysUtils, System.Win.ComObj, EwbCoreTools; function IsSeTIEPopupMenus(ID: DWORD; rcm: TIEPopupMenus): Boolean; begin - Result := (rcmAll in rcm) or - ((ID in [0..9]) and (TIEPopupMenu(ID) in rcm)); + Result := (rcmAll in rcm) or ((ID in [0 .. 9]) and (TIEPopupMenu(ID) in rcm)); end; -function ShowRightClickMenu(Sender: TObject; dwID: DWORD; const Target: IUnknown; const Context: - IDispatch; - const ppt: PPOINT; const EncodingSubMenu: OleVariant; - Preprocess: TMenuPreprocess = nil): Boolean; +function ShowRightClickMenu(Sender: TObject; dwID: DWORD; + const Target: IUnknown; const Context: IDispatch; const ppt: PPOINT; + const EncodingSubMenu: OleVariant; preprocess: TMenuPreprocess = nil) + : Boolean; var ShDocLcHandle: THandle; OleCommandTarget: IOleCommandTarget; @@ -651,15 +653,16 @@ function ShowRightClickMenu(Sender: TObject; dwID: DWORD; const Target: IUnknown SubMenuItemInfo.hSubMenu := HMENU(@EncodingSubMenu); SetMenuItemInfo(SubMenu, IDM_LANGUAGE, False, SubMenuItemInfo); - if Assigned(Preprocess) then - Preprocess(Sender, dwID, SubMenu, Context); + if Assigned(preprocess) then + preprocess(Sender, dwID, SubMenu, Context); - PopupResult := Windows.TrackPopupMenuEx(SubMenu, TPM_LEFTALIGN - or TPM_TOPALIGN or TPM_RETURNCMD or TPM_RIGHTBUTTON - or TPM_HORPOSANIMATION or TPM_VERPOSANIMATION, ppt^.X, ppt^.Y, + PopupResult := Windows.TrackPopupMenuEx(SubMenu, TPM_LEFTALIGN or + TPM_TOPALIGN or TPM_RETURNCMD or TPM_RIGHTBUTTON or + TPM_HORPOSANIMATION or TPM_VERPOSANIMATION, ppt^.x, ppt^.y, WindowHandle, nil); if PopupResult then - SendMessage(WindowHandle, WM_COMMAND, MakeWParam(LOWORD(PopupResult), 0), 0); + SendMessage(WindowHandle, WM_COMMAND, + MakeWParam(LOWORD(PopupResult), 0), 0); Result := True; finally DestroyMenu(ParentMenu); @@ -673,8 +676,8 @@ TnoDragDrop = class(TInterfacedObject, IDropTarget) protected function DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HRESULT; stdcall; - function DragOver(grfKeyState: Longint; pt: TPoint; - var dwEffect: Longint): HRESULT; stdcall; + function DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint) + : HRESULT; stdcall; function DragLeave: HRESULT; stdcall; function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HRESULT; stdcall; @@ -713,45 +716,52 @@ class function TCustomEmbeddedWB.dwEffectToStr(Command: Int64): string; E_UNSPEC = E_Fail; begin case (Command) of - DROPEFFECT_NONE: Result := 'Drop target cannot accept the data.'; - DROPEFFECT_COPY: Result := 'Drag source should copy the data.'; - DROPEFFECT_MOVE: Result := 'Drag source should remove the data.'; - DROPEFFECT_LINK: Result := - 'Drag source should create a link to the original data.'; - DRAGDROP_S_DROP: Result := 'The drag-and-drop operation was successful.'; - DRAGDROP_S_CANCEL: Result := 'The drag-and-drop operation was canceled.'; - DRAGDROP_S_USEDEFAULTCURSORS: Result := - 'Successful completion. Restoring defaults.'; - DRAGDROP_E_INVALIDHWND: Result := - 'Invalid handle returned in the hwnd parameter.'; - DRAGDROP_E_NOTREGISTERED: Result := - 'Failed to revoke a drop target that has not been registered.'; - E_UNSPEC: Result := 'Unexpected error occurred.'; - E_OUTOFMEMORY: Result := 'Out of memory.'; - 7: Result := 'operation was successful.'; + DROPEFFECT_NONE: + Result := 'Drop target cannot accept the data.'; + DROPEFFECT_COPY: + Result := 'Drag source should copy the data.'; + DROPEFFECT_MOVE: + Result := 'Drag source should remove the data.'; + DROPEFFECT_LINK: + Result := 'Drag source should create a link to the original data.'; + DRAGDROP_S_DROP: + Result := 'The drag-and-drop operation was successful.'; + DRAGDROP_S_CANCEL: + Result := 'The drag-and-drop operation was canceled.'; + DRAGDROP_S_USEDEFAULTCURSORS: + Result := 'Successful completion. Restoring defaults.'; + DRAGDROP_E_INVALIDHWND: + Result := 'Invalid handle returned in the hwnd parameter.'; + DRAGDROP_E_NOTREGISTERED: + Result := 'Failed to revoke a drop target that has not been registered.'; + E_UNSPEC: + Result := 'Unexpected error occurred.'; + E_OUTOFMEMORY: + Result := 'Out of memory.'; + 7: + Result := 'operation was successful.'; else Result := 'Unknown.'; end; end; -class procedure TCustomEmbeddedWB.DropEffect(grfKeyState: Longint; var dwEffect: - longint); +class procedure TCustomEmbeddedWB.DropEffect(grfKeyState: Longint; + var dwEffect: Longint); begin if (grfKeyState and MK_CONTROL = 0) and (grfKeyState and MK_SHIFT <> 0) and - (dwEffect and DropEffect_Move <> 0) then - dwEffect := DropEffect_Move + (dwEffect and DROPEFFECT_MOVE <> 0) then + dwEffect := DROPEFFECT_MOVE else if (grfKeyState and MK_CONTROL <> 0) and (grfKeyState and MK_SHIFT <> 0) - and - (dwEffect and DropEffect_Link <> 0) then - dwEffect := DropEffect_Link - else if (dwEffect and DropEffect_Copy <> 0) then - dwEffect := DropEffect_Copy - else if (dwEffect and DropEffect_Move <> 0) then - dwEffect := DropEffect_Move - else if (dwEffect and DropEffect_Link <> 0) then - dwEffect := DropEffect_Link + and (dwEffect and DROPEFFECT_LINK <> 0) then + dwEffect := DROPEFFECT_LINK + else if (dwEffect and DROPEFFECT_COPY <> 0) then + dwEffect := DROPEFFECT_COPY + else if (dwEffect and DROPEFFECT_MOVE <> 0) then + dwEffect := DROPEFFECT_MOVE + else if (dwEffect and DROPEFFECT_LINK <> 0) then + dwEffect := DROPEFFECT_LINK else - dwEffect := DropEffect_None; + dwEffect := DROPEFFECT_NONE; end; function TCustomEmbeddedWB.AllowFocusChange(out pfAllow: BOOL): HRESULT; @@ -764,8 +774,7 @@ function TCustomEmbeddedWB.AllowFocusChange(out pfAllow: BOOL): HRESULT; function TCustomEmbeddedWB.CopyOptionKeyPath(Overrided: Boolean): PWideChar; begin - if (OptionKeyPath = '') or - (OverrideOptionKeyPath xor Overrided) then + if (OptionKeyPath = '') or (OverrideOptionKeyPath xor Overrided) then Result := nil else Result := StringToLPOLESTR(OptionKeyPath); @@ -794,26 +803,28 @@ destructor TCustomEmbeddedWB.Destroy(); inherited Destroy; end; -procedure TCustomEmbeddedWB.CreateWnd; //jls +procedure TCustomEmbeddedWB.CreateWnd; // jls begin if (CurrentHandle <> 0) and IsWindow(CurrentHandle) then begin WindowHandle := CurrentHandle; CurrentHandle := 0; Windows.SetParent(WindowHandle, TWinControl(Self).Parent.Handle); - MoveWindow(WindowHandle, Left, Top, Width, Height, True); //Force a resize on the client window + MoveWindow(WindowHandle, Left, Top, Width, Height, True); + // Force a resize on the client window end else inherited CreateWnd; end; -procedure TCustomEmbeddedWB.DestroyWnd; //jls +procedure TCustomEmbeddedWB.DestroyWnd; // jls begin if (csDestroying in ComponentState) then inherited DestroyWnd else begin - Windows.SetParent(WindowHandle, Forms.Application.Handle); //Parent to the Application window which is 0x0 in size + Windows.SetParent(WindowHandle, Forms.Application.Handle); + // Parent to the Application window which is 0x0 in size CurrentHandle := WindowHandle; // Save the WindowHandle WindowHandle := 0; // Set it to 0 so Createwnd will be called again... end; @@ -827,13 +838,13 @@ function TCustomEmbeddedWB.EnableModeless(const fEnable: BOOL): HRESULT; end; function TCustomEmbeddedWB.EvaluateNewWindow(pszUrl, pszName, pszUrlContext, - pszFeatures: LPCWSTR; fReplace: BOOL; dwFlags, - dwUserActionTime: DWORD): HRESULT; + pszFeatures: LPCWSTR; fReplace: BOOL; + dwFlags, dwUserActionTime: DWORD): HRESULT; begin - Result := E_FAIL; + Result := E_Fail; if Assigned(FOnEvaluateNewWindow) then FOnEvaluateNewWindow(Self, pszUrl, pszName, pszUrlContext, pszFeatures, - FReplace, dwFlags, dwUserActionTime, Result); + fReplace, dwFlags, dwUserActionTime, Result); end; function TCustomEmbeddedWB.FilterDataObject(const pDO: IDataObject; @@ -872,12 +883,12 @@ function TCustomEmbeddedWB.GetDoc5: IHtmlDocument5; Result := nil; end; -function TCustomEmbeddedWB.getBody: IHTMLElement; +function TCustomEmbeddedWB.GetBody: IHTMLElement; var D: IHtmlDocument2; begin if Supports(Document, IHtmlDocument2, D) then - Result := D.body + Result := D.Body else Result := nil; end; @@ -905,17 +916,17 @@ function TCustomEmbeddedWB.GetHostInfo(var pInfo: TDOCHOSTUIINFO): HRESULT; FOnGetHostInfo(Self, pInfo); end; -function TCustomEmbeddedWB.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, - LocaleID: Integer; DispIDs: Pointer): HRESULT; +function TCustomEmbeddedWB.GetIDsOfNames(const IID: TGUID; Names: Pointer; + NameCount, LocaleID: Integer; DispIDs: Pointer): HRESULT; begin Result := inherited GetIDsOfNames(IID, Names, NameCount, LocaleID, DispIDs); if Assigned(FOnGetIDsOfNames) then - FOnGetIDsOfNames(Self, IID, Names, NameCount, LocaleID, DispIds, Result); + FOnGetIDsOfNames(Self, IID, Names, NameCount, LocaleID, DispIDs, Result); end; function TCustomEmbeddedWB.GetIEWin(const ClassName: string): HWND; var - szClass: array[0..255] of char; + szClass: array [0 .. 255] of Char; begin if HandleAllocated then begin @@ -944,7 +955,8 @@ function TCustomEmbeddedWB.GetOptionKeyPath(out pchKey: POleStr; Result := S_OK; end; -function TCustomEmbeddedWB.GetOverrideKeyPath(out pchKey: POleStr; dw: DWORD): HRESULT; +function TCustomEmbeddedWB.GetOverrideKeyPath(out pchKey: POleStr; + dw: DWORD): HRESULT; begin pchKey := CopyOptionKeyPath(True); {$IFDEF GETKEYPATH_HANDLERS} @@ -957,7 +969,8 @@ function TCustomEmbeddedWB.GetOverrideKeyPath(out pchKey: POleStr; dw: DWORD): H Result := S_OK; end; -function TCustomEmbeddedWB.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HRESULT; +function TCustomEmbeddedWB.GetTypeInfo(Index, LocaleID: Integer; + out TypeInfo): HRESULT; begin Result := inherited GetTypeInfo(Index, LocaleID, TypeInfo); if Assigned(FOnGetTypeInfo) then @@ -975,7 +988,7 @@ function TCustomEmbeddedWB.GetZoom: Integer; var vaIn, vaOut: OleVariant; begin - vaIn := NULL; + vaIn := Variants.NULL; InvokeCommand(nil, OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut); Result := vaOut; end; @@ -985,11 +998,11 @@ procedure TCustomEmbeddedWB.SetZoom(const Value: Integer); vaIn, vaOut: OleVariant; Range: DWORD; begin - InvokeCommand(nil, OLECMDID_GETZOOMRANGE, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, - vaOut); + InvokeCommand(nil, OLECMDID_GETZOOMRANGE, OLECMDEXECOPT_DONTPROMPTUSER, + vaIn, vaOut); Range := DWORD(vaOut); - if Value < LoWord(Range) then - vaIn := LoWord(Range) + if Value < LOWORD(Range) then + vaIn := LOWORD(Range) else if Value > HiWord(Range) then vaIn := HiWord(Range) else @@ -1005,15 +1018,17 @@ procedure TCustomEmbeddedWB.SetOpticalZoom(const Value: Integer); if FZoomPercent <> Value then begin FZoomPercent := Value; - InvokeCommand(nil, OLECMDID_OPTICAL_GETZOOMRANGE, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut); + InvokeCommand(nil, OLECMDID_OPTICAL_GETZOOMRANGE, + OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut); Range := DWORD(vaOut); - if Value < LoWord(Range) then - vaIn := LoWord(Range) + if Value < LOWORD(Range) then + vaIn := LOWORD(Range) else if Value > HiWord(Range) then vaIn := HiWord(Range) else vaIn := Value; - InvokeCommand(nil, OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut); + InvokeCommand(nil, OLECMDID_OPTICAL_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, + vaIn, vaOut); if Assigned(FOnZoomPercentChanged) then FOnZoomPercentChanged(Self, vaOut); end; @@ -1026,8 +1041,8 @@ function TCustomEmbeddedWB.HideUI: HRESULT; FOnHideUI(Self, Result); end; -function TCustomEmbeddedWB.InvokeCommand(CmdGroup: PGUID; Cmd, nCmdexecopt: DWORD; - var vaIn, vaOut: OleVariant): HRESULT; +function TCustomEmbeddedWB.InvokeCommand(CmdGroup: PGUID; + Cmd, nCmdexecopt: DWORD; var vaIn, vaOut: OleVariant): HRESULT; var CmdTarget: IOleCommandTarget; begin @@ -1040,10 +1055,11 @@ function TCustomEmbeddedWB.InvokeCommand(CmdGroup: PGUID; Cmd, nCmdexecopt: DWOR function TCustomEmbeddedWB.InvokeCommand(CmdGroup: PGUID; Cmd: DWORD): HRESULT; var CmdTarget: IOleCommandTarget; - vaIn, vaOut: Olevariant; + vaIn, vaOut: OleVariant; begin if Supports(Document, IOleCommandTarget, CmdTarget) then - Result := CmdTarget.Exec(CmdGroup, Cmd, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut) + Result := CmdTarget.Exec(CmdGroup, Cmd, OLECMDEXECOPT_DODEFAULT, + vaIn, vaOut) else Result := E_UNEXPECTED; end; @@ -1054,23 +1070,25 @@ function TCustomEmbeddedWB.QueryCMDArrayStatus(CmdGroup: PGUID; CmdTarget: IOleCommandTarget; begin if Supports(Document, IOleCommandTarget, CmdTarget) then - Result := CmdTarget.QueryStatus(CmdGroup, - Length(cmds), @Cmds, nil) = S_OK + Result := CmdTarget.QueryStatus(CmdGroup, Length(cmds), @cmds, nil) = S_OK else Result := False; end; -function TCustomEmbeddedWB.QueryCMDEnabled(CmdGroup: PGUID; cmdID: Cardinal): Boolean; +function TCustomEmbeddedWB.QueryCMDEnabled(CmdGroup: PGUID; + CmdID: Cardinal): Boolean; begin - Result := (QueryCMDStatus(CmdGroup, cmdID) and OLECMDF_ENABLED) <> 0; + Result := (QueryCMDStatus(CmdGroup, CmdID) and OLECMDF_ENABLED) <> 0; end; -function TCustomEmbeddedWB.QueryCMDLatched(CmdGroup: PGUID; cmdID: Cardinal): Boolean; +function TCustomEmbeddedWB.QueryCMDLatched(CmdGroup: PGUID; + CmdID: Cardinal): Boolean; begin - Result := (QueryCMDStatus(CmdGroup, cmdID) and OLECMDF_LATCHED) <> 0; + Result := (QueryCMDStatus(CmdGroup, CmdID) and OLECMDF_LATCHED) <> 0; end; -function TCustomEmbeddedWB.QueryCMDStatus(CmdGroup: PGUID; cmdID: Cardinal): OLECMDF; +function TCustomEmbeddedWB.QueryCMDStatus(CmdGroup: PGUID; + CmdID: Cardinal): OLECMDF; var CmdTarget: IOleCommandTarget; Cmd: TOleCmd; @@ -1078,16 +1096,15 @@ function TCustomEmbeddedWB.QueryCMDStatus(CmdGroup: PGUID; cmdID: Cardinal): OLE Result := 0; if Supports(Document, IOleCommandTarget, CmdTarget) then begin - Cmd.CmdID := cmdID; + Cmd.CmdID := CmdID; Cmd.cmdf := 0; if CmdTarget.QueryStatus(CmdGroup, 1, @Cmd, nil) = S_OK then Result := Cmd.cmdf; end; end; -function TCustomEmbeddedWB.QueryCommandStatus(CmdGroup: PGUID; cCmds: Cardinal; prgCmds: - POleCmd; - CmdText: POleCmdText): HRESULT; +function TCustomEmbeddedWB.QueryCommandStatus(CmdGroup: PGUID; cCmds: Cardinal; + prgCmds: POleCmd; CmdText: POleCmdText): HRESULT; var CmdTarget: IOleCommandTarget; begin @@ -1107,8 +1124,9 @@ function TCustomEmbeddedWB.QueryInterface(const IID: TGUID; out Obj): HRESULT; end; {$ENDIF} -function TCustomEmbeddedWB.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; - Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT; +function TCustomEmbeddedWB.Invoke(DispID: Integer; const IID: TGUID; + LocaleID: Integer; Flags: Word; var Params; + VarResult, ExcepInfo, ArgErr: Pointer): HRESULT; var UserAgent: string; begin @@ -1155,7 +1173,7 @@ function TCustomEmbeddedWB.Invoke(DispID: Integer; const IID: TGUID; LocaleID: I begin Result := inherited Invoke(DispID, IID, LocaleID, Flags, Params, VarResult, ExcepInfo, ArgErr); - if (result = DISP_E_MEMBERNOTFOUND) and Assigned(FOnInvoke) then + if (Result = DISP_E_MEMBERNOTFOUND) and Assigned(FOnInvoke) then FOnInvoke(Self, DispID, IID, LocaleID, Flags, TagDispParams(Params), VarResult, ExcepInfo, ArgErr, Result); end; @@ -1177,37 +1195,40 @@ function TCustomEmbeddedWB.Invoke(DispID: Integer; const IID: TGUID; LocaleID: I function TCustomEmbeddedWB.OnDocWindowActivate(const fActivate: BOOL): HRESULT; begin if Assigned(FOnOnDocWindowActivate) then - FOnOnDocWindowActivate(Self, FActivate); + FOnOnDocWindowActivate(Self, fActivate); Result := S_OK; end; -function TCustomEmbeddedWB.OnFrameWindowActivate(const fActivate: BOOL): HRESULT; +function TCustomEmbeddedWB.OnFrameWindowActivate(const fActivate: BOOL) + : HRESULT; begin if Assigned(FOnOnFrameWindowActivate) then FOnOnFrameWindowActivate(Self, fActivate); Result := S_OK; end; -function TCustomEmbeddedWB.DoQueryService(const rsid, iid: TGUID; var Obj): Boolean; +function TCustomEmbeddedWB.DoQueryService(const rsid, IID: TGUID; + var Obj): Boolean; begin - if (IsEqualGuid(rsid, IID_INewWindowManager) and Assigned(FOnEvaluateNewWindow)) - or IsEqualGuid(rsid, IID_IProtectFocus) - or (IsEqualGuid(rsid, IID_IDownloadManager) and Assigned(FOnDownload)) - or (IsEqualGuid(rsid, IID_IHostBehaviorInit) and Assigned(OnPopulateNSTable)) + if (IsEqualGuid(rsid, IID_INewWindowManager) and + Assigned(FOnEvaluateNewWindow)) or IsEqualGuid(rsid, IID_IProtectFocus) or + (IsEqualGuid(rsid, IID_IDownloadManager) and Assigned(FOnDownload)) or + (IsEqualGuid(rsid, IID_IHostBehaviorInit) and Assigned(OnPopulateNSTable)) or (IsEqualGuid(rsid, IID_IHTMLOMWindowServices) and - (FloatingHosting or Assigned(OnMove) or Assigned(Self.OnMoveBy) - or Assigned(OnResize) or Assigned(OnResizeBy))) - or (IsEqualGUID(iid, IID_IAuthenticate) and Assigned(OnAuthenticate)) then - Result := QueryInterface(iid, Obj) = S_OK + (FloatingHosting or Assigned(OnMove) or Assigned(Self.OnMoveBy) or + Assigned(OnResize) or Assigned(OnResizeBy))) or + (IsEqualGuid(IID, IID_IAuthenticate) and Assigned(OnAuthenticate)) then + Result := QueryInterface(IID, Obj) = S_OK else Result := False; end; -function TCustomEmbeddedWB.QueryService(const rsid, iid: TGUID; out Obj): HRESULT; +function TCustomEmbeddedWB.QueryService(const rsid, IID: TGUID; + out Obj): HRESULT; begin Pointer(Obj) := nil; - if (not DoQueryService(rsid, iid, Obj)) and Assigned(FOnQueryService) then - FOnQueryService(Self, rsid, iid, IUnknown(obj)); + if (not DoQueryService(rsid, IID, Obj)) and Assigned(FOnQueryService) then + FOnQueryService(Self, rsid, IID, IUnknown(Obj)); if Pointer(Obj) <> nil then Result := S_OK @@ -1215,8 +1236,8 @@ function TCustomEmbeddedWB.QueryService(const rsid, iid: TGUID; out Obj): HRESUL Result := E_NOINTERFACE; end; -function TCustomEmbeddedWB.ResizeBorder(const prcBorder: PRECT; - const pUIWindow: IOleInPlaceUIWindow; const FrameWindow: BOOL): HRESULT; +function TCustomEmbeddedWB.ResizeBorder(const prcBorder: PRect; + const pUIWindow: IOleInPlaceUIWindow; const fRameWindow: BOOL): HRESULT; begin if Assigned(FOnResizeBorder) then FOnResizeBorder(Self, prcBorder, pUIWindow, fRameWindow); @@ -1234,7 +1255,7 @@ procedure TCustomEmbeddedWB.MoveParentForm(x, y: Integer; Delta: Boolean); begin x := F.Left + x; y := F.Top + y; - end; //FIXME defend from moving outside of screen (don't forget multimonitor) + end; // FIXME defend from moving outside of screen (don't forget multimonitor) F.SetBounds(x, y, F.Width, F.Height); end; end; @@ -1269,7 +1290,7 @@ function TCustomEmbeddedWB.ResizeTo(const x, y: Integer): HRESULT; if FloatingHosting then ResizeParentForm(x, y, False); if Assigned(OnResize) then - OnResize(self, x, y); + OnResize(Self, x, y); Result := S_OK; // always return success to prevent script error messages end; @@ -1278,7 +1299,7 @@ function TCustomEmbeddedWB.MoveBy(const x, y: Integer): HRESULT; if FloatingHosting then MoveParentForm(x, y, True); if Assigned(OnMoveBy) then - OnMoveBy(self, x, y); + OnMoveBy(Self, x, y); Result := S_OK; // always return success to prevent script error messages end; @@ -1287,11 +1308,12 @@ function TCustomEmbeddedWB.MoveTo(const x, y: Integer): HRESULT; if FloatingHosting then MoveParentForm(x, y, False); if Assigned(OnMove) then - OnMove(self, x, y); + OnMove(Self, x, y); Result := S_OK; // always return success to prevent script error messages end; -function TCustomEmbeddedWB.OnZoomPercentChanged(const ulZoomPercent: uLong): HRESULT; +function TCustomEmbeddedWB.OnZoomPercentChanged(const ulZoomPercent + : uLong): HRESULT; begin if Assigned(FOnZoomPercentChanged) then Result := FOnZoomPercentChanged(Self, ulZoomPercent) @@ -1301,9 +1323,9 @@ function TCustomEmbeddedWB.OnZoomPercentChanged(const ulZoomPercent: uLong): HRE function TCustomEmbeddedWB.GetElemByID(const ID: WideString): IHTMLElement; var - Doc3: IHTMLDocument3; + Doc3: IHtmlDocument3; begin - if Supports(Document, IHTMLDocument3, Doc3) then + if Supports(Document, IHtmlDocument3, Doc3) then Result := Doc3.getElementById(ID) else Result := nil; @@ -1317,7 +1339,7 @@ function TCustomEmbeddedWB.ScrollToElement(Element: IHTMLElement): Boolean; if Result then begin RV := (Element as IHTMLElement2).getBoundingClientRect; - Doc2.parentWindow.scrollBy(RV.left, RV.top); + Doc2.parentWindow.scrollBy(RV.Left, RV.Top); end; end; @@ -1344,56 +1366,57 @@ procedure TCustomEmbeddedWB.SetDesignMode(const Value: Boolean); with (Application as IOleControl) do begin OnAmbientPropertyChange(DISPID_AMBIENT_USERMODE); - _Release; +{$IFNDEF DELPHIX_SEATTLE_UP } _Release; {$ENDIF} end; end; const - _DesignModeValues: array[TDocDesignMode] of string = - ('On', 'Off', 'Inherit', ''); + _DesignModeValues: array [TDocDesignMode] of string = ('On', 'Off', + 'Inherit', ''); function TCustomEmbeddedWB.GetDocDesignMode: TDocDesignMode; var - D: IHTMLDocument2; + D: IHtmlDocument2; I: Integer; begin Result := ddmUnknown; - if Supports(Document, IHTMLDocument2, D) then + if Supports(Document, IHtmlDocument2, D) then begin - I := AnsiIndexStr(D.designMode, _DesignModeValues); - if I in [0..2] then + I := AnsiIndexStr(D.DesignMode, _DesignModeValues); + if I in [0 .. 2] then Result := TDocDesignMode(I); end; end; procedure TCustomEmbeddedWB.SetDocDesignMode(const Value: TDocDesignMode); var - D: IHTMLDocument2; + D: IHtmlDocument2; begin - if (Value <> ddmUnknown) and Supports(Document, IHTMLDocument2, D) then - D.designMode := _DesignModeValues[Value]; + if (Value <> ddmUnknown) and Supports(Document, IHtmlDocument2, D) then + D.DesignMode := _DesignModeValues[Value]; end; -procedure TCustomEmbeddedWB.SetDownloadOptions(const Value: TDownloadControlOptions); +procedure TCustomEmbeddedWB.SetDownloadOptions(const Value + : TDownloadControlOptions); begin FDownloadControlOptions := Value; UpdateDownloadControlValues; with (Application as IOleControl) do begin OnAmbientPropertyChange(DISPID_AMBIENT_DLCONTROL); - _Release; +{$IFNDEF DELPHIX_SEATTLE_UP } _Release; {$ENDIF} end; end; procedure TCustomEmbeddedWB.SetFocusToBody; var bodyElement: IHTMLElement2; - HTMLDoc2: IHTMLDocument2; + HTMLDoc2: IHtmlDocument2; begin HTMLDoc2 := GetDoc2; if Assigned(HTMLDoc2) then begin - bodyElement := HTMLDoc2.body as IHTMLElement2; + bodyElement := HTMLDoc2.Body as IHTMLElement2; if Assigned(bodyElement) then bodyElement.focus; end; @@ -1410,7 +1433,8 @@ procedure TCustomEmbeddedWB.SetFocusToDoc; CanGrabFocus := True; with (Application as IOleObject) do begin - if DoVerb(OLEIVERB_UIACTIVATE, nil, Self, 0, Handle, GetClientRect) = S_OK then + if DoVerb(OLEIVERB_UIACTIVATE, nil, Self, 0, Handle, GetClientRect) = S_OK + then begin ParentForm := GetParentForm(Self); if Assigned(ParentForm) and Self.CanFocus then @@ -1423,12 +1447,12 @@ procedure TCustomEmbeddedWB.SetFocusToDoc; procedure TCustomEmbeddedWB.SetFocusToParent; begin - {if IsWindow(WindowHandle) then - begin - Windows.SetParent(WindowHandle, Parent.Handle); - MoveWindow(WindowHandle, 0, 0, Parent.Width, Parent.Height, True); - Parent.SetFocus; - end;} + { if IsWindow(WindowHandle) then + begin + Windows.SetParent(WindowHandle, Parent.Handle); + MoveWindow(WindowHandle, 0, 0, Parent.Width, Parent.Height, True); + Parent.SetFocus; + end; } if IsWindow(WindowHandle) then begin Windows.SetParent(WindowHandle, TWinControl(Self).Parent.Handle); @@ -1438,18 +1462,20 @@ procedure TCustomEmbeddedWB.SetFocusToParent; end; end; -procedure TCustomEmbeddedWB.SetUserInterfaceOptions(const Value: TUserInterfaceOptions); +procedure TCustomEmbeddedWB.SetUserInterfaceOptions + (const Value: TUserInterfaceOptions); begin FUserInterfaceOptions := Value; UpdateUserInterfaceValues; with (Application as IOleControl) do begin OnAmbientPropertyChange(DISPID_AMBIENT_DLCONTROL); - _Release; +{$IFNDEF DELPHIX_SEATTLE_UP } _Release; {$ENDIF} end; end; -procedure TCustomEmbeddedWB.SetDropHandlingType(const Value: TDragDropHandlingType); +procedure TCustomEmbeddedWB.SetDropHandlingType(const Value + : TDragDropHandlingType); var innerWnd: LongWord; Impl: IDropTarget; @@ -1469,7 +1495,8 @@ procedure TCustomEmbeddedWB.SetDropHandlingType(const Value: TDragDropHandlingTy case Value of ddtMS: DefaultInterface.RegisterAsDropTarget := True; - ddtMy: Impl := Self; + ddtMy: + Impl := Self; ddtCustom: if innerWnd <> 0 then begin @@ -1511,8 +1538,8 @@ function TCustomEmbeddedWB.GetDropTarget(const pDropTarget: IDropTarget; end; end; -function TCustomEmbeddedWB.DragEnter(const dataObj: IDataObject; grfKeyState: Integer; - pt: TPoint; var dwEffect: Integer): HRESULT; +function TCustomEmbeddedWB.DragEnter(const dataObj: IDataObject; + grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HRESULT; begin Result := NOERROR; dwEffect := DROPEFFECT_NONE; @@ -1527,8 +1554,8 @@ function TCustomEmbeddedWB.DragLeave: HRESULT; OnDragLeave(Self); end; -function TCustomEmbeddedWB.Drop(const dataObj: IDataObject; grfKeyState: Integer; - pt: TPoint; var dwEffect: Integer): HRESULT; +function TCustomEmbeddedWB.Drop(const dataObj: IDataObject; + grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HRESULT; begin Result := NOERROR; dwEffect := DROPEFFECT_NONE; @@ -1545,9 +1572,9 @@ function TCustomEmbeddedWB.DropTargetDragOver(grfKeyState: Integer; pt: TPoint; FOnDragOverEvent(Self, grfKeyState, pt, dwEffect, Result); end; -function TCustomEmbeddedWB.Download(pmk: IMoniker; pbc: IBindCtx; dwBindVerb, - grfBINDF: DWORD; pBindInfo: PBindInfo; pszHeaders, pszRedir: PWidechar; - uiCP: UINT): HRESULT; +function TCustomEmbeddedWB.Download(pmk: IMoniker; pbc: IBindCtx; + dwBindVerb, grfBINDF: DWORD; pBindInfo: pBindInfo; + pszHeaders, pszRedir: PWideChar; uiCP: UINT): HRESULT; begin Result := E_NOTIMPL; if Assigned(FOnDownload) then @@ -1560,8 +1587,8 @@ function TCustomEmbeddedWB.FilterPopupMenu: Boolean; Result := Assigned(OnFilterPopupMenu); end; -procedure TCustomEmbeddedWB.DoFilterPopupMenu(Sender: TObject; ID: DWORD; Menu: HMENU; const Context: - IDispatch); +procedure TCustomEmbeddedWB.DoFilterPopupMenu(Sender: TObject; ID: DWORD; + Menu: HMENU; const Context: IDispatch); begin if Assigned(OnFilterPopupMenu) then OnFilterPopupMenu(Sender, ID, Menu, Context); @@ -1573,8 +1600,8 @@ function TCustomEmbeddedWB.ShowContextMenu(const dwID: DWORD; const ppt: PPOINT; EncodingSubMenu: OleVariant; begin Result := E_NOTIMPL; - if Assigned(FOnShowContextMenu) then - FOnShowContextMenu(Self, dwID, ppt, CommandTarget, Context, Result); + if Assigned(FOnShowContextmenu) then + FOnShowContextmenu(Self, dwID, ppt, CommandTarget, Context, Result); if Result = E_NOTIMPL then begin @@ -1582,13 +1609,14 @@ function TCustomEmbeddedWB.ShowContextMenu(const dwID: DWORD; const ppt: PPOINT; begin Result := S_OK; if Assigned(PopUpMenu) then // Show assigned TPopupMenu - PopUpMenu.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y); + PopUpMenu.Popup(Mouse.CursorPos.x, Mouse.CursorPos.y); end else if FilterPopupMenu then begin - ExecWB(CGetMimeSubMenuCommandID, OLECMDEXECOPT_DODEFAULT, EncodingSubMenu); - if ShowRightClickMenu(Self, dwID, CommandTarget, Context, ppt, EncodingSubMenu, - DoFilterPopupMenu) then + ExecWB(CGetMimeSubMenuCommandID, OLECMDEXECOPT_DODEFAULT, + EncodingSubMenu); + if ShowRightClickMenu(Self, dwID, CommandTarget, Context, ppt, + EncodingSubMenu, DoFilterPopupMenu) then Result := S_OK else Result := S_FALSE; @@ -1598,11 +1626,13 @@ function TCustomEmbeddedWB.ShowContextMenu(const dwID: DWORD; const ppt: PPOINT; end; end; -function TCustomEmbeddedWB.ShowHelp(HWND: THandle; pszHelpFile: POleStr; uCommand, - dwData: Integer; ptMouse: TPoint; var pDispatchObjectHit: IDispatch): HRESULT; +function TCustomEmbeddedWB.ShowHelp(HWND: THandle; pszHelpFile: POleStr; + uCommand, dwData: Integer; ptMouse: TPoint; + var pDispatchObjectHit: IDispatch): HRESULT; begin if Assigned(FOnShowHelp) then - Result := FOnShowHelp(Self, HWND, pszHelpFile, uCommand, dwData, ptMouse, pDispatchObjectHit) + Result := FOnShowHelp(Self, HWND, pszHelpFile, uCommand, dwData, ptMouse, + pDispatchObjectHit) else if (pszHelpFile = nil) and (HelpFile <> '') then begin HtmlHelp(HWND, PChar(HelpFile), uCommand, dwData); @@ -1612,12 +1642,13 @@ function TCustomEmbeddedWB.ShowHelp(HWND: THandle; pszHelpFile: POleStr; uComman Result := S_FALSE; end; -function TCustomEmbeddedWB.ShowMessage(HWND: THandle; lpstrText, lpstrCaption: POleStr; - dwType: Integer; lpstrHelpFile: POleStr; dwHelpContext: Integer; - var plResult: LRESULT): HRESULT; +function TCustomEmbeddedWB.ShowMessage(HWND: THandle; + lpstrText, lpstrCaption: POleStr; dwType: Integer; lpstrHelpFile: POleStr; + dwHelpContext: Integer; var plResult: LRESULT): HRESULT; begin if Assigned(FOnShowMessage) then - Result := FOnShowMessage(Self, HWND, lpstrText, lpStrCaption, dwType, lpStrHelpFile, dwHelpContext, plResult) + Result := FOnShowMessage(Self, HWND, lpstrText, lpstrCaption, dwType, + lpstrHelpFile, dwHelpContext, plResult) else Result := S_FALSE; end; @@ -1639,15 +1670,15 @@ function TCustomEmbeddedWB.DoFilterMsg(const lpMsg: PMSG): Boolean; ShiftState: TShiftState; begin { - Result := (FDisableCtrlShortcuts <> '') and (lpMsg^.message = WM_KEYDOWN) - and (((GetKeyState(VK_LCONTROL) < 0) and (GetKeyState(VK_MENU) >= 0)) or - ((GetKeyState(VK_RCONTROL) < 0) and (GetKeyState(VK_LMENU) >= 0))) - and (_CharPos(Char(lpMsg.wParam), FDisableCtrlShortcuts) > 0); } + Result := (FDisableCtrlShortcuts <> '') and (lpMsg^.message = WM_KEYDOWN) + and (((GetKeyState(VK_LCONTROL) < 0) and (GetKeyState(VK_MENU) >= 0)) or + ((GetKeyState(VK_RCONTROL) < 0) and (GetKeyState(VK_LMENU) >= 0))) + and (_CharPos(Char(lpMsg.wParam), FDisableCtrlShortcuts) > 0); } ShiftState := KeyDataToShiftState(PWMKey(lpMsg)^.KeyData); - Result := (FDisableCtrlShortcuts <> '') and (lpMsg^.message = WM_KEYDOWN) - and ((ShiftState = [ssCtrl]) and (ShiftState <> [ssAlt])) - and (_CharPos(Char(lpMsg.wParam), FDisableCtrlShortcuts) > 0); + Result := (FDisableCtrlShortcuts <> '') and (lpMsg^.Message = WM_KEYDOWN) and + ((ShiftState = [ssCtrl]) and (ShiftState <> [ssAlt])) and + (_CharPos(Char(lpMsg.wParam), FDisableCtrlShortcuts) > 0); if Result and Assigned(OnMaskedCtrlChar) then OnMaskedCtrlChar(Self, Char(lpMsg.wParam)); @@ -1656,7 +1687,7 @@ function TCustomEmbeddedWB.DoFilterMsg(const lpMsg: PMSG): Boolean; function TCustomEmbeddedWB.TranslateAccelerator(const lpMsg: PMSG; const pguidCmdGroup: PGUID; const nCmdID: DWORD): HRESULT; { Called by MSHTML when IOleInPlaceActiveObject.TranslateAccelerator or - IOleControlSite.TranslateAccelerator is called } + IOleControlSite.TranslateAccelerator is called } var Filtered: Boolean; begin @@ -1670,14 +1701,14 @@ function TCustomEmbeddedWB.TranslateAccelerator(const lpMsg: PMSG; Result := S_FALSE; end; -function TCustomEmbeddedWB.TranslateUrl(const dwTranslate: DWORD; const pchURLIn: - POleStr; out ppchURLOut: POleStr): HRESULT; +function TCustomEmbeddedWB.TranslateUrl(const dwTranslate: DWORD; + const pchURLIn: POleStr; out ppchURLOut: POleStr): HRESULT; var URLOut: WideString; begin URLOut := ''; - if Assigned(FOnTranslateUrl) then - FOnTranslateUrl(Self, pchUrlIn, URLOut); + if Assigned(FOnTranslateUrL) then + FOnTranslateUrL(Self, pchURLIn, URLOut); if URLOut <> '' then begin Result := S_OK; @@ -1696,13 +1727,11 @@ function TCustomEmbeddedWB.UpdateUI: HRESULT; procedure TCustomEmbeddedWB.UpdateUserInterfaceValues; const - acardUserInterfaceValues: array[TUserInterfaceOption] of Cardinal = - ($00000001, $00000002, $00000004, $00000008, - $00000010, $00000020, $00000040, $00000080, - $00000100, $00000200, $00000400, $00000800, - $00001000, $00002000, $00004000, $00010000, $00020000, - $00040000, $00080000, $00100000, $00200000, $00400000, - $00800000, $01000000, $02000000, $04000000, $08000000, + acardUserInterfaceValues: array [TUserInterfaceOption] of Cardinal = + ($00000001, $00000002, $00000004, $00000008, $00000010, $00000020, + $00000040, $00000080, $00000100, $00000200, $00000400, $00000800, $00001000, + $00002000, $00004000, $00010000, $00020000, $00040000, $00080000, $00100000, + $00200000, $00400000, $00800000, $01000000, $02000000, $04000000, $08000000, $10000000, $20000000); var uio: TUserInterfaceOption; @@ -1716,12 +1745,10 @@ procedure TCustomEmbeddedWB.UpdateUserInterfaceValues; procedure TCustomEmbeddedWB.UpdateDownloadControlValues; const - acardDownloadControlValues: array[TDownloadControlOption] of Cardinal = - ($00000010, $00000020, $00000040, $00000080, - $00000100, $00000200, $00000400, $00000800, - $00001000, $00002000, $00004000, $00008000, - $00010000, $00020000, $00040000, $10000000, - $20000000, $40000000, $80000000); + acardDownloadControlValues: array [TDownloadControlOption] of Cardinal = + ($00000010, $00000020, $00000040, $00000080, $00000100, $00000200, + $00000400, $00000800, $00001000, $00002000, $00004000, $00008000, $00010000, + $00020000, $00040000, $10000000, $20000000, $40000000, $80000000); var dco: TDownloadControlOption; begin @@ -1736,7 +1763,8 @@ function TCustomEmbeddedWB.ZoomRangeHigh: Integer; var vaIn, vaOut: OleVariant; begin - InvokeCommand(nil, OLECMDID_GETZOOMRANGE, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut); + InvokeCommand(nil, OLECMDID_GETZOOMRANGE, OLECMDEXECOPT_DONTPROMPTUSER, + vaIn, vaOut); Result := HiWord(DWORD(vaOut)); end; @@ -1744,44 +1772,46 @@ function TCustomEmbeddedWB.ZoomRangeLow: Integer; var vaIn, vaOut: OleVariant; begin - InvokeCommand(nil, OLECMDID_GETZOOMRANGE, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut); - Result := LoWord(DWORD(vaOut)); + InvokeCommand(nil, OLECMDID_GETZOOMRANGE, OLECMDEXECOPT_DONTPROMPTUSER, + vaIn, vaOut); + Result := LOWORD(DWORD(vaOut)); end; function TCustomEmbeddedWB._getCookie: WideString; var - D: IHTMLDocument2; + D: IHtmlDocument2; begin - if Supports(Document, IHTMLDocument2, D) then + if Supports(Document, IHtmlDocument2, D) then Result := OleObject.Document.Cookie else Result := ''; end; -procedure TCustomEmbeddedWB.Client2HostWin(var CX, CY: Integer); +procedure TCustomEmbeddedWB.Client2HostWin(var cx, cy: Integer); var F: TCustomForm; begin F := GetParentForm(Self); if F <> nil then begin - Inc(CX, F.ClientWidth - Self.Width); - Inc(CY, F.ClientHeight - Self.Height); + Inc(cx, F.ClientWidth - Self.Width); + Inc(cy, F.ClientHeight - Self.Height); end; end; {$IFDEF USE_IOLECOMMANDTARGET} -//======IOleCommandTarget interface ============================================ +// ======IOleCommandTarget interface ============================================ -function TCustomEmbeddedWB.CommandTarget_QueryStatus(CmdGroup: PGUID; cCmds: Cardinal; - prgCmds: POleCmd; CmdText: POleCmdText): HRESULT; +function TCustomEmbeddedWB.CommandTarget_QueryStatus(CmdGroup: PGUID; + cCmds: Cardinal; prgCmds: POleCmd; CmdText: POleCmdText): HRESULT; begin prgCmds.cmdf := OLECMDF_ENABLED; Result := S_OK; end; -function TCustomEmbeddedWB.CommandTarget_Exec(CmdGroup: PGUID; nCmdID, nCmdexecopt: DWORD; - const vaIn: OleVariant; var vaOut: OleVariant): HRESULT; +function TCustomEmbeddedWB.CommandTarget_Exec(CmdGroup: PGUID; + nCmdID, nCmdexecopt: DWORD; const vaIn: OleVariant; + var vaOut: OleVariant): HRESULT; var tmpCancel: Boolean; const @@ -1799,7 +1829,7 @@ function TCustomEmbeddedWB.CommandTarget_Exec(CmdGroup: PGUID; nCmdID, nCmdexeco if CmdGroup <> nil then begin - if IsEqualGuid(cmdGroup^, CGID_EXPLORER) then + if IsEqualGuid(CmdGroup^, CGID_EXPLORER) then begin case nCmdID of OLECMDID_ONUNLOAD: @@ -1822,24 +1852,26 @@ function TCustomEmbeddedWB.CommandTarget_Exec(CmdGroup: PGUID; nCmdID, nCmdexeco end; if Assigned(FOnHookChildWindow) then - if (GetIEWin('Internet Explorer_Server') <> 0) or (GetIEWin('SysListView32') <> 0) then + if (GetIEWin('Internet Explorer_Server') <> 0) or + (GetIEWin('SysListView32') <> 0) then FOnHookChildWindow(Self); end; end end - else if IsEqualGuid(cmdGroup^, CGID_DocHostCommandHandler) then + else if IsEqualGuid(CmdGroup^, CGID_DocHostCommandHandler) then begin case nCmdID of - ID_IE_F5_REFRESH {nCmdID 6041, F5}, - ID_IE_CONTEXTMENU_REFRESH {nCmdID 6042, Refresh by ContextMenu}, - IDM_REFRESH {nCmdID 2300}: + ID_IE_F5_REFRESH { nCmdID 6041, F5 } , + ID_IE_CONTEXTMENU_REFRESH { nCmdID 6042, Refresh by ContextMenu } , + IDM_REFRESH { nCmdID 2300 } : begin if Assigned(FOnRefresh) then begin tmpCancel := False; FOnRefresh(Self, nCmdID, tmpCancel); if tmpCancel then - Result := S_OK; //FIXME is it true? Why not OLECMDERR_E_CANCELED + Result := S_OK; + // FIXME is it true? Why not OLECMDERR_E_CANCELED end; Exit; end; @@ -1852,8 +1884,8 @@ function TCustomEmbeddedWB.CommandTarget_Exec(CmdGroup: PGUID; nCmdID, nCmdexeco end; end; if Assigned(OnCommandExec) then - Self.OnCommandExec(Self, CmdGroup, nCmdID, nCmdexecopt, - vaIn, vaOut, Result); + Self.OnCommandExec(Self, CmdGroup, nCmdID, nCmdexecopt, vaIn, + vaOut, Result); end; {$ENDIF} @@ -1862,7 +1894,7 @@ function TCustomEmbeddedWB.ScriptErrorHandler(const vaIn: OleVariant; var EventObject: IHTMLEventObj; CurWindow: IHTMLWindow2; - CurDocument: IHTMLDocument2; + CurDocument: IHtmlDocument2; CurUnknown: IUnknown; function GetProperty(const PropName: WideString): OleVariant; @@ -1877,32 +1909,37 @@ function TCustomEmbeddedWB.ScriptErrorHandler(const vaIn: OleVariant; DispParams.cArgs := 0; DispParams.cNamedArgs := 0; PPropName := PWideChar(PropName); - Status := EventObject.GetIDsOfNames(GUID_NULL, @PPropName, 1, LOCALE_SYSTEM_DEFAULT, @Disp); + Status := EventObject.GetIDsOfNames(GUID_NULL, @PPropName, 1, + LOCALE_SYSTEM_DEFAULT, @Disp); if Status = 0 then begin - Status := EventObject.Invoke(disp, GUID_NULL, LOCALE_SYSTEM_DEFAULT, + Status := EventObject.Invoke(Disp, GUID_NULL, LOCALE_SYSTEM_DEFAULT, DISPATCH_PROPERTYGET, DispParams, @Result, @ExcepInfo, nil); if Status <> 0 then DispatchInvokeError(Status, ExcepInfo); end else if Status = DISP_E_UNKNOWNNAME then - raise - EOleError.CreateFmt('''%s'' is not supported.', [PropName]) + raise EOleError.CreateFmt('''%s'' is not supported.', [PropName]) else OleCheck(Status); end; + begin Result := S_OK; case FScriptErrorAction of - eaAskUser: Result := S_FALSE; //E_FAIL; - eaContinue: vaOut := True; - eaCancel: vaOut := False; + eaAskUser: + Result := S_FALSE; // E_FAIL; + eaContinue: + vaOut := True; + eaCancel: + vaOut := False; end; if Assigned(FOnScriptError) then begin CurUnknown := IUnknown(TVarData(vaIn).VUnknown); - if Succeeded(CurUnknown.QueryInterface(IID_IHTMLDocument2, CurDocument)) then + if Succeeded(CurUnknown.QueryInterface(IID_IHTMLDocument2, CurDocument)) + then begin CurWindow := CurDocument.Get_parentWindow; CurDocument := nil; @@ -1911,12 +1948,9 @@ function TCustomEmbeddedWB.ScriptErrorHandler(const vaIn: OleVariant; EventObject := CurWindow.Get_event; if EventObject <> nil then begin - FOnScriptError(Self, - GetProperty('errorline'), - GetProperty('errorCharacter'), - GetProperty('errorCode'), - GetProperty('errorMessage'), - GetProperty('errorUrl'), + FOnScriptError(Self, GetProperty('errorline'), + GetProperty('errorCharacter'), GetProperty('errorCode'), + GetProperty('errorMessage'), GetProperty('errorUrl'), FScriptErrorAction); end; end; @@ -1927,12 +1961,12 @@ function TCustomEmbeddedWB.ScriptErrorHandler(const vaIn: OleVariant; function TCustomEmbeddedWB.PopulateNamespaceTable: HRESULT; begin Result := S_OK; - if Assigned(fOnPopulateNSTable) then + if Assigned(FOnPopulateNSTable) then FOnPopulateNSTable(Self); end; -function TCustomEmbeddedWB.GetElementNamespaceTable( - out aTable: IElementNamespaceTable): Boolean; +function TCustomEmbeddedWB.GetElementNamespaceTable + (out aTable: IElementNamespaceTable): Boolean; var SP: IServiceProvider; begin @@ -1941,24 +1975,24 @@ function TCustomEmbeddedWB.GetElementNamespaceTable( aTable) = S_OK); end; -function WideStringToLPOLESTR(const Src: WideString): POLEStr; +function WideStringToLPOLESTR(const Src: WideString): POleStr; begin Result := CoTaskMemAlloc((Length(Src) + 1) * SizeOf(WideChar)); if Result <> nil then Move(PWideChar(Src)^, Result^, (Length(Src) + 1) * SizeOf(WideChar)); end; -function TCustomEmbeddedWB.Authenticate(var hwnd: HWnd; var szUserName, - szPassWord: LPWSTR): HRESULT; +function TCustomEmbeddedWB.Authenticate(var HWND: HWND; + var szUserName, szPassWord: LPWSTR): HRESULT; var aUser, aPwd: WideString; begin Result := S_OK; - hwnd := Self.Handle; + HWND := Self.Handle; aUser := ''; aPwd := ''; if Assigned(OnAuthenticate) then - OnAuthenticate(Self, hwnd, aUser, aPwd, Result); + OnAuthenticate(Self, HWND, aUser, aPwd, Result); if aUser <> '' then szUserName := WideStringToLPOLESTR(aUser) else @@ -1977,4 +2011,3 @@ function TEwbCore.IsCtrlCharMask: Boolean; end; end. - diff --git a/Source/EwbCoreTools.pas b/Source/EwbCoreTools.pas index 72a48aa..83585e8 100644 --- a/Source/EwbCoreTools.pas +++ b/Source/EwbCoreTools.pas @@ -72,7 +72,7 @@ function AddBackSlash(const S: string): string; implementation uses - IeConst, EwbAcc; + EWB.IeConst, EwbAcc; type {VerifyVersion} diff --git a/Source/EwbDDE.pas b/Source/EwbDDE.pas index 7ceadfd..44c6dcc 100644 --- a/Source/EwbDDE.pas +++ b/Source/EwbDDE.pas @@ -38,7 +38,7 @@ interface uses - Windows, Classes, ShellAPI, EWBAcc, Registry, EwbTools, ShlObj, IEConst, + Windows, Classes, ShellAPI, EWBAcc, Registry, EwbTools, ShlObj, EWB.IEConst, sysUtils, ActiveX, ComObj; type @@ -56,8 +56,7 @@ procedure DisposePIDL(ID: PItemIDList); implementation -uses - EwbCoreTools; + var FindFolder, OpenFolder, ExploreFolder, HtmlFileApp, HtmlFileTopic: string; diff --git a/Source/EwbDisableMouseWheelFix.pas b/Source/EwbDisableMouseWheelFix.pas index 1434bee..878a3f7 100644 --- a/Source/EwbDisableMouseWheelFix.pas +++ b/Source/EwbDisableMouseWheelFix.pas @@ -31,6 +31,6 @@ interface implementation initialization - EWBEnableMouseWheelFix := False; + //EWBEnableMouseWheelFix := False; end. diff --git a/Source/EwbEditors.pas b/Source/EwbEditors.pas index 991301b..9344133 100644 --- a/Source/EwbEditors.pas +++ b/Source/EwbEditors.pas @@ -43,8 +43,8 @@ interface {$I EWB.inc} uses -{$IFDEF DELPHI6_UP}DesignEditors, DesignIntf, StrEdit{$ELSE}DsgnIntf{$ENDIF} - , Classes; +DesignEditors, DesignIntf, StrEdit, + Classes; type TEwbCompEditor = class(TComponentEditor) @@ -109,7 +109,7 @@ TMultiStringProperty = class(TStringListProperty) implementation uses - Browse4Folder, TypInfo, ShellApi, Windows, Dialogs, SysUtils, IEConst, Forms, shlobj; + Browse4Folder, TypInfo, ShellApi, Windows, Dialogs, SysUtils, EWB.IEConst, Forms, shlobj; //--Verb Delphi menu------------------------------------------------------------ diff --git a/Source/EwbEventsComp.pas b/Source/EwbEventsComp.pas index eb0ba4a..646e465 100644 --- a/Source/EwbEventsComp.pas +++ b/Source/EwbEventsComp.pas @@ -44,7 +44,7 @@ interface uses {$IFDEF DELPHI6_UP}Variants, {$ENDIF} - Windows, Classes, ActiveX, Mshtml_Ewb, EwbAcc, EwbClasses, EwbEvents; + Windows, Classes, ActiveX, Mshtml_Ewb, EwbClasses, EwbEvents; type THtmlListener = class; @@ -224,7 +224,7 @@ THtmlListenerLink = class(TInterfacedDispatchObject, IHubLink) implementation uses - SysUtils, EwbCoreTools; + SysUtils; const _eventids: array[TEventEnum] of TEventID = ( diff --git a/Source/EwbFocusControl.pas b/Source/EwbFocusControl.pas index d6281bd..754ef5f 100644 --- a/Source/EwbFocusControl.pas +++ b/Source/EwbFocusControl.pas @@ -1,37 +1,37 @@ -//*********************************************************** -// TEWBFocusControl unit * -// * -// For Delphi 5 to XE * -// Freeware Component * -// by * -// (smot) * -// * -// Documentation and updated versions: * -// * -// http://www.bsalsa.com * -//*********************************************************** -{*******************************************************************************} -{LICENSE: -THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, -EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED -WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. -YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE -AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE -AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE -OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED -OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, -INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR -OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, -AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY -DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. - -You may use, change or modify the component under 4 conditions: -1. In your website, add a link to "http://www.bsalsa.com" -2. In your application, add credits to "Embedded Web Browser" -3. Mail me (bsalsa@gmail.com) any code change in the unit - for the benefit of the other users. -4. Please, consider donation in our web site! -{*******************************************************************************} +// *********************************************************** +// TEWBFocusControl unit * +// * +// For Delphi 5 to XE * +// Freeware Component * +// by * +// (smot) * +// * +// Documentation and updated versions: * +// * +// http://www.bsalsa.com * +// *********************************************************** +{ ******************************************************************************* } +{ LICENSE: + THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, + EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED + WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. + YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE + AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE + AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE + OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED + OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, + INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR + OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, + AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY + DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. + + You may use, change or modify the component under 4 conditions: + 1. In your website, add a link to "http://www.bsalsa.com" + 2. In your application, add credits to "Embedded Web Browser" + 3. Mail me (bsalsa@gmail.com) any code change in the unit + for the benefit of the other users. + 4. Please, consider donation in our web site! + {******************************************************************************* } unit EwbFocusControl; @@ -110,27 +110,29 @@ constructor TEWBFocusControl.Create; end; class procedure TEWBFocusControl.Activate(Value: Boolean) - {: TEWBApplicationHook}; +{ : TEWBApplicationHook }; const {$J+} Instance: TEWBFocusControl = nil; {$J-} begin - if EWBEnableFocusControl then - case Value of - True: + case Value of + True: + begin + if EWBEnableFocusControl then begin if not Assigned(Instance) then Instance := Create; end; - False: - begin - if Assigned(EWBAppHookInstance) then - FreeAndNil(EWBAppHookInstance); - if Assigned(Instance) then - FreeAndNil(Instance); - end; - end; + end; + False: + begin + if Assigned(EWBAppHookInstance) then + FreeAndNil(EWBAppHookInstance); + if Assigned(Instance) then + FreeAndNil(Instance); + end; + end; end; // -- TAppHookWindow ----------------------------------------------------------- @@ -140,33 +142,40 @@ function TAppHookWindow.MessageHook(var Msg: TMessage): Boolean; ActiveControl: TWinControl; ActiveForm: TCustomForm; bContinue: Boolean; -// s: string; + // s: string; begin Result := False; - if (Msg.Msg = WM_WINDOWPOSCHANGING) or (Msg.Msg = CM_ACTIVATE) then + if EWBEnableFocusControl then begin - ActiveForm := Screen.ActiveForm; - if Assigned(ActiveForm) then - begin - if Screen.ActiveForm.FormStyle = fsMDIChild then // Check if MDI - bContinue := IsChild(GetActiveWindow, ActiveForm.Handle) - else - bContinue := not Forms.Application.Terminated and ActiveForm.HandleAllocated and - (ActiveForm.Handle = GetActiveWindow); - if bContinue and (ActiveForm.CanFocus) then + if (Msg.Msg = WM_WINDOWPOSCHANGING) or (Msg.Msg = CM_ACTIVATE) then + begin + ActiveForm := Screen.ActiveForm; + if Assigned(ActiveForm) then begin - ActiveControl := ActiveForm.ActiveControl; - // s := '** MessageHook ' + ActiveControl.ClassName + ' ' + Inttostr(ActiveForm.Handle) + ' ' + Inttostr(GetFocus); - // OutputDebugString(PChar(s)); - if Assigned(ActiveControl) and ((ActiveControl.ClassName = 'TEmbeddedWB') or - (ActiveControl.ClassName = 'TEWBCore')) then - if GetFocus <> ActiveControl.Handle then - begin - PostMessage(ActiveControl.Handle, WM_SETWBFOCUS, Integer(ActiveControl), 0); - // OutputDebugString(PChar('Focus set')); - // ActiveControl.SetFocus doesn't work when switching between forms. - end; + if Screen.ActiveForm.FormStyle = fsMDIChild then // Check if MDI + bContinue := IsChild(GetActiveWindow, ActiveForm.Handle) + else + bContinue := not Forms.Application.Terminated and + ActiveForm.HandleAllocated and + (ActiveForm.Handle = GetActiveWindow); + + if bContinue and (ActiveForm.CanFocus) then + begin + ActiveControl := ActiveForm.ActiveControl; + // s := '** MessageHook ' + ActiveControl.ClassName + ' ' + Inttostr(ActiveForm.Handle) + ' ' + Inttostr(GetFocus); + // OutputDebugString(PChar(s)); + if Assigned(ActiveControl) and + ((ActiveControl.ClassName = 'TEmbeddedWB') or + (ActiveControl.ClassName = 'TEWBCore')) then + if GetFocus <> ActiveControl.Handle then + begin + PostMessage(ActiveControl.Handle, WM_SETWBFOCUS, + Integer(ActiveControl), 0); + // OutputDebugString(PChar('Focus set')); + // ActiveControl.SetFocus doesn't work when switching between forms. + end; + end; end; end; end; @@ -174,8 +183,11 @@ function TAppHookWindow.MessageHook(var Msg: TMessage): Boolean; destructor TAppHookWindow.Destroy; begin - inherited; - Deactivate; + try + Deactivate; + finally + inherited; + end; end; procedure TAppHookWindow.Activate; @@ -190,7 +202,7 @@ procedure TAppHookWindow.Activate; procedure TAppHookWindow.Deactivate; begin - if Assigned(Application) then + if Assigned(Application) and (FHookSet) then begin Application.UnHookMainWindow(MessageHook); FHookSet := False; diff --git a/Source/EwbReg.pas b/Source/EwbReg.pas index a55b4b8..9335d70 100644 --- a/Source/EwbReg.pas +++ b/Source/EwbReg.pas @@ -1,37 +1,37 @@ -//************************************************************** -// * -// Ewb_Reg * -// * -// For Delphi * -// by * -// bsalsa - Eran Bodankin - bsalsa@gmail.com * -// * -// * -// Updated versions: * -// http://www.bsalsa.com * -//************************************************************** -{*******************************************************************************} -{LICENSE: -THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, -EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED -WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. -YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE -AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE -AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE -OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED -OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, -INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR -OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, -AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY -DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. +// ************************************************************** +// * +// Ewb_Reg * +// * +// For Delphi * +// by * +// bsalsa - Eran Bodankin - bsalsa@gmail.com * +// * +// * +// Updated versions: * +// http://www.bsalsa.com * +// ************************************************************** +{ ******************************************************************************* } +{ LICENSE: + THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, + EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED + WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. + YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE + AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE + AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE + OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED + OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, + INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR + OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, + AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY + DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. -You may use, change or modify the component under 4 conditions: -1. In your website, add a link to "http://www.bsalsa.com" -2. In your application, add credits to "Embedded Web Browser" -3. Mail me (bsalsa@gmail.com) any code change in the unit - for the benefit of the other users. -4. Please, consider donation in our web site! -{*******************************************************************************} + You may use, change or modify the component under 4 conditions: + 1. In your website, add a link to "http://www.bsalsa.com" + 2. In your application, add credits to "Embedded Web Browser" + 3. Mail me (bsalsa@gmail.com) any code change in the unit + for the benefit of the other users. + 4. Please, consider donation in our web site! + {******************************************************************************* } unit EwbReg; @@ -40,12 +40,15 @@ interface {$I EWB.inc} uses - Classes, {$IFDEF DELPHI6_UP}DesignEditors, DesignIntf, {$ELSE}DsgnIntf, {$ENDIF} - EwbEditors, AppWebUpdater, IEParser, ExportFavorites, FavoritesTree, IETravelLog, + Classes, {$IFDEF DELPHI6_UP}DesignEditors, DesignIntf, {$ELSE}DsgnIntf, +{$ENDIF} + EwbEditors, AppWebUpdater, IEParser, ExportFavorites, FavoritesTree, + IETravelLog, FavMenu, FavoritesListView, FavoritesPopup, HistoryMenu, HistoryListView, ImportFavorites, LibXmlComps, LibXmlParser, LinksBar, RichEditBrowser, SecurityManager, SendMail_For_Ewb, UrlHistory, Edithost, EditDesigner, - IEAddress, IEDownload, IEMultiDownload, EwbCore, EmbeddedWB, EwbControlComponent, IECache, Browse4Folder, + IEAddress, IEDownload, IEMultiDownload, EwbCore, EmbeddedWB, + EwbControlComponent, IECache, Browse4Folder, FileExtAssociate, LinksLabel, UI_Less, {$IFDEF DELPHI6_UP}EwbEventsComp, EwbBehaviorsComp, {$ENDIF}EwbActns; @@ -54,51 +57,25 @@ procedure Register; implementation uses - SysUtils, ActnList; + System.Actions, ToolsAPI, WctlForm, + SysUtils, ActnList, DateUtils, Windows; procedure Register; begin - RegisterComponents('Embedded Web Browser', [ - TBrowse4Folder, + RegisterComponents('Embedded Web Browser', [TBrowse4Folder, {$IFDEF DELPHI6_UP} - TEwbBehaviorFactory, - TEwbBehaviorController, + TEwbBehaviorFactory, TEwbBehaviorController, {$ENDIF} - TEasyXmlScanner, - TEditDesigner, - TEdithost, - TEmbeddedWB, - TEwbCore, - TEwbControl, - TEwbMapiMail, - TExportFavorite, - TFavoritesListView, - TFavoritesMenu, - TFavoritesPopup, - TFavoritesTree, - TFileExtAssociate, - THistoryListView, - THistoryMenu, + TEasyXmlScanner, TEditDesigner, TEdithost, TEmbeddedWB, TEwbCore, + TEwbControl, TEwbMapiMail, TExportFavorite, TFavoritesListView, + TFavoritesMenu, TFavoritesPopup, TFavoritesTree, TFileExtAssociate, + THistoryListView, THistoryMenu, {$IFDEF DELPHI6_UP} THtmlListener, {$ENDIF} - TIEAddress, - TIECache, - TIEDownload, - TIEMultiDownload, - TIEParser, - TIETravelLog, - TImportFavorite, - TLinksLabel, - TLinksBar, - TRichEditWB, - TSecurityManager, - TUILess, - TUrlHistory, - TWebUpdater, - TXmlScanner - ]); - + TIEAddress, TIECache, TIEDownload, TIEMultiDownload, TIEParser, + TIETravelLog, TImportFavorite, TLinksLabel, TLinksBar, TRichEditWB, + TSecurityManager, TUILess, TUrlHistory, TWebUpdater, TXmlScanner]); RegisterComponentEditor(TBrowse4Folder, TBFFEditor); {$IFDEF DELPHI6_UP} @@ -138,15 +115,34 @@ procedure Register; RegisterComponentEditor(TWebUpdater, TEwbCompEditor); RegisterComponentEditor(TXmlScanner, TEwbCompEditor); - - RegisterPropertyEditor(TypeInfo(WideString), TIEDownload, 'DownloadDir', TBrowse4FolderDLG); - RegisterPropertyEditor(TypeInfo(WideString), TIEParser, 'LocalFileName', TOpenFileDLG); - RegisterPropertyEditor(TypeInfo(WideString), TIEParser, 'SaveLogAs', TSaveTextDLG); - RegisterPropertyEditor(TypeInfo(WideString), TBrowse4Folder, 'InitialDir', TBrowse4FolderDLG); + RegisterPropertyEditor(TypeInfo(WideString), TIEDownload, 'DownloadDir', + TBrowse4FolderDLG); + RegisterPropertyEditor(TypeInfo(WideString), TIEParser, 'LocalFileName', + TOpenFileDLG); + RegisterPropertyEditor(TypeInfo(WideString), TIEParser, 'SaveLogAs', + TSaveTextDLG); + RegisterPropertyEditor(TypeInfo(WideString), TBrowse4Folder, 'InitialDir', + TBrowse4FolderDLG); {$IFDEF DELPHI6_UP} - RegisterPropertyEditor(TypeInfo(WideString), TEmbeddedWB, 'HostCSS', TMultiStringProperty); + RegisterPropertyEditor(TypeInfo(WideString), TEmbeddedWB, 'HostCSS', + TMultiStringProperty); {$ENDIF} RegisterActions('EmbeddedWB', [TEwbLinkAction], nil); end; +procedure RegisterSplashScreen; +var + ProductImage: HBITMAP; +begin + Assert(Assigned(SplashScreenServices), + 'Unable to get Borland Splash Services'); + ProductImage := LoadBitmap(FindResourceHInstance(HInstance), 'TEMBEDDEDWB'); + SplashScreenServices.AddPluginBitmap('TEmbeddedWB', ProductImage, False, + 'Open Source ' + IntToStr(YearOf(Now))); +end; + +initialization + +RegisterSplashScreen; + end. diff --git a/Source/EwbTools.pas b/Source/EwbTools.pas index 84091ba..4cf2106 100644 --- a/Source/EwbTools.pas +++ b/Source/EwbTools.pas @@ -1,38 +1,38 @@ -//*********************************************************** -// EwbTools * -// * -// For Delphi * -// Freeware unit * -// by * -// bsalsa, Smot, * -// per lindso larsen * -// * -// Documentation and updated versions: * -// http://www.bsalsa.com * -//*********************************************************** - -{*******************************************************************************} -{LICENSE: -THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, -EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED -WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. -YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE -AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE -AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE -OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED -OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, -INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR -OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, -AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY -DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. - -You may use, change or modify the component under 4 conditions: -1. In your website, add a link to "http://www.bsalsa.com" -2. In your application, add credits to "Embedded Web Browser" -3. Mail me (bsalsa@gmail.com) any code change in the unit - for the benefit of the other users. -4. Please, consider donation in our web site! -{*******************************************************************************} +// *********************************************************** +// EwbTools * +// * +// For Delphi * +// Freeware unit * +// by * +// bsalsa, Smot, * +// per lindso larsen * +// * +// Documentation and updated versions: * +// http://www.bsalsa.com * +// *********************************************************** + +{ ******************************************************************************* } +{ LICENSE: + THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, + EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED + WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. + YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE + AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE + AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE + OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED + OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, + INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR + OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, + AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY + DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. + + You may use, change or modify the component under 4 conditions: + 1. In your website, add a link to "http://www.bsalsa.com" + 2. In your application, add credits to "Embedded Web Browser" + 3. Mail me (bsalsa@gmail.com) any code change in the unit + for the benefit of the other users. + 4. Please, consider donation in our web site! + {******************************************************************************* } unit EwbTools; @@ -48,23 +48,26 @@ interface var PrintingWithOptions: Boolean; -//Document and Frame + // Document and Frame function DocumentLoaded(Document: IDispatch): Boolean; procedure AssignEmptyDocument(WebBrowser: TEmbeddedWB); -//Html -function AddHtmlToAboutBlank(WebBrowser: TEmbeddedWB; StringToHtml: string): Boolean; +// Html +function AddHtmlToAboutBlank(WebBrowser: TEmbeddedWB; + StringToHtml: string): Boolean; function DocumentSourceText(OleObject: Variant; Document: IDispatch): string; function DocumentSource(OleObject: Variant): string; function GetWordAtCursor(const X, Y: Integer; WebBrowser: TEmbeddedWB): string; -//frames +// frames function GetFrame(Document: IDispatch; FrameNo: Integer): IWebBrowser2; -function GetFrameFromDocument(SourceDoc: IHTMLDocument2; FrameNo: Integer): IWebBrowser2; //By Aladin +function GetFrameFromDocument(SourceDoc: IHTMLDocument2; FrameNo: Integer) + : IWebBrowser2; // By Aladin function FrameCount(Document: IDispatch): Longint; -function FrameCountFromDocument(SourceDoc: IHTMLDocument2): Integer; //By Aladin +function FrameCountFromDocument(SourceDoc: IHTMLDocument2): Integer; +// By Aladin -//Document Operations +// Document Operations procedure SetFocusToDoc(WebBrowser: TEmbeddedWB; Dispatch, Document: IDispatch); function CMD_Copy(Document: IDispatch): Boolean; function Cmd_Paste(Document: IDispatch): Boolean; @@ -72,14 +75,16 @@ function Cmd_Cut(Document: IDispatch): Boolean; function SelectAll(Document: IDispatch): Boolean; function UnSelectAll(Document: IDispatch): Boolean; -//scroll +// scroll procedure ScrollToTop(OleObject: Variant); procedure ScrollToPosition(OleObject: Variant; X, Y: Integer); procedure ScrollToBottom(Document: IDispatch); procedure ScrollToID(ID: Integer; WebBrowser: TEmbeddedWB); procedure ScrollToIDEx(ID: string; WebBrowser: TEmbeddedWB); -procedure GetScrollBarVisibility(WebBrowser: TEmbeddedWB; var HScroll, VScroll: Boolean); -function GetScrollBarPosition(WebBrowser: TEmbeddedWB; var ScrollPos: TPoint): Boolean; +procedure GetScrollBarVisibility(WebBrowser: TEmbeddedWB; + var HScroll, VScroll: Boolean); +function GetScrollBarPosition(WebBrowser: TEmbeddedWB; + var ScrollPos: TPoint): Boolean; // zoom function Zoom(Document: IDispatch; ZoomValue: Integer): Boolean; @@ -87,38 +92,54 @@ function ZoomValue(Document: IDispatch): Integer; function ZoomRangeHigh(Document: IDispatch): Integer; function ZoomRangeLow(Document: IDispatch): Integer; -function SetCharartersSet(WebBrowser: TEmbeddedWB; Document: IDispatch; const ACharactersSet: string; Refresh: Boolean = True): Boolean; +function SetCharartersSet(WebBrowser: TEmbeddedWB; Document: IDispatch; + const ACharactersSet: string; Refresh: Boolean = True): Boolean; procedure GetThumbnail(Dispatch: IDispatch; var Image: TImage); -function GetBmpFromBrowser(Document: IDispatch; Handle: THandle; Width, Height: Integer; FileName: string): Boolean; -function GetJPEGfromBrowser(Document: IDispatch; ControlInterface: IWebBrowser2; FileName: string; SourceHeight, SourceWidth, TargetHeight, TargetWidth: Integer): Boolean; +function GetBmpFromBrowser(Document: IDispatch; Handle: THandle; + Width, Height: Integer; FileName: string): Boolean; +function GetJPEGfromBrowser(Document: IDispatch; ControlInterface: IWebBrowser2; + FileName: string; SourceHeight, SourceWidth, TargetHeight, + TargetWidth: Integer): Boolean; -//View Document Fields/Properties/Images +// View Document Fields/Properties/Images procedure ViewPageLinksToStrings(OleObject: Variant; LinksList: TStrings); -procedure ViewPageSourceHTMLToStrings(OleObject: Variant; Document: IDispatch; HtmlList: TStrings); -procedure ViewPageSourceTextToStrings(OleObject: Variant; Document: IDispatch; TextList: TStrings); +procedure ViewPageSourceHTMLToStrings(OleObject: Variant; Document: IDispatch; + HtmlList: TStrings); +procedure ViewPageSourceTextToStrings(OleObject: Variant; Document: IDispatch; + TextList: TStrings); procedure ViewPageSourceText(OleObject: Variant; Document: IDispatch); -//Save +// Save function SaveDocToStrings(Document: IDispatch; var AStrings: TStrings): HRESULT; function SaveDocToStream(Document: IDispatch; var AStream: TStream): HRESULT; function SaveDocToFile(Document: IDispatch; const Fname: string): HRESULT; -//Printing -procedure Print(ControlInterface: IWebBrowser2; bHideSetup: Boolean = False; bCustomHeaderFooter: Boolean = False; Header: string = ''; Footer: string = ''); -procedure PrintWithOptions(ControlInterface: IWebBrowser2; Document: IDispatch; UsePrintOptions, PrintOptionsEnabled, HideSetup: Boolean; var InvokingPageSetup: Boolean); -procedure PrintPreview(Webbrowser: IWebBrowser2); -procedure PrintPreviewExtended(ControlInterface: IWebBrowser2; nCMDShow: Integer; HideSetup: Boolean); -procedure PrintPreviewFromTemplate(const TemplateFileName: string; Document: IDispatch); -function PageSetup(Document: IDispatch; UsePrintOptions, PrintOptionsEnabled: Boolean; var InvokingPageSetup: Boolean): Boolean; +// Printing +procedure Print(ControlInterface: IWebBrowser2; bHideSetup: Boolean = False; + bCustomHeaderFooter: Boolean = False; Header: string = ''; + Footer: string = ''); +procedure PrintWithOptions(ControlInterface: IWebBrowser2; Document: IDispatch; + UsePrintOptions, PrintOptionsEnabled, HideSetup: Boolean; + var InvokingPageSetup: Boolean); +procedure PrintPreview(WebBrowser: IWebBrowser2); +procedure PrintPreviewExtended(ControlInterface: IWebBrowser2; + nCMDShow: Integer; HideSetup: Boolean); +procedure PrintPreviewFromTemplate(const TemplateFileName: string; + Document: IDispatch); +function PageSetup(Document: IDispatch; + UsePrintOptions, PrintOptionsEnabled: Boolean; + var InvokingPageSetup: Boolean): Boolean; procedure PrintSetup(ControlInterface: IWebBrowser2; HideSetup: Boolean); -procedure GetPrintValues(WebBrowser: TEmbeddedWB; PrintOptions: TPrintOptions; Measure: TMeasure); +procedure GetPrintValues(WebBrowser: TEmbeddedWB; PrintOptions: TPrintOptions; + Measure: TMeasure); function PrintMarginStr(Measure, RuntimeMeasure: TMeasure; M: Real): string; procedure RestorePrintValues; -//Dialogs +// Dialogs function OpenDialog(WebBrowser: TEmbeddedWB; AOwner: TComponent): Boolean; function SaveDialog(Document: IDispatch): Boolean; overload; -function SaveDialog(WebBrowser: TEmbeddedWB; AOwner: TComponent; ATitle: string = ''; AFilter: string = ''): string; overload; +function SaveDialog(WebBrowser: TEmbeddedWB; AOwner: TComponent; + ATitle: string = ''; AFilter: string = ''): string; overload; function ShowInternetOptions(Document: IDispatch): Boolean; function ShowPageProperties(Document: IDispatch): Boolean; @@ -127,9 +148,10 @@ procedure ShowImportExportFavoritesAndCookies(Handle: THandle); function ShowFindDialog(Document: IDispatch): Boolean; procedure SaveImagesDialog(OleObject: Variant; Document: IDispatch); function ViewPageSourceHtml(Document: IDispatch): Boolean; -procedure SavePageTextDialog(AOwner: TComponent; OleObject: Variant; Document: IDispatch); +procedure SavePageTextDialog(AOwner: TComponent; OleObject: Variant; + Document: IDispatch); -//Open external programs +// Open external programs procedure OpenAddressBook; procedure OpenEudoraMail; procedure OpenOutlookExpressMail; @@ -142,7 +164,7 @@ function OpenNewsClient: Boolean; procedure DoExploreFolder(Handle: THandle; Path: string); procedure OpenIEBrowserWithAddress(Handle: THandle); -//Open specific webpages +// Open specific webpages function OpenHotmailMail(WebBrowser: TEmbeddedWB): Boolean; function OpenYahooMail(WebBrowser: TEmbeddedWB): Boolean; function OpenGoogleMail(WebBrowser: TEmbeddedWB): Boolean; @@ -150,17 +172,17 @@ procedure GoSearchInGoogle(WebBrowser: TEmbeddedWB; SearchTerm: string); procedure GoSearchInMSN(WebBrowser: TEmbeddedWB; SearchTerm: string); procedure GoSearchInYahoo(WebBrowser: TEmbeddedWB; SearchTerm: string); -//Navigate & Download +// Navigate & Download procedure Go(WebBrowser: TEmbeddedWB; Url: string); procedure GoWithQueryDetails(WebBrowser: TEmbeddedWB; Url, Query: string); -procedure GoNoHistory(WebBrowser: TEmbeddedWB; const URL: string); +procedure GoNoHistory(WebBrowser: TEmbeddedWB; const Url: string); procedure NavigatePidl(WebBrowser: TEmbeddedWB; pidl: PItemIdList); procedure GoAboutBlank(WebBrowser: TEmbeddedWB); -procedure GoDownloadFile(WebBrowser: TEmbeddedWB; URL: string); +procedure GoDownloadFile(WebBrowser: TEmbeddedWB; Url: string); function DownloadFile(SourceFile, TargetFile: string): Boolean; procedure GoDownloadMaskedFile(SourceFile, TargetFile: string; Notify: Boolean); -//Get Special Folders/URL paths etc. +// Get Special Folders/URL paths etc. function GetSpecialFolderPath(CallerHandle: THandle; CSIDL: Integer): PChar; function GetShellFolderPath(FolderName: Widestring): string; function GetIEHomePage: string; @@ -169,161 +191,177 @@ function GetCachedFileFromURL(ItemUrl: string): string; function GetDefaultBrowserFromRegistry: string; function GetIPAndHostName(var HostName, IPaddr, WSAErr: string): Boolean; - -//E-Mail functions -procedure SendPageInMailAsAttachment(WebBrowser: TEmbeddedWB; AOwner: TComponent; Document: IDispatch; mFileName, mSubject, mBody: string); +// E-Mail functions +procedure SendPageInMailAsAttachment(WebBrowser: TEmbeddedWB; + AOwner: TComponent; Document: IDispatch; mFileName, mSubject, mBody: string); function CreateNewMail: Boolean; -procedure SendUrlInMail(LocationURL, LocationName: WideString); +procedure SendUrlInMail(LocationURL, LocationName: Widestring); -//Search in Document & Fill Forms -function SearchString(Webbrowser: TEmbeddedWB; const strText: string): Boolean; -//function SearchText(WebBrowser: TEmbeddedWB; Document: IDispatch; const Value: string; const iPos: Integer = 1): IHTMLTxtRange; -function SearchText(WebBrowser: TEmbeddedWB; Document: IDispatch; const Value: string; aTypeSearch: Integer; const iPos: Integer = 1): IHTMLTxtRange; +// Search in Document & Fill Forms +function SearchString(WebBrowser: TEmbeddedWB; const strText: string): Boolean; +// function SearchText(WebBrowser: TEmbeddedWB; Document: IDispatch; const Value: string; const iPos: Integer = 1): IHTMLTxtRange; +function SearchText(WebBrowser: TEmbeddedWB; Document: IDispatch; + const Value: string; aTypeSearch: Integer; const iPos: Integer = 1) + : IHTMLTxtRange; -procedure SearchAndHighlight(Document: IDispatch; - AText: string; const ACaption, APrompt: string; Flags: TSearchFlags = []; +procedure SearchAndHighlight(Document: IDispatch; AText: string; + const ACaption, APrompt: string; Flags: TSearchFlags = []; cbackColor: string = 'yellow'; cForeColor: string = ''; - ScrollIntoView: TScrollIntoView = sivNoScroll; ShowInputQuery: Boolean = True); overload; + ScrollIntoView: TScrollIntoView = sivNoScroll; + ShowInputQuery: Boolean = True); overload; -procedure SearchAndHighlight(Document: IDispatch; aText: string; Flags: TSearchFlags = []; - cbackColor: string = 'yellow'; cForeColor: string = ''; +procedure SearchAndHighlight(Document: IDispatch; AText: string; + Flags: TSearchFlags = []; cbackColor: string = 'yellow'; + cForeColor: string = ''; ScrollIntoView: TScrollIntoView = sivNoScroll); overload; -procedure SetTextAreaValue(Document: IDispatch; sName, sValue: string; Options: TFindOptions); -function FillForm(WebBrowser: TEmbeddedWB; FieldName, FieldValue: string; ElementNr: Integer = -1): Boolean; overload; -function FillForm(Document: IDispatch; FieldName: string; FieldValue: string; ElementNr: Integer = -1): Boolean; overload; - -function FillForm(WebBrowser: TEmbeddedWB; FieldName: string; FieldValue: string; Value: Boolean): Boolean; overload; +procedure SetTextAreaValue(Document: IDispatch; sName, sValue: string; + Options: TFindOptions); +function FillForm(WebBrowser: TEmbeddedWB; FieldName, FieldValue: string; + ElementNr: Integer = -1): Boolean; overload; +function FillForm(Document: IDispatch; FieldName: string; FieldValue: string; + ElementNr: Integer = -1): Boolean; overload; +function FillForm(WebBrowser: TEmbeddedWB; FieldName: string; + FieldValue: string; Value: Boolean): Boolean; overload; function GetFieldValue(OleObject: Variant; FieldName: string): string; procedure ClickInputImage(WebBrowser: TEmbeddedWB; ImageURL: string); procedure FillIEFormAndExcecute; -//Clearing +// Clearing procedure ClearCache; procedure ClearTypedUrls; -//Online Status +// Online Status function CheckOnlineStatus: Boolean; function IsGlobalOffline: Boolean; procedure WorkOffline(); procedure WorkOnline(); -//Restricted & Trusted Lists -function CheckIfInRestricredList(const Host: string; SecureSite: Boolean): Boolean; +// Restricted & Trusted Lists +function CheckIfInRestricredList(const Host: string; + SecureSite: Boolean): Boolean; function CheckIfInTrustedList(const Host: string; SecureSite: Boolean): Boolean; -procedure AddToTrustedSiteList(WebBrowser: TEmbeddedWB; const URL: string); -procedure AddToRestrictedSiteList(WebBrowser: TEmbeddedWB; const URL: string); +procedure AddToTrustedSiteList(WebBrowser: TEmbeddedWB; const Url: string); +procedure AddToRestrictedSiteList(WebBrowser: TEmbeddedWB; const Url: string); -//Zone Icon, Security Zone, SSL Status +// Zone Icon, Security Zone, SSL Status procedure GetZoneIcon(IconPath: string; var Icon: TIcon); function GetZoneIconToForm(LocationURL: string; Caption, Hint: string): Boolean; -function GetZoneAttributes(const URL: string): TZoneAttributes; -function GetSSLStatus(OleObject: Variant; LocationURL: string; var SSLName, SSLDescription: string): Boolean; -function GetUrlSecurityZone(LocationURL: string; var ZoneName, ZoneDescription: string; var Icon: TIcon): Boolean; +function GetZoneAttributes(const Url: string): TZoneAttributes; +function GetSSLStatus(OleObject: Variant; LocationURL: string; + var SSLName, SSLDescription: string): Boolean; +function GetUrlSecurityZone(LocationURL: string; + var ZoneName, ZoneDescription: string; var Icon: TIcon): Boolean; -//Proxy & User agent +// Proxy & User agent function SetProxy(UserAgent, Address, Bypass: string): Boolean; overload; -function SetProxy(UserAgent, Address, UserName, Password: string; Port: Integer): Boolean; overload; +function SetProxy(UserAgent, Address, UserName, Password: string; Port: Integer) + : Boolean; overload; function SetProxyFromPAC(UserAgent, PACFile: string): Boolean; function RemoveProxy(): Boolean; procedure RemoveUserAgent(UserAgent: string); -//MIME Filter & NameSpace +// MIME Filter & NameSpace function RegisterMIMEFilter(clsid: TGUID; MIME: PWideChar): HRESULT; function UnregisterMIMEFilter(MIME: PWideChar): HRESULT; function RegisterNameSpace(clsid: TGUID): HRESULT; function UnregisterNameSpace: HRESULT; -//Cookies +// Cookies function GetCookiesPath: string; procedure ClearSessionCookies; -//Favorites -function OrganizeFavorite(h: THandle; Path: PAnsiChar): Boolean; stdcall; overload; +// Favorites +function OrganizeFavorite(h: THandle; Path: PAnsiChar): Boolean; + stdcall; overload; {$IFDEF UNICODE} function OrganizeFavorite(h: THandle; Path: PWideChar): Boolean; overload; {$ENDIF UNICODE} - function URLFromFavorites(const dotURL: string): string; function GetFavoritesPath: string; -procedure AddToFavorites(URL, Title: string); +procedure AddToFavorites(Url, Title: string); -//History +// History function GetHistoryPath: string; -function UrlFromHistory(ShellFolder: IShellFolder; pidl: PItemIDList): string; +function UrlFromHistory(ShellFolder: IShellFolder; pidl: PItemIdList): string; procedure ClearHistory; -//Pages +// Pages procedure SetNewHomePage(HomePage: string); function GetLastVisitedPage(var LastVisitedPage: string): Boolean; -function SaveLastVisitedPage(WebBrowser: TEmbeddedWB; LocationURL: string): Boolean; +function SaveLastVisitedPage(WebBrowser: TEmbeddedWB; + LocationURL: string): Boolean; -//Code accessories +// Code accessories procedure Wait(WebBrowser: TEmbeddedWB); -function InvokeCMD(Document: IDispatch; InvokeIE: Boolean; Value1, Value2: Integer; var vaIn, vaOut: OleVariant): HRESULT; +function InvokeCMD(Document: IDispatch; InvokeIE: Boolean; + Value1, Value2: Integer; var vaIn, vaOut: OleVariant): HRESULT; function GetIEHandle(WebBrowser: TEmbeddedWB; ClassName: string): HWND; -//Execute Script +// Execute Script procedure ExecScript(WebBrowser: TEmbeddedWB; sExpression, sLanguage: string); -function ExecScriptEx(WebBrowser: TEmbeddedWB; MethodName: string; ParamValues: array of const): OleVariant; -function WBExecScript(TargetObj: IDispatch; MethodName: string; ParamValues: array of const): OleVariant; +function ExecScriptEx(WebBrowser: TEmbeddedWB; MethodName: string; + ParamValues: array of const): OleVariant; +function WBExecScript(TargetObj: IDispatch; MethodName: string; + ParamValues: array of const): OleVariant; -//Miscellaneous +// Miscellaneous procedure RestoreApplicationFormSize(WebBrowser: TEmbeddedWB); procedure SaveApplicationFormSize(WebBrowser: TEmbeddedWB); procedure ShowIEVersionInfo(Handle: THandle); procedure CreateDesktopShortcut(Handle: THandle); procedure DisableNavSound(bDisable: Boolean); -//----- add to ewb------------------------------------------------------- -function ConcatPIDLs(IDList1, IDList2: PItemIDList): PItemIDList; -function CopyITEMID(Malloc: IMalloc; ID: PItemIDList): PItemIDList; -function CopyPIDL(IDList: PItemIDList): PItemIDList; -function CreatePIDL(Size: Integer): PItemIDList; -function DeleteUrl(Url: PWideChar): HResult; +// ----- add to ewb------------------------------------------------------- +function ConcatPIDLs(IDList1, IDList2: PItemIdList): PItemIdList; +function CopyITEMID(Malloc: IMalloc; ID: PItemIdList): PItemIdList; +function CopyPIDL(IDList: PItemIdList): PItemIdList; +function CreatePIDL(Size: Integer): PItemIdList; +function DeleteUrl(Url: PWideChar): HRESULT; function Encode(const S: string): string; -function ExtractUrl(ShellFolder: IShellFolder; pidl: PItemIDList): string; -function GetDisplayName(Folder: IShellFolder; pidl: PItemIDList): string; -function GetFileName(Folder: IShellFolder; pidl: PItemIDList): string; +function ExtractUrl(ShellFolder: IShellFolder; pidl: PItemIdList): string; +function GetDisplayName(Folder: IShellFolder; pidl: PItemIdList): string; +function GetFileName(Folder: IShellFolder; pidl: PItemIdList): string; function GetIEVersion: string; function GetIEVersionMajor: Integer; -function GetImageIndex(pidl: PItemIDList): Integer; +function GetImageIndex(pidl: PItemIdList): Integer; function GetMailClients: TStrings; -function GetPIDLSize(IDList: PItemIDList): Integer; +function GetPIDLSize(IDList: PItemIdList): Integer; function IE5_Installed: Boolean; -function IsChannel(ChannelShortcut: string; ShellFolder: IShellFolder; ID: PItemIDList): Boolean; -function IsFolder(ShellFolder: IShellFolder; ID: PItemIDList): Boolean; -function IsFolderEx(ChannelShortcut: string; ShellFolder: IShellFolder; ID: PItemIDList): Boolean; - - - - -function NextPIDL(IDList: PItemIDList): PItemIDList; -function ResolveChannel(pFolder: IShellFolder; pidl: PItemIDList; var lpszURL: string): HRESULT; +function IsChannel(ChannelShortcut: string; ShellFolder: IShellFolder; + ID: PItemIdList): Boolean; +function IsFolder(ShellFolder: IShellFolder; ID: PItemIdList): Boolean; +function IsFolderEx(ChannelShortcut: string; ShellFolder: IShellFolder; + ID: PItemIdList): Boolean; + +function NextPIDL(IDList: PItemIdList): PItemIdList; +function ResolveChannel(pFolder: IShellFolder; pidl: PItemIdList; + var lpszURL: string): HRESULT; function ResolveLink(const Path: string): string; function ResolveUrlIni(FileName: string): string; function ResolveUrlIntShCut(FileName: string): string; function StringToVarArray(const S: string): Variant; function URLFromShortcut(const dotURL: string): string; function VarArrayToString(const V: Variant): string; -procedure DisposePIDL(ID: PItemIDList); -procedure StripLastID(IDList: PItemIDList); +procedure DisposePIDL(ID: PItemIdList); +procedure StripLastID(IDList: PItemIdList); function IsWinXPSP2OrLater(): Boolean; function EncodeUrl(const InputStr: string; const bQueryStr: Boolean): string; function DecodeURL(const InputStr: string): string; -function IsValidProtocol(URL: string): Boolean; +function IsValidProtocol(Url: string): Boolean; function ImportCertFile(AFileName, AStoreType: string): Boolean; -//--end of add to ewb--------------------------------- +// --end of add to ewb--------------------------------- implementation uses - Registry, ShellAPI, Controls, Messages, Forms, SysUtils, - OleCtrls, WinInet, SendMail_For_EWB, ComObj, IEConst, IniFiles, JPEG, WinSock, + System.Win.Registry, ShellAPI, Controls, Messages, Forms, SysUtils, + OleCtrls, WinInet, SendMail_For_EWB, System.Win.ComObj, EWB.IEConst, IniFiles, + JPEG, WinSock, Wcrypt2, Browse4Folder, EWBCoreTools; type @@ -333,26 +371,26 @@ implementation dwMinorVersion: DWORD; dwBuildNumber: DWORD; dwPlatformId: DWORD; - szCSDVersion: array[0..127] of Char; + szCSDVersion: array [0 .. 127] of Char; wServicePackMajor: WORD; wServicePackMinor: WORD; wSuiteMask: WORD; wProductType: BYTE; wReserved: BYTE; end; + TOSVersionInfoEx = OSVERSIONINFOEX; POSVersionInfoEx = ^TOSVersionInfoEx; - type fn_VerifyVersionInfo = function(var VersionInformation: OSVERSIONINFOEX; dwTypeMask: DWORD; dwlConditionMask: LONGLONG): BOOL; stdcall; fn_VerSetConditionMask = function(ConditionMask: LONGLONG; TypeMask: DWORD; - Condition: Byte): LONGLONG; stdcall; + Condition: BYTE): LONGLONG; stdcall; function ImportCertFile(AFileName, AStoreType: string): Boolean; var - f: file; //by Ray + f: file; // by Ray encCert: PByte; encCertLen: DWORD; store: HCERTSTORE; @@ -400,11 +438,11 @@ function IsWinXPSP2OrLater(): Boolean; VerSetConditionMask: fn_VerSetConditionMask; begin Result := False; - hLib := LoadLibrary('kernel32.dll'); - if (hLib <> 0) then + hlib := LoadLibrary('kernel32.dll'); + if (hlib <> 0) then begin - @VerifyVersionInfo := GetProcAddress(hLib, 'VerifyVersionInfoA'); - @VerSetConditionMask := GetProcAddress(hLib, 'VerSetConditionMask'); + @VerifyVersionInfo := GetProcAddress(hlib, 'VerifyVersionInfoA'); + @VerSetConditionMask := GetProcAddress(hlib, 'VerSetConditionMask'); if ((@VerifyVersionInfo = nil) or (@VerSetConditionMask = nil)) then Exit; @@ -420,10 +458,14 @@ function IsWinXPSP2OrLater(): Boolean; osvi.wServicePackMinor := 0; // Initialize the condition mask. - dwlConditionMask := VerSetConditionMask(dwlConditionMask, VER_MAJORVERSION, op); - dwlConditionMask := VerSetConditionMask(dwlConditionMask, VER_MINORVERSION, op); - dwlConditionMask := VerSetConditionMask(dwlConditionMask, VER_SERVICEPACKMAJOR, op); - dwlConditionMask := VerSetConditionMask(dwlConditionMask, VER_SERVICEPACKMINOR, op); + dwlConditionMask := VerSetConditionMask(dwlConditionMask, + VER_MAJORVERSION, op); + dwlConditionMask := VerSetConditionMask(dwlConditionMask, + VER_MINORVERSION, op); + dwlConditionMask := VerSetConditionMask(dwlConditionMask, + VER_SERVICEPACKMAJOR, op); + dwlConditionMask := VerSetConditionMask(dwlConditionMask, + VER_SERVICEPACKMINOR, op); // Perform the test. Result := VerifyVersionInfo(osvi, VER_MAJORVERSION or VER_MINORVERSION or @@ -431,7 +473,7 @@ function IsWinXPSP2OrLater(): Boolean; end; end; -function EncodeURL(const InputStr: string; const bQueryStr: Boolean): string; +function EncodeUrl(const InputStr: string; const bQueryStr: Boolean): string; var Idx: Integer; begin @@ -439,7 +481,7 @@ function EncodeURL(const InputStr: string; const bQueryStr: Boolean): string; for Idx := 1 to Length(InputStr) do begin case InputStr[Idx] of - 'A'..'Z', 'a'..'z', '0'..'9', '-', '_', '.': + 'A' .. 'Z', 'a' .. 'z', '0' .. '9', '-', '_', '.': Result := Result + InputStr[Idx]; ' ': if bQueryStr then @@ -486,18 +528,18 @@ function DecodeURL(const InputStr: string): string; end; end; -function IsValidProtocol(URL: string): Boolean; +function IsValidProtocol(Url: string): Boolean; const - Protocols: array[1..11] of string = ('ftp://', 'http://', 'https://', + Protocols: array [1 .. 11] of string = ('ftp://', 'http://', 'https://', 'gopher://', 'mailto:', 'news:', 'nntp://', 'telnet://', 'wais://', 'file://', 'prospero://'); var I: Integer; begin Result := False; - URL := SysUtils.LowerCase(URL); + Url := SysUtils.LowerCase(Url); for I := Low(Protocols) to High(Protocols) do - if Pos(Protocols[I], URL) <> 0 then + if Pos(Protocols[I], Url) <> 0 then begin Result := True; Break; @@ -521,11 +563,13 @@ procedure AssignEmptyDocument(WebBrowser: TEmbeddedWB); WebBrowser.Go('about:blank'); end; -function AddHtmlToAboutBlank(WebBrowser: TEmbeddedWB; StringToHtml: string): Boolean; +function AddHtmlToAboutBlank(WebBrowser: TEmbeddedWB; + StringToHtml: string): Boolean; var Flags, TargetFrameName, PostData, Headers: OleVariant; begin - WebBrowser.Navigate('about:' + StringToHtml, Flags, TargetFrameName, PostData, Headers); + WebBrowser.Navigate('about:' + StringToHtml, Flags, TargetFrameName, + PostData, Headers); Result := True; end; @@ -538,7 +582,7 @@ function GetWordAtCursor(const X, Y: Integer; WebBrowser: TEmbeddedWB): string; Result := ''; if WebBrowser.DocumentLoaded(Doc) then begin - Selection := (Doc as IHTMLDocument2).selection; + Selection := (Doc as IHTMLDocument2).Selection; if Assigned(Selection) then begin Range := Selection.createRange as IHTMLTxtRange; @@ -550,7 +594,8 @@ function GetWordAtCursor(const X, Y: Integer; WebBrowser: TEmbeddedWB): string; end; end; -procedure PrintPreviewFromTemplate(const TemplateFileName: string; Document: IDispatch); +procedure PrintPreviewFromTemplate(const TemplateFileName: string; + Document: IDispatch); var OleCommandTarget: IOleCommandTarget; ParamIn, EmptyParam: OleVariant; @@ -558,12 +603,9 @@ procedure PrintPreviewFromTemplate(const TemplateFileName: string; Document: IDi if Assigned(Document) then begin EmptyParam := EmptyStr; - Document.QueryInterface(IID_IoleCommandTarget, OLECOMMANDTARGET); + Document.QueryInterface(IID_IoleCommandTarget, OleCommandTarget); ParamIn := TemplateFileName; - OleCommandTarget.Exec( - nil, - OLECMDID_PRINTPREVIEW, - OLECMDEXECOPT_PROMPTUSER, + OleCommandTarget.Exec(nil, OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_PROMPTUSER, ParamIn, EmptyParam); end; end; @@ -581,7 +623,7 @@ procedure ScrollToIDEx(ID: string; WebBrowser: TEmbeddedWB); if Assigned(Elem) then begin RV := (Elem as IHTMLElement2).getBoundingClientRect; - Webbrowser.Doc2.parentWindow.scrollBy(RV.left, RV.top); + WebBrowser.Doc2.parentWindow.scrollBy(RV.left, RV.top); end; end; end; @@ -603,10 +645,10 @@ procedure ScrollToID(ID: Integer; WebBrowser: TEmbeddedWB); begin Match := nil; S := IntToStr(ID); - for I := 0 to ACollection.length - 1 do + for I := 0 to ACollection.Length - 1 do begin Elem := ACollection.item(I, '') as IHTMLElement; - if Assigned(Elem) and (Elem.id = S) then + if Assigned(Elem) and (Elem.ID = S) then begin Match := Elem as IHTMLElement2; Break; @@ -628,36 +670,41 @@ function GetWBLV(WBHandle: HWND): HWND; WND: HWND; begin Result := 0; - Wnd := GetNextWindow(WBHandle, GW_CHILD); + WND := GetNextWindow(WBHandle, GW_CHILD); while (Result = 0) and (WND <> 0) do begin - Result := FindWindowEx(Wnd, 0, 'SysListView32', nil); - Wnd := GetNextWindow(Wnd, GW_CHILD) + Result := FindWindowEx(WND, 0, 'SysListView32', nil); + WND := GetNextWindow(WND, GW_CHILD) end; end; // Check if the horizontal / vertical Scrollbars are visible -procedure GetScrollBarVisibility(WebBrowser: TEmbeddedWB; var HScroll, VScroll: Boolean); +procedure GetScrollBarVisibility(WebBrowser: TEmbeddedWB; + var HScroll, VScroll: Boolean); var WndLV: HWND; - IDoc: IHTMLDocument2; + iDoc: IHTMLDocument2; begin VScroll := False; HScroll := False; WndLV := GetWBLV(WebBrowser.Handle); if WndLV = 0 then begin - if Assigned(WebBrowser.Document) and (Succeeded(WebBrowser.Document.QueryInterface(IHTMLDocument2, IDoc))) then + if Assigned(WebBrowser.Document) and + (Succeeded(WebBrowser.Document.QueryInterface(IHTMLDocument2, iDoc))) then begin - IDoc := WebBrowser.Document as IHTMLDocument2; - if Assigned(IDoc) and Assigned((IHTMLDocument2(IDoc).Body)) then + iDoc := WebBrowser.Document as IHTMLDocument2; + if Assigned(iDoc) and Assigned((IHTMLDocument2(iDoc).Body)) then begin - VScroll := WebBrowser.OleObject.Document.body.ScrollHeight > WebBrowser.OleObject.Document.Body.ClientHeight; - HScroll := (WebBrowser.OleObject.Document.body.ScrollWidth > WebBrowser.OleObject.Document.Body.ClientWidth); + VScroll := WebBrowser.OleObject.Document.Body.ScrollHeight > + WebBrowser.OleObject.Document.Body.ClientHeight; + HScroll := (WebBrowser.OleObject.Document.Body.ScrollWidth > + WebBrowser.OleObject.Document.Body.ClientWidth); end; end; - end else + end + else begin // if the WB is in "ListView" mode: VScroll := ((GetWindowLong(WndLV, GWL_STYLE) and WS_VSCROLL) <> 0); @@ -667,10 +714,12 @@ procedure GetScrollBarVisibility(WebBrowser: TEmbeddedWB; var HScroll, VScroll: // Get TEmbeddedWB Scrollbar X,Y Position -function GetScrollBarPosition(WebBrowser: TEmbeddedWB; var ScrollPos: TPoint): Boolean; +function GetScrollBarPosition(WebBrowser: TEmbeddedWB; + var ScrollPos: TPoint): Boolean; - // Get Scrollbar X,Y Position of the ListView - function WB_GetLVScrollPosition(WebBrowser: TEmbeddedWB; var ScrollPos: TPoint): Boolean; +// Get Scrollbar X,Y Position of the ListView + function WB_GetLVScrollPosition(WebBrowser: TEmbeddedWB; + var ScrollPos: TPoint): Boolean; var lpsi: TScrollInfo; WndLV: HWND; @@ -680,7 +729,7 @@ function GetScrollBarPosition(WebBrowser: TEmbeddedWB; var ScrollPos: TPoint): B WndLV := GetWBLV(WebBrowser.Handle); if WndLV <> 0 then // SysListView32 found begin - // initialize TScrollInfo + // initialize TScrollInfo FillChar(lpsi, SizeOf(lpsi), 0); with lpsi do begin @@ -701,31 +750,35 @@ function GetScrollBarPosition(WebBrowser: TEmbeddedWB; var ScrollPos: TPoint): B end; end; - // Get Scrollbar X,Y Position of the HTML Document - function WB_GetDOCScrollPosition(WebBrowser: TEmbeddedWB; var ScrollPos: TPoint): Boolean; +// Get Scrollbar X,Y Position of the HTML Document + function WB_GetDOCScrollPosition(WebBrowser: TEmbeddedWB; + var ScrollPos: TPoint): Boolean; var - IDoc: IHTMLDocument2; + iDoc: IHTMLDocument2; IDoc3: IHTMLDocument3; IElement: IHTMLElement; begin ScrollPos := Point(-1, -1); Result := False; - if Assigned(WebBrowser.Document) and (Succeeded(WebBrowser.Document.QueryInterface(IHTMLDocument2, IDoc))) then + if Assigned(WebBrowser.Document) and + (Succeeded(WebBrowser.Document.QueryInterface(IHTMLDocument2, iDoc))) then begin - IDoc := WebBrowser.Document as IHTMLDocument2; - if Assigned(IDoc) and Assigned((IHTMLDocument2(IDoc).Body)) then + iDoc := WebBrowser.Document as IHTMLDocument2; + if Assigned(iDoc) and Assigned((IHTMLDocument2(iDoc).Body)) then begin - if (IDoc.QueryInterface(IHTMLDocument3, IDoc3) = S_OK) then + if (iDoc.QueryInterface(IHTMLDocument3, IDoc3) = S_OK) then if Assigned(IDoc3) then IElement := IDoc3.get_documentElement; - if (Assigned(IElement)) and (Variant(IDoc).DocumentElement.scrollTop = 0) then - ScrollPos.Y := IHTMLDocument2(IDoc).Body.getAttribute('ScrollTop', 0) + if (Assigned(IElement)) and (Variant(iDoc).DocumentElement.scrollTop = 0) + then + ScrollPos.Y := IHTMLDocument2(iDoc).Body.getAttribute('ScrollTop', 0) else - ScrollPos.Y := Variant(IDoc).DocumentElement.scrollTop; - if Assigned(IElement) and (Variant(IDoc).DocumentElement.scrollLeft = 0) then - ScrollPos.X := IHTMLDocument2(IDoc).Body.getAttribute('ScrollLeft', 0) + ScrollPos.Y := Variant(iDoc).DocumentElement.scrollTop; + if Assigned(IElement) and (Variant(iDoc).DocumentElement.scrollLeft = 0) + then + ScrollPos.X := IHTMLDocument2(iDoc).Body.getAttribute('ScrollLeft', 0) else - ScrollPos.X := Variant(IDoc).DocumentElement.scrollLeft + ScrollPos.X := Variant(iDoc).DocumentElement.scrollLeft end; Result := (ScrollPos.X <> -1) and (ScrollPos.Y <> -1) end; @@ -744,7 +797,7 @@ function DocumentSource(OleObject: Variant): string; Strings := TStringList.Create; try ViewPageSourceHTMLToStrings(OleObject, OleObject.Document, Strings); - Result := Strings.Text; + Result := Strings.text; finally FreeAndNil(Strings); end; @@ -757,7 +810,7 @@ function DocumentSourceText(OleObject: Variant; Document: IDispatch): string; Strings := TStringList.Create; try EwbTools.ViewPageSourceTextToStrings(OleObject, Document, Strings); - Result := Strings.Text; + Result := Strings.text; finally FreeAndNil(Strings); end; @@ -774,104 +827,114 @@ function GetFrame(Document: IDispatch; FrameNo: Integer): IWebBrowser2; begin Fetched := nil; OleContainer := Document as IOleContainer; - if OleContainer.EnumObjects(OLECONTF_EMBEDDINGS, Enum) = S_OK then + if OleContainer.EnumObjects(OLECONTF_EMBEDDINGS, enum) = S_OK then begin - Enum.Skip(FrameNo); - Enum.Next(1, Unk, Fetched); - Result := Unk as IWebBrowser2; - end else + enum.Skip(FrameNo); + enum.Next(1, unk, Fetched); + Result := unk as IWebBrowser2; + end + else Result := nil; end else Result := nil; end; -function FrameCount(Document: IDispatch): LongInt; -var //fix by Aladin +function FrameCount(Document: IDispatch): Longint; +var // fix by Aladin OleContainer: IOleContainer; enum: ActiveX.IEnumUnknown; - FetchedContrs: LongInt; + FetchedContrs: Longint; Unknown: IUnknown; IWeb: IWebBrowser2; begin - Result := 0; //bsalsa - if not DocumentLoaded(Document) then Exit; + Result := 0; // bsalsa + if not DocumentLoaded(Document) then + Exit; OleContainer := Document as IOleContainer; - if OleContainer.EnumObjects(OLECONTF_EMBEDDINGS, Enum) = S_OK then + if OleContainer.EnumObjects(OLECONTF_EMBEDDINGS, enum) = S_OK then begin - while Enum.Next(1, Unknown, @FetchedContrs) = S_OK do + while enum.Next(1, Unknown, @FetchedContrs) = S_OK do begin - if Unknown.QueryInterface(IID_IWebBrowser2, IWeb) = S_OK then //check if it is frame + if Unknown.QueryInterface(IID_IWebBrowser2, IWeb) = S_OK then + // check if it is frame Inc(Result); end; end; end; function FrameCountFromDocument(SourceDoc: IHTMLDocument2): Integer; -var //by Aladin +var // by Aladin OleContainer: IOleContainer; enum: ActiveX.IEnumUnknown; - unk: array[0..99] of IUnknown; // CHANGED from "unk: IUnknown;" + unk: array [0 .. 99] of IUnknown; // CHANGED from "unk: IUnknown;" EnumResult: HRESULT; begin Result := 0; - if not DocumentLoaded(SourceDoc) then Exit; + if not DocumentLoaded(SourceDoc) then + Exit; OleContainer := SourceDoc as IOleContainer; - EnumResult := OleContainer.EnumObjects(OLECONTF_EMBEDDINGS, Enum); + EnumResult := OleContainer.EnumObjects(OLECONTF_EMBEDDINGS, enum); if EnumResult = S_OK then - // Added per OLE help - Enum.Next(100, Unk, @Result) + // Added per OLE help + enum.Next(100, unk, @Result) else // Added per OLE help - Enum := nil; + enum := nil; end; procedure SetFocusToDoc(WebBrowser: TEmbeddedWB; Dispatch, Document: IDispatch); begin if DocumentLoaded(Document) then with (Dispatch as IOleObject) do - DoVerb(OLEIVERB_UIACTIVATE, nil, WebBrowser, 0, WebBrowser.Handle, WebBrowser.ClientRect); + DoVerb(OLEIVERB_UIACTIVATE, nil, WebBrowser, 0, WebBrowser.Handle, + WebBrowser.ClientRect); end; function CMD_Copy(Document: IDispatch): Boolean; var vaIn, vaOut: OleVariant; begin - Result := InvokeCmd(Document, False, OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut) = S_OK; + Result := InvokeCMD(Document, False, OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT, + vaIn, vaOut) = S_OK; end; -function CMD_Paste(Document: IDispatch): Boolean; +function Cmd_Paste(Document: IDispatch): Boolean; var vaIn, vaOut: OleVariant; begin - Result := InvokeCmd(Document, False, OLECMDID_PASTE, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut) = S_OK; + Result := InvokeCMD(Document, False, OLECMDID_PASTE, OLECMDEXECOPT_DODEFAULT, + vaIn, vaOut) = S_OK; end; -function CMD_Cut(Document: IDispatch): Boolean; +function Cmd_Cut(Document: IDispatch): Boolean; var vaIn, vaOut: OleVariant; begin - Result := InvokeCmd(Document, False, OLECMDID_CUT, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut) = S_OK; + Result := InvokeCMD(Document, False, OLECMDID_CUT, OLECMDEXECOPT_DODEFAULT, + vaIn, vaOut) = S_OK; end; function SelectAll(Document: IDispatch): Boolean; var vaIn, vaOut: OleVariant; begin - Result := InvokeCmd(Document, False, OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut) = S_OK; + Result := InvokeCMD(Document, False, OLECMDID_SELECTALL, + OLECMDEXECOPT_DODEFAULT, vaIn, vaOut) = S_OK; end; function UnSelectAll(Document: IDispatch): Boolean; var vaIn, vaOut: OleVariant; begin - Result := InvokeCmd(Document, False, OLECMDID_CLEARSELECTION, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut) = S_OK; + Result := InvokeCMD(Document, False, OLECMDID_CLEARSELECTION, + OLECMDEXECOPT_DODEFAULT, vaIn, vaOut) = S_OK; end; procedure ScrollToTop(OleObject: Variant); begin try if DocumentLoaded(OleObject.Document) then - OleObject.Document.ParentWindow.ScrollTo(0, 0); + OleObject.Document.parentWindow.ScrollTo(0, 0); except end; end; @@ -880,7 +943,7 @@ procedure ScrollToPosition(OleObject: Variant; X, Y: Integer); begin try if DocumentLoaded(OleObject.Document) then - OleObject.Document.ParentWindow.ScrollTo(X, Y); + OleObject.Document.parentWindow.ScrollTo(X, Y); except end; end; @@ -895,7 +958,7 @@ procedure ScrollToBottom(Document: IDispatch); begin // OleObject.Document.ParentWindow.ScrollTo(0, MaxInt); doesn't work in IE8 HTMLParentWin := IHTMLWindow2((Doc2 as IHTMLDocument2).parentWindow); - HTMLParentWin.scrollBy(0, (Doc2.body as IHTMLElement2).scrollHeight); + HTMLParentWin.scrollBy(0, (Doc2.Body as IHTMLElement2).ScrollHeight); end; except end; @@ -907,12 +970,12 @@ function Zoom(Document: IDispatch; ZoomValue: Integer): Boolean; begin if ZoomValue < ZoomRangeLow(Document) then vaIn := ZoomRangeLow(Document) + else if ZoomValue > ZoomRangeHigh(Document) then + vaIn := ZoomRangeHigh(Document) else - if ZoomValue > ZoomRangeHigh(Document) then - vaIn := ZoomRangeHigh(Document) - else - vaIn := ZoomValue; - Result := InvokeCmd(Document, False, OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut) = S_OK; + vaIn := ZoomValue; + Result := InvokeCMD(Document, False, OLECMDID_ZOOM, + OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut) = S_OK; end; function ZoomValue(Document: IDispatch): Integer; @@ -920,7 +983,8 @@ function ZoomValue(Document: IDispatch): Integer; vaIn, vaOut: OleVariant; begin vaIn := null; - InvokeCmd(Document, False, OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut); + InvokeCMD(Document, False, OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, + vaIn, vaOut); Result := vaOut; end; @@ -928,7 +992,8 @@ function ZoomRangeHigh(Document: IDispatch): Integer; var vaIn, vaOut: OleVariant; begin - InvokeCmd(Document, False, OLECMDID_GETZOOMRANGE, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut); + InvokeCMD(Document, False, OLECMDID_GETZOOMRANGE, + OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut); Result := HiWord(DWORD(vaOut)); end; @@ -936,11 +1001,13 @@ function ZoomRangeLow(Document: IDispatch): Integer; var vaIn, vaOut: OleVariant; begin - InvokeCmd(Document, False, OLECMDID_GETZOOMRANGE, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut); + InvokeCMD(Document, False, OLECMDID_GETZOOMRANGE, + OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut); Result := LoWord(DWORD(vaOut)); end; -function SetCharartersSet(WebBrowser: TEmbeddedWB; Document: IDispatch; const ACharactersSet: string; Refresh: Boolean = True): Boolean; +function SetCharartersSet(WebBrowser: TEmbeddedWB; Document: IDispatch; + const ACharactersSet: string; Refresh: Boolean = True): Boolean; var RefreshLevel: OleVariant; begin @@ -962,15 +1029,15 @@ function SetCharartersSet(WebBrowser: TEmbeddedWB; Document: IDispatch; const AC end; { -function GetCookie(OleObject: Variant): string; -begin + function GetCookie(OleObject: Variant): string; + begin Result := ''; if DocumentLoaded(OleObject.Document) then try - Result := OleObject.Document.Cookie; + Result := OleObject.Document.Cookie; except end; -end; } + end; } procedure ClearSessionCookies; begin @@ -991,7 +1058,8 @@ procedure GetThumbnail(Dispatch: IDispatch; var Image: TImage); Image.Refresh; end; -function GetBmpFromBrowser(Document: IDispatch; Handle: THandle; Width, Height: Integer; FileName: string): Boolean; +function GetBmpFromBrowser(Document: IDispatch; Handle: THandle; + Width, Height: Integer; FileName: string): Boolean; var ViewObject: IViewObject; sourceDrawRect: TRect; @@ -999,28 +1067,29 @@ function GetBmpFromBrowser(Document: IDispatch; Handle: THandle; Width, Height: begin Result := False; if DocumentLoaded(Document) then - try - Document.QueryInterface(IViewObject, ViewObject); - if Assigned(ViewObject) then try - ScreenImg := TBitmap.Create; - ScreenImg.Height := Height; - ScreenImg.Width := Width; - sourceDrawRect := Rect(0, 0, ScreenImg.Width, ScreenImg.Height); - ViewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Handle, - ScreenImg.Canvas.Handle, @sourceDrawRect, nil, nil, 0); - ScreenImg.SaveToFile(FileName); - Result := True; - finally - ViewObject._Release; + Document.QueryInterface(IViewObject, ViewObject); + if Assigned(ViewObject) then + try + ScreenImg := TBitmap.Create; + ScreenImg.Height := Height; + ScreenImg.Width := Width; + sourceDrawRect := Rect(0, 0, ScreenImg.Width, ScreenImg.Height); + ViewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Handle, + ScreenImg.Canvas.Handle, @sourceDrawRect, nil, nil, 0); + ScreenImg.SaveToFile(FileName); + Result := True; + finally +{$IFNDEF DELPHIX_SEATTLE_UP }ViewObject._Release; {$ENDIF} + end; + except + Result := False; end; - except - Result := False; - end; end; -function GetJPEGfromBrowser(Document: IDispatch; ControlInterface: IWebBrowser2; FileName: string; SourceHeight, SourceWidth, - TargetHeight, TargetWidth: Integer): Boolean; +function GetJPEGfromBrowser(Document: IDispatch; ControlInterface: IWebBrowser2; + FileName: string; SourceHeight, SourceWidth, TargetHeight, + TargetWidth: Integer): Boolean; var sourceDrawRect: TRect; targetDrawRect: TRect; @@ -1044,9 +1113,8 @@ function GetJPEGfromBrowser(Document: IDispatch; ControlInterface: IWebBrowser2; if aViewObject = nil then Exit; OleCheck(aViewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, - Forms.Application.Handle, - sourceBitmap.Canvas.Handle, - @sourceDrawRect, nil, nil, 0)); + Forms.Application.Handle, sourceBitmap.Canvas.Handle, @sourceDrawRect, + nil, nil, 0)); targetDrawRect := Rect(0, 0, TargetWidth, TargetHeight); targetBitmap.Height := TargetHeight; targetBitmap.Width := TargetWidth; @@ -1065,43 +1133,45 @@ function GetJPEGfromBrowser(Document: IDispatch; ControlInterface: IWebBrowser2; end; procedure ViewPageLinksToStrings(OleObject: Variant; LinksList: TStrings); -var //by smot +var // by smot UNum: Variant; - s: string; + S: string; procedure RecurseLinks(htmlDoc: Variant); var - BodyElement, ElementCo, HTMLFrames, HTMLWnd, doc: OleVariant; - j, i: Integer; + BodyElement, ElementCo, HTMLFrames, HTMLWnd, Doc: OleVariant; + j, I: Integer; begin - if VarIsEmpty(htmlDoc) then Exit; - BodyElement := htmlDoc.body; + if VarIsEmpty(htmlDoc) then + Exit; + BodyElement := htmlDoc.Body; if BodyElement.tagName = 'BODY' then begin ElementCo := htmlDoc.links; j := ElementCo.Length - 1; - for i := 0 to j do + for I := 0 to j do begin - UNum := ElementCo.item(i); - s := UNum.href; + UNum := ElementCo.item(I); + S := UNum.href; if j = 0 then - s := 'No Links found in the page body'; - LinksList.Add(s); + S := 'No Links found in the page body'; + LinksList.Add(S); end; end; HTMLFrames := htmlDoc.Frames; j := HTMLFrames.Length - 1; - for i := 0 to j do + for I := 0 to j do begin - HTMLWnd := HTMLFrames.Item(i); + HTMLWnd := HTMLFrames.item(I); try - doc := HTMLWnd.Document; - RecurseLinks(doc); + Doc := HTMLWnd.Document; + RecurseLinks(Doc); except Continue; end; end; end; + begin LinksList.Clear; if not DocumentLoaded(OleObject.Document) then @@ -1109,25 +1179,27 @@ procedure ViewPageLinksToStrings(OleObject: Variant; LinksList: TStrings); RecurseLinks(OleObject.Document); end; -procedure ViewPageSourceHTMLToStrings(OleObject: Variant; Document: IDispatch; HtmlList: TStrings); +procedure ViewPageSourceHTMLToStrings(OleObject: Variant; Document: IDispatch; + HtmlList: TStrings); begin HtmlList.Clear; if DocumentLoaded(Document) then begin try - HtmlList.Add(VarToStr(OleObject.Document.documentElement.innerHTML)); + HtmlList.Add(VarToStr(OleObject.Document.DocumentElement.innerHTML)); except end; end; end; -procedure ViewPageSourceTextToStrings(OleObject: Variant; Document: IDispatch; TextList: TStrings); +procedure ViewPageSourceTextToStrings(OleObject: Variant; Document: IDispatch; + TextList: TStrings); begin TextList.Clear; if DocumentLoaded(Document) then begin try - TextList.Add(VarToStr(OleObject.Document.documentElement.innerText)); + TextList.Add(VarToStr(OleObject.Document.DocumentElement.innerText)); except end; end; @@ -1141,15 +1213,15 @@ procedure ViewPageSourceText(OleObject: Variant; Document: IDispatch); try if DocumentLoaded(Document) then begin - TextLst.Add(VarToStr(OleObject.Document.documentElement.innerText)); - MessageDlg(TextLst.Text, mtCustom, [mbOK], 0); + TextLst.Add(VarToStr(OleObject.Document.DocumentElement.innerText)); + MessageDlg(TextLst.text, mtCustom, [mbOK], 0); end; finally TextLst.Free; end; end; -function SaveDocToStrings(Document: IDispatch; var AStrings: TStrings): HResult; +function SaveDocToStrings(Document: IDispatch; var AStrings: TStrings): HRESULT; var IpStream: IPersistStreamInit; AStream: TMemoryStream; @@ -1162,33 +1234,31 @@ function SaveDocToStrings(Document: IDispatch; var AStrings: TStrings): HResult; IpStream := Document as IPersistStreamInit; if not Assigned(IpStream) then Result := S_FALSE - else - if Succeeded(IpStream.save(TStreamadapter.Create(AStream), True)) - then - begin - AStream.Seek(0, 0); - AStrings.LoadFromStream(AStream); - Result := S_OK; - end; + else if Succeeded(IpStream.save(TStreamadapter.Create(AStream), True)) then + begin + AStream.Seek(0, 0); + AStrings.LoadFromStream(AStream); + Result := S_OK; + end; except end; AStream.Free; end; -function SaveDocToStream(Document: IDispatch; var AStream: TStream): HResult; +function SaveDocToStream(Document: IDispatch; var AStream: TStream): HRESULT; var IpStream: IPersistStreamInit; begin if DocumentLoaded(Document) then begin IpStream := Document as IPersistStreamInit; - Result := IpStream.Save(TStreamAdapter.Create(AStream), True); + Result := IpStream.save(TStreamadapter.Create(AStream), True); end else Result := S_FALSE; end; -function SaveDocToFile(Document: IDispatch; const Fname: string): HResult; +function SaveDocToFile(Document: IDispatch; const Fname: string): HRESULT; var PFile: IPersistFile; begin @@ -1196,22 +1266,23 @@ function SaveDocToFile(Document: IDispatch; const Fname: string): HResult; if DocumentLoaded(Document) then begin PFile := Document as IPersistFile; - Result := PFile.Save(StringToOleStr(FName), False); + Result := PFile.save(StringToOleStr(Fname), False); end; end; -procedure PrintWithHeaderFooter(ControlInterface: IWebBrowser2; Header, Footer: PWideChar; Options: OLECMDEXECOPT); +procedure PrintWithHeaderFooter(ControlInterface: IWebBrowser2; + Header, Footer: PWideChar; Options: OLECMDEXECOPT); var saBound: TSafeArrayBound; psaHeadFoot: PSafeArray; vaIn, vaOut: TVariantArg; vHeadStr, vFootStr: TVariantArg; - rgIndex: LongInt; + rgIndex: Longint; begin try saBound.lLbound := 0; saBound.cElements := 2; - psaHeadFoot := SafeArrayCreate(VT_VARIANT, 1, saBound); + psaHeadFoot := SafeArrayCreate(VT_VARIANT, 1, @saBound); vHeadStr.vt := VT_BSTR; vHeadStr.bstrVal := SysAllocString(Header); vFootStr.vt := VT_BSTR; @@ -1222,8 +1293,8 @@ procedure PrintWithHeaderFooter(ControlInterface: IWebBrowser2; Header, Footer: OleCheck(SafeArrayPutElement(psaHeadFoot, rgIndex, vFootStr)); vaIn.vt := VT_ARRAY or VT_BYREF; vaIn.parray := psaHeadFoot; - ControlInterFace.ExecWB(OLECMDID_PRINT, Options, - OleVariant(vaIn), OleVariant(vaOut)); + ControlInterface.ExecWB(OLECMDID_PRINT, Options, OleVariant(vaIn), + OleVariant(vaOut)); if vHeadStr.bstrVal <> nil then SysFreeString(vHeadStr.bstrVal); if vFootStr.bstrVal <> nil then @@ -1232,7 +1303,9 @@ procedure PrintWithHeaderFooter(ControlInterface: IWebBrowser2; Header, Footer: end; end; -procedure Print(ControlInterface: IWebBrowser2; bHideSetup: Boolean = False; bCustomHeaderFooter: Boolean = False; Header: string = ''; Footer: string = ''); +procedure Print(ControlInterface: IWebBrowser2; bHideSetup: Boolean = False; + bCustomHeaderFooter: Boolean = False; Header: string = ''; + Footer: string = ''); var vaIn, vaOut: OleVariant; begin @@ -1241,81 +1314,92 @@ procedure Print(ControlInterface: IWebBrowser2; bHideSetup: Boolean = False; bCu if bCustomHeaderFooter then begin if bHideSetup then - PrintWithHeaderFooter(ControlInterface, TaskAllocWideString(Header), TaskAllocWideString(Footer), OLECMDEXECOPT_DONTPROMPTUSER) + PrintWithHeaderFooter(ControlInterface, TaskAllocWideString(Header), + TaskAllocWideString(Footer), OLECMDEXECOPT_DONTPROMPTUSER) else - PrintWithHeaderFooter(ControlInterface, TaskAllocWideString(Header), TaskAllocWideString(Footer), OLECMDEXECOPT_PROMPTUSER); + PrintWithHeaderFooter(ControlInterface, TaskAllocWideString(Header), + TaskAllocWideString(Footer), OLECMDEXECOPT_PROMPTUSER); end + else if bHideSetup then + ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER, + vaIn, vaOut) else - if bHideSetup then - ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut) - else - ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER, vaIn, vaOut) + ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER, + vaIn, vaOut) end; end; -procedure PrintWithOptions(ControlInterface: IWebBrowser2; Document: IDispatch; UsePrintOptions, PrintOptionsEnabled, HideSetup: Boolean; var InvokingPageSetup: Boolean); +procedure PrintWithOptions(ControlInterface: IWebBrowser2; Document: IDispatch; + UsePrintOptions, PrintOptionsEnabled, HideSetup: Boolean; + var InvokingPageSetup: Boolean); begin PrintingWithOptions := True; - PageSetup(Document, UsePrintOptions, PrintOptionsEnabled, InvokingPagesetup); + PageSetup(Document, UsePrintOptions, PrintOptionsEnabled, InvokingPageSetup); Print(ControlInterface, HideSetup); end; -procedure PrintPreview(Webbrowser: IWebBrowser2); +procedure PrintPreview(WebBrowser: IWebBrowser2); // IE 5.5 only var - vaIn, vaOut: Olevariant; + vaIn, vaOut: OleVariant; begin - if DocumentLoaded(Webbrowser.Document) then - Webbrowser.ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut); + if DocumentLoaded(WebBrowser.Document) then + WebBrowser.ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DONTPROMPTUSER, + vaIn, vaOut); end; function OpenClient(Client: string): Boolean; var - s, params, Exec: string; + S, params, Exec: string; begin Result := False; with TRegistry.Create do - try - RootKey := HKEY_LOCAL_MACHINE; - OpenKey('Software\Clients\' + Client, False); - S := ReadString(''); - CloseKey; - OpenKey('Software\Clients\' + Client + '\' + S + '\shell\open\command', False); - S := ReadString(''); - CloseKey; - if S <> '' then - begin - if Pos('/', S) > 0 then - begin - Exec := system.Copy(S, 1, Pos('/', S) - 2); - Params := system.Copy(s, Length(exec) + 1, length(S)); - end - else + try + RootKey := HKEY_LOCAL_MACHINE; + OpenKey('Software\Clients\' + Client, False); + S := ReadString(''); + CloseKey; + OpenKey('Software\Clients\' + Client + '\' + S + + '\shell\open\command', False); + S := ReadString(''); + CloseKey; + if S <> '' then begin - Exec := S; - Params := ''; + if Pos('/', S) > 0 then + begin + Exec := System.Copy(S, 1, Pos('/', S) - 2); + params := System.Copy(S, Length(Exec) + 1, Length(S)); + end + else + begin + Exec := S; + params := ''; + end; + Result := True; + ShellExecute(Application.Handle, 'open', PChar(Exec), PChar(params), + '', SW_SHOW); end; - Result := True; - ShellExecute(Application.handle, 'open', PChar(Exec), PChar(Params), '', SW_SHOW); + finally + Free; end; - finally - Free; - end; end; -procedure PrintPreviewExtended(ControlInterface: IWebBrowser2; nCMDShow: Integer; HideSetup: Boolean); +procedure PrintPreviewExtended(ControlInterface: IWebBrowser2; + nCMDShow: Integer; HideSetup: Boolean); var Preview_HWND, App_HWND: THandle; - ClassName: array[0..255] of Char; - StartTime, EndTime: DWORD; //Smot + ClassName: array [0 .. 255] of Char; + StartTime, EndTime: DWORD; // Smot vaIn, vaOut: OleVariant; begin if DocumentLoaded(ControlInterface.Document) then begin if HideSetup then - ControlInterface.ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut) //jerzy + ControlInterface.ExecWB(OLECMDID_PRINTPREVIEW, + OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut) // jerzy else - ControlInterface.ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_PROMPTUSER, vaIn, vaOut); + ControlInterface.ExecWB(OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_PROMPTUSER, + vaIn, vaOut); Preview_HWND := 0; StartTime := GetTickCount; repeat @@ -1327,11 +1411,13 @@ procedure PrintPreviewExtended(ControlInterface: IWebBrowser2; nCMDShow: Integer EndTime := GetTickCount; until (Preview_HWND <> 0) or (EndTime - StartTime > 7000); if Preview_HWND <> 0 then - ShowWindow(Preview_HWND, nCmdShow); + ShowWindow(Preview_HWND, nCMDShow); end; end; -function PageSetup(Document: IDispatch; UsePrintOptions, PrintOptionsEnabled: Boolean; var InvokingPageSetup: Boolean): Boolean; +function PageSetup(Document: IDispatch; + UsePrintOptions, PrintOptionsEnabled: Boolean; + var InvokingPageSetup: Boolean): Boolean; var vaIn, vaOut: OleVariant; begin @@ -1340,7 +1426,8 @@ function PageSetup(Document: IDispatch; UsePrintOptions, PrintOptionsEnabled: Bo begin if PrintOptionsEnabled and UsePrintOptions then InvokingPageSetup := True; - Result := InvokeCmd(Document, False, OLECMDID_PAGESETUP, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut) = S_OK + Result := InvokeCMD(Document, False, OLECMDID_PAGESETUP, + OLECMDEXECOPT_DODEFAULT, vaIn, vaOut) = S_OK end; end; @@ -1351,21 +1438,22 @@ procedure PrintSetup(ControlInterface: IWebBrowser2; HideSetup: Boolean); if DocumentLoaded(ControlInterface.Document) then begin if HideSetup then - ControlInterface.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut) + ControlInterface.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_DONTPROMPTUSER, + vaIn, vaOut) else - ControlInterface.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_PROMPTUSER, vaIn, vaOut) + ControlInterface.ExecWB(OLECMDID_PAGESETUP, OLECMDEXECOPT_PROMPTUSER, + vaIn, vaOut) end; end; -procedure GetPrintValues(WebBrowser: TEmbeddedWB; PrintOptions: TPrintOptions; Measure: TMeasure); +procedure GetPrintValues(WebBrowser: TEmbeddedWB; PrintOptions: TPrintOptions; + Measure: TMeasure); var S: string; Reg: TRegistry; - {$IFDEF DELPHI7_UP} - FS: TFormatSettings; - {$ENDIF} - - +{$IFDEF DELPHI7_UP} + FS: TFormatSettings; +{$ENDIF} function ReadMargin(key: string): Real; begin S := Reg.ReadString(key); @@ -1374,7 +1462,8 @@ procedure GetPrintValues(WebBrowser: TEmbeddedWB; PrintOptions: TPrintOptions; M S := StringReplace(S, ' ', '', [rfReplaceAll]); if {$IFDEF DELPHI7_UP}FS.{$ENDIF}DecimalSeparator <> '.' then - S := StringReplace(S, '.',{$IFDEF DELPHI7_UP}FS.{$ENDIF}DecimalSeparator ,[]); + S := StringReplace(S, '.', +{$IFDEF DELPHI7_UP}FS.{$ENDIF}DecimalSeparator, []); if Measure = mMetric then Result := StrToFloat(S) * InchToMetric @@ -1394,9 +1483,9 @@ procedure GetPrintValues(WebBrowser: TEmbeddedWB; PrintOptions: TPrintOptions; M begin Header := ReadString('header'); Footer := ReadString('footer'); - Margins.Left := ReadMargin('margin_left'); + Margins.left := ReadMargin('margin_left'); Margins.Right := ReadMargin('margin_right'); - Margins.Top := ReadMargin('margin_top'); + Margins.top := ReadMargin('margin_top'); Margins.Bottom := ReadMargin('margin_bottom'); end; end; @@ -1441,7 +1530,8 @@ procedure RestorePrintValues; Reg.Free; end; except - MessageDlg('Error while writing page print values to the registry!', mtError, [mbOK], 0); + MessageDlg('Error while writing page print values to the registry!', + mtError, [mbOK], 0); end; end; @@ -1454,11 +1544,11 @@ function OpenDialog(WebBrowser: TEmbeddedWB; AOwner: TComponent): Boolean; with OD do begin Filter := 'Internet Files|*.htm; *.html; *.url; *.mht; *.mhtml; *.php *.asp' - + #10 + #13 + '|Image Files| *.gif;*.bmp;*.ico;*.jpg;*.png;*.wmf; *.emf; ' - + #10 + #13 + '|Text & Documents Files| *.txt;*.doc;*.xls;*.dot;' - + #10 + #13 + '|Compressed Files| *.zip;' - + #10 + #13 + '|XML Files| *.xml;' - + #10 + #13 + '|Any Files|*.*'; + + #10 + #13 + + '|Image Files| *.gif;*.bmp;*.ico;*.jpg;*.png;*.wmf; *.emf; ' + #10 + #13 + + '|Text & Documents Files| *.txt;*.doc;*.xls;*.dot;' + #10 + #13 + + '|Compressed Files| *.zip;' + #10 + #13 + '|XML Files| *.xml;' + #10 + + #13 + '|Any Files|*.*'; Options := Options + [ofShowHelp, ofEnableSizing]; Title := 'Browser - Open Dialog'; HelpContext := 0; @@ -1471,7 +1561,8 @@ function OpenDialog(WebBrowser: TEmbeddedWB; AOwner: TComponent): Boolean; end; end; -function SaveDialog(WebBrowser: TEmbeddedWB; AOwner: TComponent; ATitle: string = ''; AFilter: string = ''): string; +function SaveDialog(WebBrowser: TEmbeddedWB; AOwner: TComponent; + ATitle: string = ''; AFilter: string = ''): string; var SD: TSaveDialog; begin @@ -1480,10 +1571,9 @@ function SaveDialog(WebBrowser: TEmbeddedWB; AOwner: TComponent; ATitle: string with SD do begin if AFilter = '' then - Filter := 'Internet Files|*.htm; *.html;*.mht; *.mhtml; *.php *.asp' - + #10 + #13 + '|Text & Documents Files| *.txt;*.doc;*.xls;*.dot;' - + #10 + #13 + '|XML Files| *.xml;' - + #10 + #13 + '|Any Files|*.*' + Filter := 'Internet Files|*.htm; *.html;*.mht; *.mhtml; *.php *.asp' + + #10 + #13 + '|Text & Documents Files| *.txt;*.doc;*.xls;*.dot;' + #10 + + #13 + '|XML Files| *.xml;' + #10 + #13 + '|Any Files|*.*' else Filter := AFilter; Options := Options + [ofShowHelp, ofEnableSizing]; @@ -1504,26 +1594,29 @@ function SaveDialog(Document: IDispatch): Boolean; var vaIn, vaOut: OleVariant; begin - Result := InvokeCmd(Document, False, OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut) = S_OK; + Result := InvokeCMD(Document, False, OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT, + vaIn, vaOut) = S_OK; end; function ShowInternetOptions(Document: IDispatch): Boolean; var vaIn, vaOut: OleVariant; begin - Result := InvokeCmd(Document, True, HTMLID_OPTIONS, 0, vaIn, vaOut) = S_OK; + Result := InvokeCMD(Document, True, HTMLID_OPTIONS, 0, vaIn, vaOut) = S_OK; end; function ShowPageProperties(Document: IDispatch): Boolean; var vaIn, vaOut: OleVariant; begin // OLECMDID_SHOWPAGEACTIONMENU - Result := InvokeCmd(Document, False, OLECMDID_PROPERTIES, OLECMDEXECOPT_DODEFAULT, vaIn, vaOut) = S_OK; + Result := InvokeCMD(Document, False, OLECMDID_PROPERTIES, + OLECMDEXECOPT_DODEFAULT, vaIn, vaOut) = S_OK; end; function ShowOrganizeFavorites(Handle: THandle): Boolean; begin - Result := OrganizeFavorite(Handle, GetSpecialFolderPath(Handle, CSIDL_FAVORITES)); + Result := OrganizeFavorite(Handle, GetSpecialFolderPath(Handle, + CSIDL_FAVORITES)); end; procedure ShowImportExportFavoritesAndCookies(Handle: THandle); @@ -1535,29 +1628,29 @@ function ShowFindDialog(Document: IDispatch): Boolean; var vaIn, vaOut: OleVariant; begin - Result := InvokeCmd(Document, True, HTMLID_FIND, 0, vaIn, vaOut) = S_OK; + Result := InvokeCMD(Document, True, HTMLID_FIND, 0, vaIn, vaOut) = S_OK; end; procedure SaveImagesDialog(OleObject: Variant; Document: IDispatch); var k, p: Integer; - path, Source, dest, ext: string; + Path, Source, dest, ext: string; begin if DocumentLoaded(Document) then begin - // path := TBrowse4Folder.('Web Browser - Please select a destination folder' + #10 + #13 - // + 'for the images', 'Desktop'); + // path := TBrowse4Folder.('Web Browser - Please select a destination folder' + #10 + #13 + // + 'for the images', 'Desktop'); MessageDlg(Path, mtCustom, [mbYes, mbAll, mbCancel], 0); begin for k := 0 to OleObject.Document.Images.Length - 1 do begin - Source := OleObject.Document.Images.Item(k).Src; + Source := OleObject.Document.Images.item(k).Src; p := LastDelimiter('.', Source); ext := UpperCase(System.Copy(Source, p + 1, Length(Source))); if (ext = 'GIF') or (ext = 'JPG') or (ext = 'BMP') or (ext = 'PNG') then begin p := LastDelimiter('/', Source); - dest := path + '/Images' + System.Copy(Source, p + 1, Length(Source)); + dest := Path + '/Images' + System.Copy(Source, p + 1, Length(Source)); DownloadFile(Source, dest); end; end; @@ -1569,32 +1662,34 @@ function ViewPageSourceHtml(Document: IDispatch): Boolean; var vaIn, vaOut: OleVariant; begin - Result := InvokeCmd(Document, True, HTMLID_VIEWSOURCE, 0, vaIn, vaOut) = S_OK; + Result := InvokeCMD(Document, True, HTMLID_VIEWSOURCE, 0, vaIn, vaOut) = S_OK; end; -procedure SavePageTextDialog(AOwner: TComponent; OleObject: Variant; Document: IDispatch); +procedure SavePageTextDialog(AOwner: TComponent; OleObject: Variant; + Document: IDispatch); var - sd: TSaveDialog; + SD: TSaveDialog; textStr: TStringList; begin - if not DocumentLoaded(Document) then Exit; - textstr := TStringList.Create; + if not DocumentLoaded(Document) then + Exit; + textStr := TStringList.Create; try - textStr.Add(VarToStr(OleObject.Document.documentElement.innerText)); + textStr.Add(VarToStr(OleObject.Document.DocumentElement.innerText)); begin - sd := TSaveDialog.Create(AOwner); + SD := TSaveDialog.Create(AOwner); try - sd.Filter := 'Text file|*.txt|Word file|*.doc'; - sd.DefaultExt := 'txt'; - sd.FilterIndex := 1; - sd.FileName := 'WebSiteText.txt'; - sd.Title := 'Web Site Text'; - if sd.Execute then + SD.Filter := 'Text file|*.txt|Word file|*.doc'; + SD.DefaultExt := 'txt'; + SD.FilterIndex := 1; + SD.FileName := 'WebSiteText.txt'; + SD.Title := 'Web Site Text'; + if SD.Execute then begin - textStr.SaveToFile(sd.FileName); + textStr.SaveToFile(SD.FileName); end; finally - sd.Free; + SD.Free; end; end; finally @@ -1604,7 +1699,8 @@ procedure SavePageTextDialog(AOwner: TComponent; OleObject: Variant; Document: I procedure ShellExecuteOpen(const sApplication: string); begin - ShellExecute(Application.Handle, 'open', PChar(sApplication), nil, nil, SW_SHOW); + ShellExecute(Application.Handle, 'open', PChar(sApplication), nil, + nil, SW_SHOW); end; procedure OpenOutlookMail; @@ -1649,7 +1745,7 @@ function OpenNetMeeting: Boolean; procedure DoExploreFolder(Handle: THandle; Path: string); begin - ShellExecute(handle, 'explore', PChar(Path), nil, nil, SW_SHOWNORMAL); + ShellExecute(Handle, 'explore', PChar(Path), nil, nil, SW_SHOWNORMAL); end; procedure OpenIEBrowserWithAddress(Handle: THandle); @@ -1713,7 +1809,7 @@ procedure Go(WebBrowser: TEmbeddedWB; Url: string); _URL := Url; Flags := 0; TargetFrameName := 0; - Postdata := 0; + PostData := 0; Headers := 0; if (Trim(_URL) <> '') then WebBrowser.Navigate2(_URL, Flags, TargetFrameName, PostData, Headers); @@ -1725,13 +1821,14 @@ procedure GoWithQueryDetails(WebBrowser: TEmbeddedWB; Url, Query: string); begin _URL := Url + Query; TargetFrameName := 0; - headers := StringtoVarArray('Content-Type:application/x-www-form-urlencoded'#13#10); - Postdata := StringToVarArray('version=current&name=myname' + #13#10); + Headers := StringToVarArray + ('Content-Type:application/x-www-form-urlencoded'#13#10); + PostData := StringToVarArray('version=current&name=myname' + #13#10); Flags := 0; WebBrowser.Navigate2(_URL, Flags, TargetFrameName, PostData, Headers); end; -procedure GoNoHistory(WebBrowser: TEmbeddedWB; const URL: string); +procedure GoNoHistory(WebBrowser: TEmbeddedWB; const Url: string); function StrToChr(Str: string; Pos: Integer): Char; begin @@ -1743,10 +1840,10 @@ procedure GoNoHistory(WebBrowser: TEmbeddedWB; const URL: string); HistoryStg: IUrlHistoryStg; begin Flags := navNoHistory; - WebBrowser.Navigate(WideString(URL), Flags); + WebBrowser.Navigate(Widestring(Url), Flags); Wait(WebBrowser); HistoryStg := CreateComObject(CLSID_CUrlHistory) as IUrlHistoryStg; - HistoryStg.DeleteUrl(PWideChar(StrToChr(URL, 0)), 0); + HistoryStg.DeleteUrl(PWideChar(StrToChr(Url, 0)), 0); end; procedure NavigatePidl(WebBrowser: TEmbeddedWB; pidl: PItemIdList); @@ -1755,7 +1852,7 @@ procedure NavigatePidl(WebBrowser: TEmbeddedWB; pidl: PItemIdList); psa: PSafeArray; cbData: UINT; begin - cbdata := GetPIDLSize(pidl); + cbData := GetPIDLSize(pidl); psa := SafeArrayCreateVector(VT_UI1, 0, cbData); if (psa <> nil) then begin @@ -1763,13 +1860,14 @@ procedure NavigatePidl(WebBrowser: TEmbeddedWB; pidl: PItemIdList); VariantInit(vaPidl); TVariantArg(vaPidl).vt := VT_ARRAY or VT_UI1; TVariantArg(vaPidl).parray := psa; - WebBrowser.Navigate2(vaPidl, vaEmpty, vaEmpty, vaEmpty, vaEmpty); + WebBrowser.Navigate2(vaPidl, VaEmpty, VaEmpty, VaEmpty, VaEmpty); VariantClear(vaPidl); end; end; -function GetFrameFromDocument(SourceDoc: IHTMLDocument2; FrameNo: Integer): IWebBrowser2; -var //by Aladin +function GetFrameFromDocument(SourceDoc: IHTMLDocument2; FrameNo: Integer) + : IWebBrowser2; +var // by Aladin OleContainer: IOleContainer; enum: ActiveX.IEnumUnknown; unk: IUnknown; @@ -1780,11 +1878,11 @@ function GetFrameFromDocument(SourceDoc: IHTMLDocument2; FrameNo: Integer): IWeb if DocumentLoaded(SourceDoc) then begin OleContainer := SourceDoc as IOleContainer; - OleContainer.EnumObjects(OLECONTF_EMBEDDINGS or OLECONTF_OTHERS, Enum); - Enum.Skip(FrameNo); - Enum.Next(1, Unk, Fetched); - if Supports(Unk, IWebBrowser2, Result) then //perva 2008/12/10 - Result := Unk as IWebBrowser2; + OleContainer.EnumObjects(OLECONTF_EMBEDDINGS or OLECONTF_OTHERS, enum); + enum.Skip(FrameNo); + enum.Next(1, unk, Fetched); + if Supports(unk, IWebBrowser2, Result) then // perva 2008/12/10 + Result := unk as IWebBrowser2; end; end; @@ -1794,7 +1892,8 @@ procedure GoAboutBlank(WebBrowser: TEmbeddedWB); Wait(WebBrowser); end; -procedure SendPageInMailAsAttachment(WebBrowser: TEmbeddedWB; AOwner: TComponent; Document: IDispatch; mFileName, mSubject, mBody: string); +procedure SendPageInMailAsAttachment(WebBrowser: TEmbeddedWB; + AOwner: TComponent; Document: IDispatch; mFileName, mSubject, mBody: string); begin WebBrowser.SaveToFile(mFileName); Sleep(800); @@ -1812,19 +1911,20 @@ procedure SendPageInMailAsAttachment(WebBrowser: TEmbeddedWB; AOwner: TComponent end; end; -procedure GoDownloadFile(WebBrowser: TEmbeddedWB; URL: string); +procedure GoDownloadFile(WebBrowser: TEmbeddedWB; Url: string); var Flags: OleVariant; begin - Flags := navNoHistory or navNoReadFromCache or navNoWriteToCache - or navAllowAutosearch or navBrowserBar; - WebBrowser.Navigate(URL, Flags); + Flags := navNoHistory or navNoReadFromCache or navNoWriteToCache or + navAllowAutosearch or navBrowserBar; + WebBrowser.Navigate(Url, Flags); end; function DownloadFile(SourceFile, TargetFile: string): Boolean; begin try - Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(TargetFile), 0, nil) = 0; + Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(TargetFile), + 0, nil) = 0; except Result := False; end; @@ -1835,19 +1935,18 @@ procedure GoDownloadMaskedFile(SourceFile, TargetFile: string; Notify: Boolean); if Notify then begin if DownloadFile(SourceFile, TargetFile) then - MessageBox(0, PChar('Downloading: ' + SourceFile + #10 + #13 + - 'To: ' + TargetFile + #10 + #13 + 'was successfully finished.'), + MessageBox(0, PChar('Downloading: ' + SourceFile + #10 + #13 + 'To: ' + + TargetFile + #10 + #13 + 'was successfully finished.'), PChar('Download successful.'), MB_OK) else - MessageBox(0, PChar( - 'An error ocurred while downloading the file.' + SourceFile), - PChar('Downloading Error!!'), MB_ICONERROR or MB_OK); + MessageBox(0, PChar('An error ocurred while downloading the file.' + + SourceFile), PChar('Downloading Error!!'), MB_ICONERROR or MB_OK); end else DownloadFile(SourceFile, TargetFile); end; -procedure AddToFavorites(URL, Title: string); +procedure AddToFavorites(Url, Title: string); // The URL parameter must specify a valid URL using HTTP, Secure Hypertext Transfer Protocol (HTTPS), // or File Transfer Protocol (FTP) protocols only. Calling the IShellUIHelper::AddFavorite method with a // file:// or javascript: URL returns E_ACCESSDENIED. @@ -1856,18 +1955,19 @@ procedure AddToFavorites(URL, Title: string); var ShellUIHelper: ISHellUIHelper; Url1, Title1: OleVariant; - Res : HRESULT; + Res: HRESULT; begin - if (Trim(URL) <> '') and (Trim(Title) <> '') then + if (Trim(Url) <> '') and (Trim(Title) <> '') then begin Title1 := Title; Url1 := Url; - Res := CoCreateInstance(CLSID_SHELLUIHELPER, nil, CLSCTX_INPROC_SERVER, IID_IShellUIHelper, ShellUIHelper); - if SUCCEEDED(Res) then - try - ShellUIHelper.AddFavorite(URL1, Title1); - except - end; + Res := CoCreateInstance(CLSID_ShellUIHelper, nil, CLSCTX_INPROC_SERVER, + IID_IShellUIHelper, ShellUIHelper); + if Succeeded(Res) then + try + ShellUIHelper.AddFavorite(Url1, Title1); + except + end; end; end; @@ -1900,15 +2000,16 @@ function GetShellFolderPath(FolderName: Widestring): string; Result := ''; Reg := TRegistry.Create(KEY_READ); with Reg do - try - Rootkey := HKEY_CURRENT_USER; - OpenKey(REG_PATH, False); - if (ValueExists(FolderName)) and not (length(trim(ReadString(FolderName))) = 0) then - Result := ReadString(FolderName); - finally - CloseKey; - Free; - end; + try + RootKey := HKEY_CURRENT_USER; + OpenKey(REG_PATH, False); + if (ValueExists(FolderName)) and + not(Length(Trim(ReadString(FolderName))) = 0) then + Result := ReadString(FolderName); + finally + CloseKey; + Free; + end; end; function GetSpecialFolderPath(CallerHandle: THandle; CSIDL: Integer): PChar; @@ -1921,7 +2022,7 @@ function GetSpecialFolderPath(CallerHandle: THandle; CSIDL: Integer): PChar; begin cbSize := SizeOf(exInfo); fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_IDLIST; - Wnd := CallerHandle; + WND := CallerHandle; nShow := SW_SHOWNORMAL; Buf := StrAlloc(MAX_PATH); try @@ -1930,7 +2031,7 @@ function GetSpecialFolderPath(CallerHandle: THandle; CSIDL: Integer): PChar; {$ELSE} FillChar(Buf^, MAX_PATH, 0); {$ENDIF UNICODE} - if SHGetSpecialFolderPath(wnd, Buf, CSIDL, True) then + if SHGetSpecialFolderPath(WND, Buf, CSIDL, True) then Result := Buf else Result := ''; @@ -1946,14 +2047,14 @@ function GetIEHomePage: string; begin HomePage := ''; with TRegistry.Create do - try - RootKey := HKEY_CURRENT_USER; - OpenKey('\Software\Microsoft\Internet Explorer\Main', False); - HomePage := ReadString('Start Page'); - CloseKey; - finally - Free; - end; + try + RootKey := HKEY_CURRENT_USER; + OpenKey('\Software\Microsoft\Internet Explorer\Main', False); + HomePage := ReadString('Start Page'); + CloseKey; + finally + Free; + end; Result := HomePage; end; @@ -1972,7 +2073,8 @@ function GetCachedFileFromURL(ItemUrl: string): string; if Result = '' then repeat dwEntrySize := 0; - FindNextUrlCacheEntry(CacheEntry, TInternetCacheEntryInfo(nil^), dwEntrySize); + FindNextUrlCacheEntry(CacheEntry, TInternetCacheEntryInfo(nil^), + dwEntrySize); dwLastError := GetLastError(); if (GetLastError = ERROR_INSUFFICIENT_BUFFER) then begin @@ -2006,17 +2108,18 @@ function URLFromFavorites(const dotURL: string): string; begin Result := ''; with TIniFile.Create(dotURL) do - try try - Result := ReadString('InternetShortcut', 'URL', ''); - except; + try + Result := ReadString('InternetShortcut', 'URL', ''); + except + ; + end; + finally + Free; end; - finally - Free; - end; end; -function UrlFromHistory(ShellFolder: IShellFolder; pidl: PItemIDList): string; +function UrlFromHistory(ShellFolder: IShellFolder; pidl: PItemIdList): string; var Handle: THandle; Info: IQueryInfo; @@ -2025,13 +2128,14 @@ function UrlFromHistory(ShellFolder: IShellFolder; pidl: PItemIDList): string; Result := ''; Handle := 0; Info := nil; - ShellFolder.GetUIObjectOf(Handle, 1, pidl, IID_IQUERYINFO, nil, Pointer(Info)); + ShellFolder.GetUIObjectOf(Handle, 1, pidl, IID_IQUERYINFO, nil, + Pointer(Info)); if Assigned(Info) then begin - Info.GetInfoTip(0, w); + Info.GetInfoTip(0, W); Result := W; end; - Result := Trim(System.Copy(Result, Pos(#10, Result) + 1, length(Result))); + Result := Trim(System.Copy(Result, Pos(#10, Result) + 1, Length(Result))); end; function GetDefaultBrowserFromRegistry: string; @@ -2068,34 +2172,39 @@ function GetIPAndHostName(var HostName, IPaddr, WSAErr: string): Boolean; if WSAResult <> 0 then begin WSAErr := 'Winsock is not responding."'; - end else - try - if Host = '' then - begin - SetLength(Host, MAX_PATH); - GetHostName(PAnsiChar(Host), MAX_PATH); - end; - HostEnt := GetHostByName(PAnsiChar(Host)); - if HostEnt <> nil then - begin - HostName := string(AnsiString(Host)); - SetLength(HostName, StrLen(PChar(HostName))); - SockAddr.sin_addr.S_addr := Longint(PLongint(HostEnt^.h_addr_list^)^); - IPaddr := string(AnsiString(inet_ntoa(SockAddr.sin_addr))); - Result := True; - end else - begin + end + else + try + if Host = '' then + begin + SetLength(Host, MAX_PATH); + GetHostName(PAnsiChar(Host), MAX_PATH); + end; + HostEnt := GetHostByName(PAnsiChar(Host)); + if HostEnt <> nil then + begin + HostName := string(AnsiString(Host)); + SetLength(HostName, StrLen(PChar(HostName))); + SockAddr.sin_addr.S_addr := Longint(PLongint(HostEnt^.h_addr_list^)^); + IPaddr := string(AnsiString(inet_ntoa(SockAddr.sin_addr))); + Result := True; + end + else begin - case WSAGetLastError of - WSANOTINITIALISED: WSAErr := 'WSANotInitialised'; - WSAENETDOWN: WSAErr := 'WSAENetDown'; - WSAEINPROGRESS: WSAErr := 'WSAEInProgress'; + begin + case WSAGetLastError of + WSANOTINITIALISED: + WSAErr := 'WSANotInitialised'; + WSAENETDOWN: + WSAErr := 'WSAENetDown'; + WSAEINPROGRESS: + WSAErr := 'WSAEInProgress'; + end; end; end; + finally + WSACleanup; end; - finally - WSACleanup; - end; end; function CreateNewMail: Boolean; @@ -2105,10 +2214,11 @@ function CreateNewMail: Boolean; em_subject := ''; em_body := ''; em_mail := 'mailto:?subject=' + em_subject + '&body=' + em_body; - Result := ShellExecute(0, 'open', PChar(em_mail), nil, nil, SW_SHOWNORMAL) > 32; + Result := ShellExecute(0, 'open', PChar(em_mail), nil, nil, + SW_SHOWNORMAL) > 32; end; -procedure SendUrlInMail(LocationURL, LocationName: WideString); +procedure SendUrlInMail(LocationURL, LocationName: Widestring); begin with TEwbMapiMail.Create(nil) do begin @@ -2122,16 +2232,17 @@ procedure SendUrlInMail(LocationURL, LocationName: WideString); end; end; - -function SearchText(WebBrowser: TEmbeddedWB; Document: IDispatch; const Value: string; aTypeSearch: Integer; const iPos: Integer = 1): IHTMLTxtRange; -//by JJM +function SearchText(WebBrowser: TEmbeddedWB; Document: IDispatch; + const Value: string; aTypeSearch: Integer; const iPos: Integer = 1) + : IHTMLTxtRange; +// by JJM { aTypeSearch can have the following values -(* -0 Default. Match partial words. -1 Match backwards. -2 Match whole words only. -4 Match case. -*) + (* + 0 Default. Match partial words. + 1 Match backwards. + 2 Match whole words only. + 4 Match case. + *) } var B: Boolean; @@ -2140,10 +2251,11 @@ function SearchText(WebBrowser: TEmbeddedWB; Document: IDispatch; const Value: s Result := nil; try if DocumentLoaded(Document) then - if Assigned((Document as IHTMLDocument2).body) then + if Assigned((Document as IHTMLDocument2).Body) then begin - Result := ((Document as IHTMLDocument2).body as IHTMLBodyElement).CreateTextRange; - if Result.moveStart('character', ipos) = S_OK then + Result := ((Document as IHTMLDocument2).Body as IHTMLBodyElement) + .CreateTextRange; + if Result.moveStart('character', iPos) = S_OK then B := Result.findText(Value, 1, aTypeSearch) else B := Result.findText(Value, iPos, aTypeSearch); @@ -2153,30 +2265,31 @@ function SearchText(WebBrowser: TEmbeddedWB; Document: IDispatch; const Value: s Result := nil; end; except - on e: Exception do ; + on e: Exception do; end; end; -function SearchString(Webbrowser: TEmbeddedWB; const strText: string): Boolean; +function SearchString(WebBrowser: TEmbeddedWB; const strText: string): Boolean; var tr: IHTMLTxtRange; begin Wait(WebBrowser); Result := False; try - if Assigned(Webbrowser.Document) then + if Assigned(WebBrowser.Document) then begin - tr := ((Webbrowser.Document as IHTMLDocument2).body as IHTMLBodyElement).createTextRange; + tr := ((WebBrowser.Document as IHTMLDocument2).Body as IHTMLBodyElement) + .CreateTextRange; Result := tr.findText(strText, 1, 0); end; except - on e: Exception do - ; + on e: Exception do; end; end; function DoSearchAndHighlight(Document: IDispatch; sFind: string; - Flags: TSearchFlags = []; cbackColor: string = 'yellow'; cForeColor: string = ''; + Flags: TSearchFlags = []; cbackColor: string = 'yellow'; + cForeColor: string = ''; ScrollIntoView: TScrollIntoView = sivNoScroll): Integer; var Doc2: IHTMLDocument2; @@ -2186,12 +2299,11 @@ function DoSearchAndHighlight(Document: IDispatch; sFind: string; searchdir, searchcase, iMatches: Integer; begin iMatches := 0; - if (Length(sFind) <> 0) and - Supports(Document, IHTMLDocument2, Doc2) then + if (Length(sFind) <> 0) and Supports(Document, IHTMLDocument2, Doc2) then begin searchdir := 1; searchcase := 0; - //Set up search case + // Set up search case if (sfMatchWholeWord in Flags) and (sfMatchCase in Flags) then searchcase := 6 else if sfMatchWholeWord in Flags then @@ -2199,13 +2311,13 @@ function DoSearchAndHighlight(Document: IDispatch; sFind: string; else if sfMatchCase in Flags then searchcase := 4; - pElem := Doc2.body; + pElem := Doc2.Body; if (pElem <> nil) then begin pBodyelem := pElem as IHTMLBodyElement; if (pBodyelem <> nil) then begin - pTxtRange := pBodyelem.createTextRange(); + pTxtRange := pBodyelem.CreateTextRange(); if (pTxtRange <> nil) then begin while (pTxtRange.findText(sFind, searchdir, searchcase)) do @@ -2218,10 +2330,10 @@ function DoSearchAndHighlight(Document: IDispatch; sFind: string; pTxtRange.moveEnd('Textedit', 1); iMatches := iMatches + 1; if (iMatches = 1) and (ScrollIntoView = sivFirstMatch) then - pTxtRange.scrollIntoView(True); + pTxtRange.ScrollIntoView(True); end; if (iMatches > 1) and (ScrollIntoView = sivLastMatch) then - pTxtRange.scrollIntoView(True); + pTxtRange.ScrollIntoView(True); end; end; end; @@ -2229,95 +2341,101 @@ function DoSearchAndHighlight(Document: IDispatch; sFind: string; Result := iMatches; end; -procedure SearchAndHighlight(Document: IDispatch; - AText: string; const ACaption, APrompt: string; Flags: TSearchFlags = []; - cbackColor: string = 'yellow'; cForeColor: string = ''; - ScrollIntoView: TScrollIntoView = sivNoScroll; ShowInputQuery: Boolean = True); overload; +procedure SearchAndHighlight(Document: IDispatch; AText: string; + const ACaption, APrompt: string; Flags: TSearchFlags = []; + cbackColor: string = 'yellow'; cForeColor: string = ''; + ScrollIntoView: TScrollIntoView = sivNoScroll; + ShowInputQuery: Boolean = True); overload; var -// tr: IHTMLTxtRange; - FrameCount, i: Integer; + // tr: IHTMLTxtRange; + FrameCount, I: Integer; Wb2: IWebBrowser2; begin if DocumentLoaded(Document) then begin if ShowInputQuery then - if not InputQuery(ACaption, APrompt, AText) then Exit; + if not InputQuery(ACaption, APrompt, AText) then + Exit; - if Length(aText) = 0 then Exit; + if Length(AText) = 0 then + Exit; try FrameCount := FrameCountFromDocument(Document as IHTMLDocument2); if FrameCount > 0 then begin - for i := 0 to Pred(FrameCount) do + for I := 0 to Pred(FrameCount) do begin - Wb2 := GetFrameFromDocument(Document as IHTMLDocument2, i); + Wb2 := GetFrameFromDocument(Document as IHTMLDocument2, I); if Assigned(Wb2) then SearchAndHighlight(Wb2.Document, AText, ACaption, APrompt, Flags, - cbackColor, cForeColor, ScrollIntoView, False); + cbackColor, cForeColor, ScrollIntoView, False); end; end else begin - DoSearchAndHighlight(Document, AText, Flags, - cbackColor, cForeColor, ScrollIntoView); - { tr := ((Document as IHTMLDocument2).body as IHTMLBodyElement).createTextRange; - while tr.findText(aText, 1, 0) do - begin + DoSearchAndHighlight(Document, AText, Flags, cbackColor, cForeColor, + ScrollIntoView); + { tr := ((Document as IHTMLDocument2).body as IHTMLBodyElement).createTextRange; + while tr.findText(aText, 1, 0) do + begin tr.pasteHTML('' + - tr.htmlText + ''); + tr.htmlText + ''); tr.scrollIntoView(True); - end; } + end; } end; except end; end; end; -procedure SearchAndHighlight(Document: IDispatch; aText: string; Flags: TSearchFlags = []; - cbackColor: string = 'yellow'; cForeColor: string = ''; +procedure SearchAndHighlight(Document: IDispatch; AText: string; + Flags: TSearchFlags = []; cbackColor: string = 'yellow'; + cForeColor: string = ''; ScrollIntoView: TScrollIntoView = sivNoScroll); overload; begin - SearchAndHighlight(Document, '', '', aText, Flags, cbackColor, cForeColor, ScrollIntoView, False); + SearchAndHighlight(Document, '', '', AText, Flags, cbackColor, cForeColor, + ScrollIntoView, False); end; -{function FillForm(OleObject: Variant; FieldName: string; Value: string): Boolean; -var +{ function FillForm(OleObject: Variant; FieldName: string; Value: string): Boolean; + var I, j: Integer; FormItem: Variant; -begin + begin Result := False; if not DocumentLoaded(OleObject.Document) or OleObject.Document.all.tags('FORM').Length = 0 then - Exit; + Exit; for I := 0 to OleObject.Document.forms.Length - 1 do begin - FormItem := OleObject.Document.forms.Item(I); - for j := 0 to FormItem.Length - 1 do - begin - try - if (FormItem.Item(j).Name = FieldName) and - (FormItem.Item(j).Name <> 'length') then - begin - FormItem.Item(j).Value := Value; - Result := True; - end; - except - Exit; - end; - end; + FormItem := OleObject.Document.forms.Item(I); + for j := 0 to FormItem.Length - 1 do + begin + try + if (FormItem.Item(j).Name = FieldName) and + (FormItem.Item(j).Name <> 'length') then + begin + FormItem.Item(j).Value := Value; + Result := True; + end; + except + Exit; + end; + end; end; -end; } + end; } -procedure SetTextAreaValue(Document: IDispatch; sName, sValue: string; Options: TFindOptions); +procedure SetTextAreaValue(Document: IDispatch; sName, sValue: string; + Options: TFindOptions); var Doc2: IHTMLDocument2; - i: Integer; + I: Integer; field: IHTMLElement; textarea: IHTMLTextAreaElement; begin if Supports(Document, IHTMLDocument2, Doc2) then - for i := 0 to Doc2.all.length - 1 do + for I := 0 to Doc2.all.Length - 1 do begin - field := Doc2.all.item(i, '') as IHTMLElement; + field := Doc2.all.item(I, '') as IHTMLElement; if Assigned(field) then begin if SameText(field.tagName, 'TEXTAREA') then @@ -2325,8 +2443,8 @@ procedure SetTextAreaValue(Document: IDispatch; sName, sValue: string; Options: textarea := field as IHTMLTextAreaElement; if Assigned(textarea) then begin - if ((frWholeWord in Options) and (sName = textarea.Name)) - or ((Options = []) and (AnsiPos(sName, textarea.Name) <> 0)) then + if ((frWholeWord in Options) and (sName = textarea.Name)) or + ((Options = []) and (AnsiPos(sName, textarea.Name) <> 0)) then textarea.Value := sValue; end; end; @@ -2334,11 +2452,12 @@ procedure SetTextAreaValue(Document: IDispatch; sName, sValue: string; Options: end; end; -function FillForm(Document: IDispatch; FieldName: string; FieldValue: string; ElementNr: Integer = -1): Boolean; overload; +function FillForm(Document: IDispatch; FieldName: string; FieldValue: string; + ElementNr: Integer = -1): Boolean; overload; var Inputs: IHTMLElementCollection; HTMLElement: IHTMLElement; - TagName: string; + tagName: string; k, iItemNr, iInputCount: Integer; begin Result := False; @@ -2351,7 +2470,8 @@ function FillForm(Document: IDispatch; FieldName: string; FieldValue: string; El else iInputCount := ElementNr; - if iInputCount = -1 then iInputCount := 0; + if iInputCount = -1 then + iInputCount := 0; for k := 0 to iInputCount - 1 do begin @@ -2363,34 +2483,36 @@ function FillForm(Document: IDispatch; FieldName: string; FieldValue: string; El HTMLElement := Inputs.item(iItemNr, '') as IHTMLElement; if Assigned(HTMLElement) then begin - TagName := AnsiUpperCase(HTMLElement.tagName); - if TagName = 'INPUT' then + tagName := AnsiUpperCase(HTMLElement.tagName); + if tagName = 'INPUT' then begin (HTMLElement as IHTMLInputElement).Value := FieldValue; Result := True; Exit; end - else if TagName = 'SELECT' then + else if tagName = 'SELECT' then begin (HTMLElement as IHTMLSelectElement).Value := FieldValue; Result := True; Exit; end - else if TagName = 'TEXTAREA' then + else if tagName = 'TEXTAREA' then begin (HTMLElement as IHTMLTextAreaElement).Value := FieldValue; Result := True; Exit; end; end; - if ElementNr <> -1 then Exit; + if ElementNr <> -1 then + Exit; end; except end; end; end; -function FillForm(WebBrowser: TEmbeddedWB; FieldName: string; FieldValue: string; ElementNr: Integer = -1): Boolean; overload; +function FillForm(WebBrowser: TEmbeddedWB; FieldName: string; + FieldValue: string; ElementNr: Integer = -1): Boolean; overload; var Doc3: IHTMLDocument3; begin @@ -2402,8 +2524,8 @@ function FillForm(WebBrowser: TEmbeddedWB; FieldName: string; FieldValue: string end; end; - -function FillForm(WebBrowser: TEmbeddedWB; FieldName: string; FieldValue: string; Value: Boolean): Boolean; +function FillForm(WebBrowser: TEmbeddedWB; FieldName: string; + FieldValue: string; Value: Boolean): Boolean; var I, j: Integer; FormItem: Variant; @@ -2412,16 +2534,17 @@ function FillForm(WebBrowser: TEmbeddedWB; FieldName: string; FieldValue: string if not DocumentLoaded(WebBrowser.Document) then if WebBrowser.OleObject.Document.all.tags('FORM').Length = 0 then if (FieldName = '') and (FieldValue = '') then - for I := 0 to WebBrowser.OleObject.Document.forms.Length - 1 do + for I := 0 to WebBrowser.OleObject.Document.Forms.Length - 1 do begin - FormItem := WebBrowser.OleObject.Document.forms.Item(I); + FormItem := WebBrowser.OleObject.Document.Forms.item(I); for j := 0 to FormItem.Length - 1 do begin try - if (FormItem.Item(j).Name = FieldName) or (Fieldname = '') then - if (FormItem.Item(j).Value = FieldValue) or (Fieldvalue = '') then + if (FormItem.item(j).Name = FieldName) or (FieldName = '') then + if (FormItem.item(j).Value = FieldValue) or (FieldValue = '') + then begin - FormItem.Item(j).checked := Value; + FormItem.item(j).checked := Value; Result := True; end; except @@ -2437,7 +2560,7 @@ procedure ClickInputImage(WebBrowser: TEmbeddedWB; ImageURL: string); iDisp: IDispatch; iColl: IHTMLElementCollection; InputImage: htmlInputImage; - i: Integer; + I: Integer; begin if WebBrowser.DocumentLoaded then begin @@ -2449,12 +2572,12 @@ procedure ClickInputImage(WebBrowser: TEmbeddedWB; ImageURL: string); if Supports(iDisp, IHTMLElementCollection, iColl) then begin ImageURL := AnsiUpperCase(ImageURL); - for i := 1 to iColl.Get_length do + for I := 1 to iColl.Get_length do begin - iDisp := iColl.item(Pred(i), 0); - if Supports(iDisp, HTMLInputImage, ImageURL) then + iDisp := iColl.item(Pred(I), 0); + if Supports(iDisp, htmlInputImage, ImageURL) then begin - if Pos(ImageURL, AnsiUpperCase(InputImage.src)) <> 0 then + if Pos(ImageURL, AnsiUpperCase(InputImage.Src)) <> 0 then begin InputImage.Click; end; @@ -2474,14 +2597,14 @@ function GetFieldValue(OleObject: Variant; FieldName: string): string; Result := ''; if DocumentLoaded(OleObject.Document) then if OleObject.Document.all.tags('FORM').Length = 0 then - for I := 0 to OleObject.Document.forms.Length - 1 do + for I := 0 to OleObject.Document.Forms.Length - 1 do begin - FormItem := OleObject.Document.forms.Item(I); + FormItem := OleObject.Document.Forms.item(I); for j := 0 to FormItem.Length - 1 do begin try - if FormItem.Item(j).Name = FieldName then - Result := FormItem.Item(j).Value; + if FormItem.item(j).Name = FieldName then + Result := FormItem.item(j).Value; except Continue; end; @@ -2496,15 +2619,15 @@ procedure FillIEFormAndExcecute; spDisp: IDispatch; IDoc1: IHTMLDocument2; Document: Variant; - k, m: Integer; + k, M: Integer; ovElements: OleVariant; - i: Integer; + I: Integer; begin ShellWindow := CoShellWindows.Create; // get the running instance of Internet Explorer for k := 0 to ShellWindow.Count do begin - spDisp := ShellWindow.Item(k); + spDisp := ShellWindow.item(k); if spDisp = nil then Continue; // QueryInterface determines if an interface can be used with an object @@ -2512,35 +2635,36 @@ procedure FillIEFormAndExcecute; if IWeb <> nil then begin - IWeb.Document.QueryInterface(IHTMLDocument2, iDoc1); - if iDoc1 <> nil then + IWeb.Document.QueryInterface(IHTMLDocument2, IDoc1); + if IDoc1 <> nil then begin - IWeb := ShellWindow.Item(k) as IWebBrowser2; + IWeb := ShellWindow.item(k) as IWebBrowser2; begin Document := IWeb.Document; - // count forms on document and iterate through its forms - for m := 0 to Document.Forms.Length - 1 do + // count forms on document and iterate through its forms + for M := 0 to Document.Forms.Length - 1 do begin - ovElements := Document.Forms.Item(m).Elements; + ovElements := Document.Forms.item(M).Elements; // iterate through elements - for i := 0 to ovElements.Length - 1 do + for I := 0 to ovElements.Length - 1 do begin // when input fieldname is found, try to fill out try - if (CompareText(ovElements.Item(i).tagName, 'INPUT') = 0) and - (CompareText(ovElements.Item(i).type, 'text') = 0) then + if (CompareText(ovElements.item(I).tagName, 'INPUT') = 0) and + (CompareText(ovElements.item(I).type, 'text') = 0) then begin - ovElements.Item(i).Value := 'FindWindow'; + ovElements.item(I).Value := 'FindWindow'; end; except end; // when Submit button is found, try to click try - if (CompareText(ovElements.Item(i).tagName, 'INPUT') = 0) and - (CompareText(ovElements.Item(i).type, 'SUBMIT') = 0) and - (ovElements.Item(i).Value = 'Search') then // Suchen for German + if (CompareText(ovElements.item(I).tagName, 'INPUT') = 0) and + (CompareText(ovElements.item(I).type, 'SUBMIT') = 0) and + (ovElements.item(I).Value = 'Search') then + // Suchen for German begin - ovElements.Item(i).Click; + ovElements.item(I).Click; end; except end; @@ -2560,41 +2684,43 @@ procedure ClearHistory; HistoryStg.ClearHistory; end; -function DeleteFirstCacheEntry(var H: THandle): DWORD; +function DeleteFirstCacheEntry(var h: THandle): DWORD; var T: PInternetCacheEntryInfo; - D: DWord; + D: DWORD; begin Result := S_OK; - H := 0; + h := 0; D := 0; - FindFirstUrlCacheEntryEx(nil, 0, URLCACHE_FIND_DEFAULT_FILTER, 0, nil, @D, nil, nil, nil); + FindFirstUrlCacheEntryEx(nil, 0, URLCACHE_FIND_DEFAULT_FILTER, 0, nil, @D, + nil, nil, nil); GetMem(T, D); try - H := FindFirstUrlCacheEntryEx(nil, 0, URLCACHE_FIND_DEFAULT_FILTER, 0, T, @D, nil, nil, nil); - if (H = 0) then + h := FindFirstUrlCacheEntryEx(nil, 0, URLCACHE_FIND_DEFAULT_FILTER, 0, T, + @D, nil, nil, nil); + if (h = 0) then Result := GetLastError else - DeleteUrlCacheEntry(T^.lpszSourceUrlname); + DeleteUrlCacheEntry(T^.lpszSourceUrlName); finally FreeMem(T, D) end; end; -function DeleteNextCacheEntry(H: THandle): DWORD; +function DeleteNextCacheEntry(h: THandle): DWORD; var T: PInternetCacheEntryInfo; D: DWORD; begin Result := S_OK; D := 0; - FindnextUrlCacheEntryEx(H, nil, @D, nil, nil, nil); + FindnextUrlCacheEntryEx(h, nil, @D, nil, nil, nil); GetMem(T, D); try - if not FindNextUrlCacheEntryEx(H, T, @D, nil, nil, nil) then + if not FindnextUrlCacheEntryEx(h, T, @D, nil, nil, nil) then Result := GetLastError else - DeleteUrlCacheEntry(T^.lpszSourceUrlname); + DeleteUrlCacheEntry(T^.lpszSourceUrlName); finally FreeMem(T, D) end; @@ -2602,23 +2728,23 @@ function DeleteNextCacheEntry(H: THandle): DWORD; procedure ClearCache; var - H: THandle; + h: THandle; begin - if DeleteFirstCacheEntry(H) = S_OK then + if DeleteFirstCacheEntry(h) = S_OK then repeat - until DeleteNextCacheEntry(H) = ERROR_NO_MORE_ITEMS; - FindCloseUrlCache(H); + until DeleteNextCacheEntry(h) = ERROR_NO_MORE_ITEMS; + FindCloseUrlCache(h); end; procedure ClearTypedUrls; begin with TRegistry.Create do - try - RootKey := HKEY_CURRENT_USER; - DeleteKey('Software\Microsoft\Internet Explorer\TypedURLs'); - finally - Free; - end; + try + RootKey := HKEY_CURRENT_USER; + DeleteKey('Software\Microsoft\Internet Explorer\TypedURLs'); + finally + Free; + end; end; function CheckOnlineStatus: Boolean; @@ -2627,7 +2753,8 @@ function CheckOnlineStatus: Boolean; begin Result := False; try - dwConnectionTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY; + dwConnectionTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN + + INTERNET_CONNECTION_PROXY; Result := InternetGetConnectedState(@dwConnectionTypes, 0); except end; @@ -2647,7 +2774,8 @@ procedure SetGlobalOffline(Value: Boolean); begin ci.dwConnectedState := INTERNET_STATE_DISCONNECTED_BY_USER; ci.dwFlags := ISO_FORCE_DISCONNECTED; - end else + end + else begin ci.dwFlags := 0; ci.dwConnectedState := INTERNET_STATE_CONNECTED; @@ -2673,26 +2801,28 @@ function IsGlobalOffline: Boolean; dwState := 0; dwSize := SizeOf(dwState); Result := False; - if (InternetQueryOption(nil, INTERNET_OPTION_CONNECTED_STATE, @dwState, dwSize)) then + if (InternetQueryOption(nil, INTERNET_OPTION_CONNECTED_STATE, @dwState, + dwSize)) then Result := ((dwState and INTERNET_STATE_DISCONNECTED_BY_USER) <> 0); end; function GetTLDFromHost(Host: string): string; var - i, Dots: Integer; + I, Dots: Integer; begin Dots := 0; - for i := Length(Host) downto 1 do + for I := Length(Host) downto 1 do begin - if Copy(Host, i, 1) = '.' then + if Copy(Host, I, 1) = '.' then Inc(Dots); if Dots = 2 then - break; - Result := Copy(Host, i, 1) + Result; + Break; + Result := Copy(Host, I, 1) + Result; end; end; -function CheckIfInRestricredList(const Host: string; SecureSite: Boolean): Boolean; +function CheckIfInRestricredList(const Host: string; + SecureSite: Boolean): Boolean; const Path = '\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\'; var @@ -2704,12 +2834,12 @@ function CheckIfInRestricredList(const Host: string; SecureSite: Boolean): Boole begin try RootKey := HKEY_CURRENT_USER; - if not OpenKey(Path + 'Domains' + '\' + TLD + '\' + - Copy(Host, 1, Length(Host) - Length(TLD) - 1), False) then + if not OpenKey(Path + 'Domains' + '\' + TLD + '\' + Copy(Host, 1, + Length(Host) - Length(TLD) - 1), False) then begin CloseKey; - if not OpenKey(Path + 'EscDomains' + '\' + TLD + '\' + - Copy(Host, 1, Length(Host) - Length(TLD) - 1), False) then // found on IE6, W2003 + if not OpenKey(Path + 'EscDomains' + '\' + TLD + '\' + Copy(Host, 1, + Length(Host) - Length(TLD) - 1), False) then // found on IE6, W2003 begin CloseKey; Exit; @@ -2738,12 +2868,12 @@ function CheckIfInTrustedList(const Host: string; SecureSite: Boolean): Boolean; begin try RootKey := HKEY_CURRENT_USER; - if not OpenKey(Path + 'Domains' + '\' + TLD + '\' + - Copy(Host, 1, Length(Host) - Length(TLD) - 1), False) then + if not OpenKey(Path + 'Domains' + '\' + TLD + '\' + Copy(Host, 1, + Length(Host) - Length(TLD) - 1), False) then begin CloseKey; - if not OpenKey(Path + 'EscDomains' + '\' + TLD + '\' + - Copy(Host, 1, Length(Host) - Length(TLD) - 1), False) then // found on IE6, W2003 + if not OpenKey(Path + 'EscDomains' + '\' + TLD + '\' + Copy(Host, 1, + Length(Host) - Length(TLD) - 1), False) then // found on IE6, W2003 begin CloseKey; Exit; @@ -2760,20 +2890,23 @@ function CheckIfInTrustedList(const Host: string; SecureSite: Boolean): Boolean; end; end; -procedure AddToTrustedSiteList(WebBrowser: TEmbeddedWB; const URL: string); +procedure AddToTrustedSiteList(WebBrowser: TEmbeddedWB; const Url: string); const - REG_PATH = '\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains'; + REG_PATH = + '\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains'; var Reg: TRegistryIniFile; begin - if AnsiPos('HTTPS', AnsiUpperCase(URL)) = 0 then - MessageDlg('Only sites with https:// prefix (secured sites) can be added to the trusted sites list zone!', mtError, [mbOK], 0) + if AnsiPos('HTTPS', AnsiUpperCase(Url)) = 0 then + MessageDlg + ('Only sites with https:// prefix (secured sites) can be added to the trusted sites list zone!', + mtError, [mbOK], 0) else begin try Reg := TRegistryIniFile.Create(REG_PATH); try - Reg.WriteInteger(URL, 'https', (2)); + Reg.WriteInteger(Url, 'https', (2)); finally Reg.Free; end; @@ -2782,9 +2915,10 @@ procedure AddToTrustedSiteList(WebBrowser: TEmbeddedWB; const URL: string); end; end; -procedure AddToRestrictedSiteList(WebBrowser: TEmbeddedWB; const URL: string); +procedure AddToRestrictedSiteList(WebBrowser: TEmbeddedWB; const Url: string); const - REG_PATH = '\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains'; + REG_PATH = + '\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains'; var st: string; I: Integer; @@ -2808,8 +2942,7 @@ procedure AddToRestrictedSiteList(WebBrowser: TEmbeddedWB; const URL: string); end; end; - -function GetZoneAttributes(const URL: string): TZoneAttributes; +function GetZoneAttributes(const Url: string): TZoneAttributes; var dwZone: Cardinal; ZoneAttr: TZoneAttributes; @@ -2821,7 +2954,7 @@ function GetZoneAttributes(const URL: string): TZoneAttributes; if CoInternetCreateSecuritymanager(nil, SecManager, 0) = S_OK then if CoInternetCreateZoneManager(nil, ZoneManager, 0) = S_OK then begin - SecManager.MapUrlToZone(PWideChar(WideString(URL)), dwZone, 0); + SecManager.MapUrlToZone(PWideChar(Widestring(Url)), dwZone, 0); ZoneManager.GetZoneAttributes(dwZone, Result); end; end; @@ -2846,12 +2979,12 @@ function GetZoneIconToForm(LocationURL: string; Caption, Hint: string): Boolean; procedure GetZoneIcon(IconPath: string; var Icon: TIcon); var - FName, ImageName: string; + Fname, ImageName: string; h: hInst; begin - FName := Copy(IconPath, 1, Pos('#', IconPath) - 1); + Fname := Copy(IconPath, 1, Pos('#', IconPath) - 1); ImageName := Copy(IconPath, Pos('#', IconPath), Length(IconPath)); - h := LoadLibrary(PChar(FName)); + h := LoadLibrary(PChar(Fname)); try if h <> 0 then Icon.Handle := LoadImage(h, PChar(ImageName), IMAGE_ICON, 16, 16, 0); @@ -2860,7 +2993,8 @@ procedure GetZoneIcon(IconPath: string; var Icon: TIcon); end; end; -function GetUrlSecurityZone(LocationURL: string; var ZoneName, ZoneDescription: string; var Icon: TIcon): Boolean; +function GetUrlSecurityZone(LocationURL: string; + var ZoneName, ZoneDescription: string; var Icon: TIcon): Boolean; var ZoneAttr: TZoneAttributes; begin @@ -2879,7 +3013,8 @@ function GetUrlSecurityZone(LocationURL: string; var ZoneName, ZoneDescription: end; end; -function GetSSLStatus(OleObject: Variant; LocationURL: string; var SSLName, SSLDescription: string): Boolean; +function GetSSLStatus(OleObject: Variant; LocationURL: string; + var SSLName, SSLDescription: string): Boolean; begin Result := False; if (Pos('https://', LocationURL) > 0) then @@ -2904,7 +3039,7 @@ function SetProxy(UserAgent, Address, Bypass: string): Boolean; list: INTERNET_PER_CONN_OPTION_LIST; dwBufSize: DWORD; hInternet: Pointer; - Options: array[1..3] of INTERNET_PER_CONN_OPTION; + Options: array [1 .. 3] of INTERNET_PER_CONN_OPTION; begin Result := False; dwBufSize := SizeOf(list); @@ -2913,7 +3048,7 @@ function SetProxy(UserAgent, Address, Bypass: string): Boolean; list.dwOptionCount := High(Options); Options[1].dwOption := INTERNET_PER_CONN_FLAGS; -// Options[1].Value.dwValue := PROXY_TYPE_DIRECT or PROXY_TYPE_PROXY; //Original code + // Options[1].Value.dwValue := PROXY_TYPE_DIRECT or PROXY_TYPE_PROXY; //Original code Options[1].dwValue := PROXY_TYPE_PROXY; Options[2].dwOption := INTERNET_PER_CONN_PROXY_SERVER; @@ -2923,22 +3058,26 @@ function SetProxy(UserAgent, Address, Bypass: string): Boolean; Options[3].pszValue := PChar(Bypass); ShowMessage(Bypass); list.pOptions := @Options; - hInternet := InternetOpen(PChar(UserAgent), INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0); + hInternet := InternetOpen(PChar(UserAgent), INTERNET_OPEN_TYPE_DIRECT, + nil, nil, 0); if hInternet <> nil then - try - Result := InternetSetOption(nil, INTERNET_OPTION_PER_CONNECTION_OPTION, @list, dwBufSize); - Result := Result and InternetSetOption(nil, INTERNET_OPTION_REFRESH, nil, 0); - finally - InternetCloseHandle(hInternet) - end; + try + Result := InternetSetOption(nil, INTERNET_OPTION_PER_CONNECTION_OPTION, + @list, dwBufSize); + Result := Result and InternetSetOption(nil, + INTERNET_OPTION_REFRESH, nil, 0); + finally + InternetCloseHandle(hInternet) + end; end; -function SetProxy(UserAgent, Address, UserName, Password: string; Port: Integer): Boolean; +function SetProxy(UserAgent, Address, UserName, Password: string; + Port: Integer): Boolean; var list: INTERNET_PER_CONN_OPTION_LIST; dwBufSize: DWORD; hInternet, hInternetConnect: Pointer; - Options: array[1..3] of INTERNET_PER_CONN_OPTION; + Options: array [1 .. 3] of INTERNET_PER_CONN_OPTION; begin Result := False; dwBufSize := SizeOf(list); @@ -2952,28 +3091,30 @@ function SetProxy(UserAgent, Address, UserName, Password: string; Port: Integer) Options[3].dwOption := INTERNET_PER_CONN_PROXY_BYPASS; Options[3].pszValue := ''; list.pOptions := @Options; - hInternet := InternetOpen(PChar(UserAgent), INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0); + hInternet := InternetOpen(PChar(UserAgent), INTERNET_OPEN_TYPE_DIRECT, + nil, nil, 0); if hInternet <> nil then - try - hInternetConnect := InternetConnect(hInternet, PChar(Address), Port, PChar(UserName), PChar(Password), - INTERNET_SERVICE_HTTP, 0, 0); - if hInternetConnect <> nil then - begin - Result := InternetSetOption(hInternet, INTERNET_OPTION_PER_CONNECTION_OPTION, @list, dwBufSize); - Result := Result and InternetSetOption(hInternet, INTERNET_OPTION_REFRESH, nil, 0); + try + hInternetConnect := InternetConnect(hInternet, PChar(Address), Port, + PChar(UserName), PChar(Password), INTERNET_SERVICE_HTTP, 0, 0); + if hInternetConnect <> nil then + begin + Result := InternetSetOption(hInternet, + INTERNET_OPTION_PER_CONNECTION_OPTION, @list, dwBufSize); + Result := Result and InternetSetOption(hInternet, + INTERNET_OPTION_REFRESH, nil, 0); + end; + finally + InternetCloseHandle(hInternet) end; - finally - InternetCloseHandle(hInternet) - end; end; - function SetProxyFromPAC(UserAgent, PACFile: string): Boolean; var list: INTERNET_PER_CONN_OPTION_LIST; dwBufSize: DWORD; hInternet: Pointer; - Options: array[1..2] of INTERNET_PER_CONN_OPTION; + Options: array [1 .. 2] of INTERNET_PER_CONN_OPTION; begin Result := False; dwBufSize := SizeOf(list); @@ -2981,20 +3122,23 @@ function SetProxyFromPAC(UserAgent, PACFile: string): Boolean; list.pszConnection := nil; list.dwOptionCount := High(Options); Options[1].dwOption := INTERNET_PER_CONN_AUTOCONFIG_URL; - Options[1].pszValue := PChar(PacFile); + Options[1].pszValue := PChar(PACFile); Options[2].dwOption := INTERNET_PER_CONN_FLAGS; Options[2].dwValue := PROXY_TYPE_AUTO_PROXY_URL; list.dwOptionCount := 2; list.dwOptionError := 0; list.pOptions := @Options; - hInternet := InternetOpen(PChar(UserAgent), INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0); + hInternet := InternetOpen(PChar(UserAgent), INTERNET_OPEN_TYPE_DIRECT, + nil, nil, 0); if hInternet <> nil then - try - Result := InternetSetOption(hInternet, INTERNET_OPTION_PER_CONNECTION_OPTION, @list, dwBufSize); - Result := Result and InternetSetOption(hInternet, INTERNET_OPTION_REFRESH, nil, 0); - finally - InternetCloseHandle(hInternet) - end; + try + Result := InternetSetOption(hInternet, + INTERNET_OPTION_PER_CONNECTION_OPTION, @list, dwBufSize); + Result := Result and InternetSetOption(hInternet, + INTERNET_OPTION_REFRESH, nil, 0); + finally + InternetCloseHandle(hInternet) + end; end; function RemoveProxy(): Boolean; @@ -3002,7 +3146,7 @@ function RemoveProxy(): Boolean; list: INTERNET_PER_CONN_OPTION_LIST; dwBufSize: DWORD; hInternet: Pointer; - Options: array[1..3] of INTERNET_PER_CONN_OPTION; + Options: array [1 .. 3] of INTERNET_PER_CONN_OPTION; begin Result := False; dwBufSize := SizeOf(list); @@ -3018,26 +3162,26 @@ function RemoveProxy(): Boolean; list.pOptions := @Options; hInternet := InternetOpen(PChar(''), INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0); if hInternet <> nil then - try - InternetSetOption(hInternet, INTERNET_OPTION_PER_CONNECTION_OPTION, @list, dwBufSize); - InternetSetOption(hInternet, INTERNET_OPTION_REFRESH, nil, 0); - Result := True; - finally - InternetCloseHandle(hInternet) - end; + try + InternetSetOption(hInternet, INTERNET_OPTION_PER_CONNECTION_OPTION, @list, + dwBufSize); + InternetSetOption(hInternet, INTERNET_OPTION_REFRESH, nil, 0); + Result := True; + finally + InternetCloseHandle(hInternet) + end; end; procedure RemoveUserAgent(UserAgent: string); var - reg: TRegistry; + Reg: TRegistry; begin Reg := TRegistry.Create; with Reg do begin RootKey := HKEY_CURRENT_USER; try - if OpenKey(USER_AGENT_PATH, False) - then + if OpenKey(USER_AGENT_PATH, False) then DeleteValue(UserAgent); finally CloseKey; @@ -3052,21 +3196,22 @@ procedure RemoveUserAgent(UserAgent: string); function RegisterMIMEFilter(clsid: TGUID; MIME: PWideChar): HRESULT; begin - CoGetClassObject(Clsid, CLSCTX_SERVER, nil, IClassFactory, MimeFactory); + CoGetClassObject(clsid, CLSCTX_SERVER, nil, IClassFactory, MimeFactory); CoInternetGetSession(0, MimeInternetSession, 0); - Result := MIMEInternetSession.RegisterMimeFilter(MimeFactory, Clsid, MIME); + Result := MimeInternetSession.RegisterMIMEFilter(MimeFactory, clsid, MIME); end; function UnregisterMIMEFilter(MIME: PWideChar): HRESULT; begin - Result := MIMEInternetSession.UnregisterMimeFilter(MIMEFactory, MIME); + Result := MimeInternetSession.UnregisterMIMEFilter(MimeFactory, MIME); end; function RegisterNameSpace(clsid: TGUID): HRESULT; begin - CoGetClassObject(Clsid, CLSCTX_SERVER, nil, IClassFactory, NSFactory); + CoGetClassObject(clsid, CLSCTX_SERVER, nil, IClassFactory, NSFactory); CoInternetGetSession(0, NSInternetSession, 0); - Result := NSInternetSession.RegisterNameSpace(NSFactory, Clsid, 'http', 0, nil, 0); + Result := NSInternetSession.RegisterNameSpace(NSFactory, clsid, 'http', + 0, nil, 0); end; function UnregisterNameSpace: HRESULT; @@ -3084,22 +3229,25 @@ procedure RestoreApplicationFormSize(WebBrowser: TEmbeddedWB); RootKey := HKEY_LOCAL_MACHINE; RegPath := 'SOFTWARE\' + Forms.Application.Title + '\FormSize'; if OpenKey(RegPath, False) then - try - with Forms.Application.MainForm do - begin - Left := ReadInteger('Left'); - Top := ReadInteger('Top'); - Width := ReadInteger('Width'); - Height := ReadInteger('Height'); - ws := ReadInteger('WindowState'); - case ws of - 0: WindowState := wsNormal; - 1: WindowState := wsMinimized; - 2: WindowState := wsMaximized; + try + with Forms.Application.MainForm do + begin + left := ReadInteger('Left'); + top := ReadInteger('Top'); + Width := ReadInteger('Width'); + Height := ReadInteger('Height'); + ws := ReadInteger('WindowState'); + case ws of + 0: + WindowState := wsNormal; + 1: + WindowState := wsMinimized; + 2: + WindowState := wsMaximized; + end; end; + except end; - except - end; CloseKey; Free; end; @@ -3114,24 +3262,27 @@ procedure SaveApplicationFormSize(WebBrowser: TEmbeddedWB); RootKey := HKEY_LOCAL_MACHINE; RegPath := 'SOFTWARE\' + Forms.Application.Title + '\FormSize'; if OpenKey(RegPath, True) then - try - with Forms.Application.MainForm do - begin - WriteInteger('Top', Top); - WriteInteger('Left', Left); - WriteInteger('Width', Width); - WriteInteger('Height', Height); + try with Forms.Application.MainForm do - case WindowState of - wsNormal: WriteInteger('WindowState', 0); - wsMinimized: WriteInteger('WindowState', 0); - wsMaximized: WriteInteger('WindowState', 0); - end; + begin + WriteInteger('Top', top); + WriteInteger('Left', left); + WriteInteger('Width', Width); + WriteInteger('Height', Height); + with Forms.Application.MainForm do + case WindowState of + wsNormal: + WriteInteger('WindowState', 0); + wsMinimized: + WriteInteger('WindowState', 0); + wsMaximized: + WriteInteger('WindowState', 0); + end; + end; + CloseKey; + Free; + except end; - CloseKey; - Free; - except - end; end; end; @@ -3140,12 +3291,13 @@ procedure Wait(WebBrowser: TEmbeddedWB); WebBrowser.Wait; end; -function InvokeCMD(Document: IDispatch; InvokeIE: Boolean; Value1, Value2: Integer; var vaIn, vaOut: OleVariant): HRESULT; +function InvokeCMD(Document: IDispatch; InvokeIE: Boolean; + Value1, Value2: Integer; var vaIn, vaOut: OleVariant): HRESULT; var CmdTarget: IOleCommandTarget; PtrGUID: PGUID; begin - // New(PtrGUID); + // New(PtrGUID); Result := S_FALSE; if InvokeIE then begin @@ -3153,18 +3305,24 @@ function InvokeCMD(Document: IDispatch; InvokeIE: Boolean; Value1, Value2: Integ PtrGUID^ := CLSID_WebBrowser; end else - PtrGuid := PGUID(nil); + PtrGUID := PGUID(nil); if DocumentLoaded(Document) then - try - Document.QueryInterface(IOleCommandTarget, CmdTarget); - if CmdTarget <> nil then try - Result := CmdTarget.Exec(PtrGuid, Value1, Value2, vaIn, vaOut); - finally - CmdTarget._Release; + Document.QueryInterface(IOleCommandTarget, CmdTarget); + if CmdTarget <> nil then + begin +{$IFNDEF DELPHIX_SEATTLE_UP } + try + Result := CmdTarget.Exec(PtrGUID, Value1, Value2, vaIn, vaOut); + finally + CmdTarget._Release; + end; +{$ELSE} + Result := CmdTarget.Exec(PtrGUID, Value1, Value2, vaIn, vaOut); +{$ENDIF} + end; + except end; - except - end; Dispose(PtrGUID); end; @@ -3200,11 +3358,13 @@ function GetLastVisitedPage(var LastVisitedPage: string): Boolean; LastVisitedPage := ''; RootKey := HKEY_LOCAL_MACHINE; try - if OpenKey('SOFTWARE\' + Forms.Application.Title + '\WebPages', False) then + if OpenKey('SOFTWARE\' + Forms.Application.Title + '\WebPages', False) + then begin LastVisitedPage := ReadString('LastVisitedPage'); CloseKey; - Result := (LastVisitedPage <> '') and (AnsiPos('.', LastVisitedPage) > 0); + Result := (LastVisitedPage <> '') and + (AnsiPos('.', LastVisitedPage) > 0); end; finally Free; @@ -3212,7 +3372,8 @@ function GetLastVisitedPage(var LastVisitedPage: string): Boolean; end; end; -function SaveLastVisitedPage(WebBrowser: TEmbeddedWB; LocationURL: string): Boolean; +function SaveLastVisitedPage(WebBrowser: TEmbeddedWB; + LocationURL: string): Boolean; var RegPath: string; begin @@ -3222,10 +3383,10 @@ function SaveLastVisitedPage(WebBrowser: TEmbeddedWB; LocationURL: string): Bool RootKey := HKEY_LOCAL_MACHINE; RegPath := 'SOFTWARE\' + Forms.Application.Title + '\WebPages'; if OpenKey(RegPath, False) then - try - DeleteKey('LastVisitedPage'); - except - end; + try + DeleteKey('LastVisitedPage'); + except + end; Free; end; with TRegIniFile.Create do @@ -3280,20 +3441,18 @@ procedure DisableNavSound(bDisable: Boolean); end; end; -function WBExecScript( - TargetObj: IDispatch; - MethodName: string; +function WBExecScript(TargetObj: IDispatch; MethodName: string; ParamValues: array of const): OleVariant; var - wide: WideString; + wide: Widestring; disps: TDispIDList; panswer: ^OleVariant; answer: OleVariant; dispParams: TDispParams; aexception: TExcepInfo; pVarArg: PVariantArgList; - res: HRESULT; - ParamCount, i: Integer; + Res: HRESULT; + ParamCount, I: Integer; begin Result := False; @@ -3302,118 +3461,145 @@ function WBExecScript( wide := MethodName; pVarArg := nil; if ParamCount > 0 then - GetMem(pVarArg, ParamCount * sizeof(TVariantArg)); + GetMem(pVarArg, ParamCount * SizeOf(TVariantArg)); try // get dispid of requested method - if not Succeeded(TargetObj.GetIDsOfNames(GUID_NULL, @wide, 1, 0, @disps)) then + if not Succeeded(TargetObj.GetIDsOfNames(GUID_NULL, @wide, 1, 0, @disps)) + then raise Exception.Create('This object does not support this method'); - pAnswer := @answer; + panswer := @answer; // prepare parameters - for i := 0 to Pred(ParamCount) do + for I := 0 to Pred(ParamCount) do begin - case ParamValues[ParamCount - 1 - i].VType of - vtBoolean: begin - pVarArg^[i].vt := VT_BOOL; - pVarArg^[i].vbool := ParamValues[ParamCount - 1 - i].VBoolean; + case ParamValues[ParamCount - 1 - I].VType of + vtBoolean: + begin + pVarArg^[I].vt := VT_BOOL; + pVarArg^[I].vbool := ParamValues[ParamCount - 1 - I].VBoolean; end; - vtCurrency: begin - pVarArg^[i].vt := VT_CY; - pVarArg^[i].cyVal := ParamValues[ParamCount - 1 - i].VCurrency^; + vtCurrency: + begin + pVarArg^[I].vt := VT_CY; + pVarArg^[I].cyVal := ParamValues[ParamCount - 1 - I].VCurrency^; end; - vtInt64: begin - pVarArg^[i].vt := VT_I8; - PInt64(@pVarArg^[i].cyVal)^ := ParamValues[ParamCount - 1 - i].VInt64^; + vtInt64: + begin + pVarArg^[I].vt := VT_I8; + PInt64(@pVarArg^[I].cyVal)^ := + ParamValues[ParamCount - 1 - I].VInt64^; end; - vtInteger: begin - pVarArg^[i].vt := VT_I4; - pVarArg^[i].lVal := ParamValues[ParamCount - 1 - i].VInteger; + vtInteger: + begin + pVarArg^[I].vt := VT_I4; + pVarArg^[I].lVal := ParamValues[ParamCount - 1 - I].VInteger; end; - vtExtended: begin - pVarArg^[i].vt := VT_R8; - pVarArg^[i].dblVal := ParamValues[ParamCount - 1 - i].VExtended^; + vtExtended: + begin + pVarArg^[I].vt := VT_R8; + pVarArg^[I].dblVal := ParamValues[ParamCount - 1 - I].VExtended^; end; - vtVariant: begin - pVarArg^[i].vt := VT_BYREF or VT_VARIANT; - pVarArg^[i].pvarVal := ParamValues[ParamCount - 1 - i].VVariant; + vtVariant: + begin + pVarArg^[I].vt := VT_BYREF or VT_VARIANT; + pVarArg^[I].pvarVal := ParamValues[ParamCount - 1 - I].VVariant; end; - vtChar: begin - {pVarArg^[i].vt := VT_I1; - pVarArg^[i].cVal := ParamValues[ParamCount - 1 - i].VChar;} - pVarArg^[i].vt := VT_BSTR; - pVarArg^[i].bstrVal := PWideChar(WideString(ParamValues[ParamCount - 1 - i].VChar)); + vtChar: + begin + { pVarArg^[i].vt := VT_I1; + pVarArg^[i].cVal := ParamValues[ParamCount - 1 - i].VChar; } + pVarArg^[I].vt := VT_BSTR; + pVarArg^[I].bstrVal := + PWideChar(Widestring(ParamValues[ParamCount - 1 - I].VChar)); end; - vtWideChar: begin - pVarArg^[i].vt := VT_BSTR; - pVarArg^[i].bstrVal := PWideChar(WideString(ParamValues[ParamCount - 1 - i].VWideChar)); + vtWideChar: + begin + pVarArg^[I].vt := VT_BSTR; + pVarArg^[I].bstrVal := + PWideChar(Widestring(ParamValues[ParamCount - 1 - I].VWideChar)); end; - vtPChar: begin - pVarArg^[i].vt := VT_BSTR; - pVarArg^[i].bstrVal := PWideChar(WideString(ParamValues[ParamCount - 1 - i].VPChar)); + vtPChar: + begin + pVarArg^[I].vt := VT_BSTR; + pVarArg^[I].bstrVal := + PWideChar(Widestring(ParamValues[ParamCount - 1 - I].VPChar)); end; - vtPWideChar: begin - pVarArg^[i].vt := VT_BSTR; - pVarArg^[i].bstrVal := ParamValues[ParamCount - 1 - i].VPWideChar; + vtPWideChar: + begin + pVarArg^[I].vt := VT_BSTR; + pVarArg^[I].bstrVal := ParamValues[ParamCount - 1 - I].VPWideChar; end; - vtAnsiString: begin - pVarArg^[i].vt := VT_BSTR; - pVarArg^[i].bstrVal := PWideChar(WideString(PAnsiChar(ParamValues[ParamCount - 1 - i].VAnsiString))); + vtAnsiString: + begin + pVarArg^[I].vt := VT_BSTR; + pVarArg^[I].bstrVal := + PWideChar(Widestring(PAnsiChar(ParamValues[ParamCount - 1 - I] + .VAnsiString))); end; - vtWideString: begin - pVarArg^[i].vt := VT_BSTR; - pVarArg^[i].bstrVal := PWideChar(WideString(ParamValues[ParamCount - 1 - i].VWideString)); + vtWideString: + begin + pVarArg^[I].vt := VT_BSTR; + pVarArg^[I].bstrVal := + PWideChar(Widestring(ParamValues[ParamCount - 1 - I] + .VWideString)); end; - vtString: begin - pVarArg^[i].vt := VT_BSTR; - pVarArg^[i].bstrVal := PWideChar(WideString(PAnsiChar(ParamValues[ParamCount - 1 - i].VString))); + vtString: + begin + pVarArg^[I].vt := VT_BSTR; + pVarArg^[I].bstrVal := + PWideChar(Widestring(PAnsiChar(ParamValues[ParamCount - 1 - I] + .VString))); end; {$IFDEF UNICODE} - vtUnicodeString: begin - pVarArg^[i].vt := VT_BSTR; - pVarArg^[i].bstrVal := PWideChar(UnicodeString(ParamValues[ParamCount - 1 - i].VUnicodeString)); + vtUnicodeString: + begin + pVarArg^[I].vt := VT_BSTR; + pVarArg^[I].bstrVal := + PWideChar(UnicodeString(ParamValues[ParamCount - 1 - I] + .VUnicodeString)); end; {$ENDIF UNICODE} else - raise Exception.CreateFmt('Unsupported type for Parameter with Index %d', [i]); + raise Exception.CreateFmt + ('Unsupported type for Parameter with Index %d', [I]); end; end; // prepare dispatch parameters - dispparams.rgvarg := pVarArg; - dispparams.rgdispidNamedArgs := nil; - dispparams.cArgs := ParamCount; - dispparams.cNamedArgs := 0; + dispParams.rgvarg := pVarArg; + dispParams.rgdispidNamedArgs := nil; + dispParams.cArgs := ParamCount; + dispParams.cNamedArgs := 0; // make IDispatch call - res := TargetObj.Invoke(disps[0], - GUID_NULL, 0, DISPATCH_METHOD or DISPATCH_PROPERTYGET, - dispParams, pAnswer, @aexception, nil); + Res := TargetObj.Invoke(disps[0], GUID_NULL, 0, DISPATCH_METHOD or + DISPATCH_PROPERTYGET, dispParams, panswer, @aexception, nil); // check the Result - if res <> 0 then - raise Exception.CreateFmt( - 'Method call unsuccessful. %s (%s).', + if Res <> 0 then + raise Exception.CreateFmt('Method call unsuccessful. %s (%s).', [string(aexception.bstrDescription), string(aexception.bstrSource)]); // return the Result Result := answer; finally if ParamCount > 0 then - FreeMem(pVarArg, ParamCount * sizeof(TVariantArg)); + FreeMem(pVarArg, ParamCount * SizeOf(TVariantArg)); end; end; -function ExecScriptEx(WebBrowser: TEmbeddedWB; MethodName: string; ParamValues: array of const): OleVariant; +function ExecScriptEx(WebBrowser: TEmbeddedWB; MethodName: string; + ParamValues: array of const): OleVariant; var - doc: IHTMLDocument2; + Doc: IHTMLDocument2; dScript: IDispatch; begin if WebBrowser.DocumentLoaded(Doc) then begin - dScript := doc.Script; + dScript := Doc.Script; if Assigned(dScript) then - Result := WBExecScript(DScript, MethodName, ParamValues); + Result := WBExecScript(dScript, MethodName, ParamValues); end; end; @@ -3429,27 +3615,27 @@ procedure ExecScript(WebBrowser: TEmbeddedWB; sExpression, sLanguage: string); if Assigned(HTMLWin) then begin try - HTMLWin.execScript(sExpression, sLanguage); + HTMLWin.ExecScript(sExpression, sLanguage); except end; end; end; end; -//To Add-------------------------------------------------- +// To Add-------------------------------------------------- function URLFromShortcut(const dotURL: string): string; begin Result := ''; with TIniFile.Create(dotURL) do - try - Result := ReadString('InternetShortcut', 'URL', ''); - finally - Free; - end; + try + Result := ReadString('InternetShortcut', 'URL', ''); + finally + Free; + end; end; -function ExtractUrl(ShellFolder: IShellFolder; pidl: PItemIDList): string; +function ExtractUrl(ShellFolder: IShellFolder; pidl: PItemIdList): string; var Handle: THandle; Info: IQueryInfo; @@ -3458,13 +3644,14 @@ function ExtractUrl(ShellFolder: IShellFolder; pidl: PItemIDList): string; Handle := 0; Info := nil; Result := ''; - ShellFolder.GetUIObjectOf(Handle, 1, pidl, IID_IQUERYINFO, nil, Pointer(Info)); + ShellFolder.GetUIObjectOf(Handle, 1, pidl, IID_IQUERYINFO, nil, + Pointer(Info)); if Assigned(Info) then begin - Info.GetInfoTip(0, w); + Info.GetInfoTip(0, W); Result := W; end; - Result := Trim(Copy(Result, Pos(#10, Result) + 1, length(Result))); + Result := Trim(Copy(Result, Pos(#10, Result) + 1, Length(Result))); end; function StringToVarArray(const S: string): Variant; @@ -3480,13 +3667,13 @@ function StringToVarArray(const S: string): Variant; function VarArrayToString(const V: Variant): string; var - i, j: Integer; + I, j: Integer; begin if VarIsArray(V) then - for i := 0 to VarArrayHighBound(V, 1) do + for I := 0 to VarArrayHighBound(V, 1) do begin - j := V[i]; - Result := Result + chr(j); + j := V[I]; + Result := Result + Chr(j); end; end; @@ -3496,18 +3683,19 @@ function Encode(const S: string): string; Hex: string; begin for I := 1 to Length(S) do - case S[i] of - ' ': Result := Result + '+'; - 'A'..'Z', 'a'..'z', '*', '@', '.', '_', '-', - '0'..'9', '$', '!', '''', '(', ')': - Result := Result + s[i]; + case S[I] of + ' ': + Result := Result + '+'; + 'A' .. 'Z', 'a' .. 'z', '*', '@', '.', '_', '-', '0' .. '9', '$', '!', + '''', '(', ')': + Result := Result + S[I]; else begin - Hex := IntToHex(ord(S[i]), 2); + Hex := IntToHex(Ord(S[I]), 2); if Length(Hex) = 2 then Result := Result + '%' + Hex else - Result := Result + '%0' + hex; + Result := Result + '%0' + Hex; end; end; end; @@ -3534,16 +3722,16 @@ function IE5_Installed: Boolean; function GetIEVersionMajor: Integer; var - i: Integer; - s: string; + I: Integer; + S: string; begin - s := GetIEVersion; - i := Pos('.', s); + S := GetIEVersion; + I := Pos('.', S); Result := -1; - if i <> 0 then + if I <> 0 then begin try - Result := StrToInt(Copy(s, 1, Pos('.', s) - 1)); + Result := StrToInt(Copy(S, 1, Pos('.', S) - 1)); except Result := -1; end; @@ -3555,9 +3743,9 @@ function GetIEVersion: string; SysDir: PChar; Info: Pointer; InfoData: Pointer; - InfoSize: LongInt; + InfoSize: Longint; Len: DWORD; - FName: Pchar; + Fname: PChar; SystemDir, Infotype: string; LangPtr: Pointer; begin @@ -3570,23 +3758,23 @@ function GetIEVersion: string; FreeMem(SysDir); end; Result := ''; - InfoType := 'FileVersion'; + Infotype := 'FileVersion'; if FileExists(SystemDir + '\ieframe.dll') then - FName := PChar(SystemDir + '\ieframe.dll') + Fname := PChar(SystemDir + '\ieframe.dll') else - FName := PChar(SystemDir + '\shdocvw.dll'); + Fname := PChar(SystemDir + '\shdocvw.dll'); InfoSize := GetFileVersionInfoSize(Fname, Len); if (InfoSize > 0) then begin GetMem(Info, InfoSize); try - if GetFileVersionInfo(FName, Len, InfoSize, Info) then + if GetFileVersionInfo(Fname, Len, InfoSize, Info) then begin Len := 255; if VerQueryValue(Info, '\VarFileInfo\Translation', LangPtr, Len) then - InfoType := Format('\StringFileInfo\%0.4x%0.4x\%s'#0, [LoWord(LongInt(LangPtr^)), - HiWord(LongInt(LangPtr^)), InfoType]); - if VerQueryValue(Info, Pchar(InfoType), InfoData, len) then + Infotype := Format('\StringFileInfo\%0.4x%0.4x\%s'#0, + [LoWord(Longint(LangPtr^)), HiWord(Longint(LangPtr^)), Infotype]); + if VerQueryValue(Info, PChar(Infotype), InfoData, Len) then {$IFDEF UNICODE} Result := Trim(PWideChar(InfoData)); {$ELSE} @@ -3599,12 +3787,12 @@ function GetIEVersion: string; end; end; -function ResolveUrlIni(Filename: string): string; +function ResolveUrlIni(FileName: string): string; var - ini: TiniFile; + ini: TIniFile; begin Result := ''; - ini := TIniFile.Create(Filename); + ini := TIniFile.Create(FileName); try Result := ini.ReadString('InternetShortcut', 'URL', ''); finally @@ -3612,40 +3800,41 @@ function ResolveUrlIni(Filename: string): string; end; end; -function ResolveUrlIntShCut(Filename: string): string; +function ResolveUrlIntShCut(FileName: string): string; var IURL: IUniformResourceLocator; - PersistFile: IPersistfile; - FName: array[0..MAX_PATH] of WideChar; + PersistFile: IPersistFile; + Fname: array [0 .. MAX_PATH] of WideChar; p: PChar; begin - if Succeeded(CoCreateInstance(CLSID_InternetShortcut, nil, CLSCTX_INPROC_SERVER, - IID_IUniformResourceLocator, IURL)) then + if Succeeded(CoCreateInstance(CLSID_InternetShortcut, nil, + CLSCTX_INPROC_SERVER, IID_IUniformResourceLocator, IURL)) then begin - Persistfile := IUrl as IPersistFile; - StringToWideChar(FileName, FName, MAX_PATH); - PersistFile.Load(FName, STGM_READ); - IUrl.GetUrl(@P); - Result := P; + PersistFile := IURL as IPersistFile; + StringToWideChar(FileName, Fname, MAX_PATH); + PersistFile.Load(Fname, STGM_READ); + IURL.GetUrl(@p); + Result := p; end; end; -function ResolveChannel(pFolder: IShellFolder; pidl: PItemIDList; var lpszURL: string): HRESULT; +function ResolveChannel(pFolder: IShellFolder; pidl: PItemIdList; + var lpszURL: string): HRESULT; var - pidlChannel: PItemIDList; + pidlChannel: PItemIdList; psfDesktop: IShellFolder; pShellLink: IShellLink; begin Result := S_FALSE; - if Succeeded(pFolder.GetUIObjectOf(0, 1, pidl, IShellLink, nil, Pointer(pShellLink))) - then + if Succeeded(pFolder.GetUIObjectOf(0, 1, pidl, IShellLink, nil, + Pointer(pShellLink))) then if Succeeded(pShellLink.GetIDList(pidlChannel)) then if Succeeded(SHGetDesktopFolder(psfDesktop)) then begin - lpszURL := getDisplayName(psfDesktop, PidlChannel); + lpszURL := GetDisplayName(psfDesktop, pidlChannel); Result := S_OK; end; - DisposePidl(PidlChannel); + DisposePIDL(pidlChannel); end; function ResolveLink(const Path: string): string; @@ -3653,22 +3842,24 @@ function ResolveLink(const Path: string): string; link: IShellLink; storage: IPersistFile; filedata: TWin32FindData; - buf: array[0..MAX_PATH] of Char; - widepath: WideString; + Buf: array [0 .. MAX_PATH] of Char; + widepath: Widestring; begin - OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IShellLink, link)); + OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, + IShellLink, link)); OleCheck(link.QueryInterface(IPersistFile, storage)); - widepath := path; + widepath := Path; Result := ''; if Succeeded(storage.Load(@widepath[1], STGM_READ)) then if Succeeded(link.Resolve(GetActiveWindow, SLR_NOUPDATE)) then - if Succeeded(link.GetPath(buf, SizeOf(buf), filedata, SLGP_UNCPRIORITY)) then - Result := buf; + if Succeeded(link.GetPath(Buf, SizeOf(Buf), filedata, SLGP_UNCPRIORITY)) + then + Result := Buf; storage := nil; link := nil; end; -function IsFolder(ShellFolder: IShellFolder; ID: PItemIDList): Boolean; +function IsFolder(ShellFolder: IShellFolder; ID: PItemIdList): Boolean; var Flags: UINT; begin @@ -3677,135 +3868,139 @@ function IsFolder(ShellFolder: IShellFolder; ID: PItemIDList): Boolean; Result := SFGAO_FOLDER and Flags <> 0; end; -function IsChannel(ChannelShortcut: string; ShellFolder: IShellFolder; ID: PItemIDList): Boolean; +function IsChannel(ChannelShortcut: string; ShellFolder: IShellFolder; + ID: PItemIdList): Boolean; var FileInfo: TShFileInfo; begin - SHGetFileInfo(Pchar(ID), 0, FileInfo, SizeOf(TSHFileInfo), SHGFI_PIDL or SHGFI_TYPENAME); - Result := BOOL(fileinfo.szTypeName = ChannelShortcut); + SHGetFileInfo(PChar(ID), 0, FileInfo, SizeOf(TShFileInfo), + SHGFI_PIDL or SHGFI_TYPENAME); + Result := BOOL(FileInfo.szTypeName = ChannelShortcut); end; -function IsFolderEx(ChannelShortcut: string; ShellFolder: IShellFolder; ID: PItemIDList): Boolean; +function IsFolderEx(ChannelShortcut: string; ShellFolder: IShellFolder; + ID: PItemIdList): Boolean; var Flags: UINT; begin Flags := SFGAO_FOLDER; ShellFolder.GetAttributesOf(1, ID, Flags); if SFGAO_FOLDER and Flags <> 0 then - Result := not isChannel(ChannelShortcut, Shellfolder, id) + Result := not IsChannel(ChannelShortcut, ShellFolder, ID) else Result := False; end; -function GetImageIndex(pidl: PItemIDList): Integer; +function GetImageIndex(pidl: PItemIdList): Integer; var Flags: UINT; - FileInfo: TSHFileInfo; + FileInfo: TShFileInfo; begin Flags := SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_ICON or SHGFI_SMALLICON; - if SHGetFileInfo(PChar(pidl), 0, FileInfo, SizeOf(TSHFileInfo), Flags) = 0 then + if SHGetFileInfo(PChar(pidl), 0, FileInfo, SizeOf(TShFileInfo), Flags) = 0 + then Result := -1 else Result := FileInfo.iIcon; end; -{function GetDisplayName(Folder: IShellFolder; pidl: PItemIDList): string; -var +{ function GetDisplayName(Folder: IShellFolder; pidl: PItemIDList): string; + var StrRet: TStrRet; -begin + begin Result := ''; Folder.GetDisplayNameOf(pidl, SHGDN_NORMAL, StrRet); case StrRet.uType of - STRRET_CSTR: - SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr)); - STRRET_OFFSET: - Result := Pchar(@pidl.mkid.abID[StrRet.uOffset - SizeOf(pidl.mkid.cb)]); - STRRET_WSTR: - Result := StrRet.pOleStr; + STRRET_CSTR: + SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr)); + STRRET_OFFSET: + Result := Pchar(@pidl.mkid.abID[StrRet.uOffset - SizeOf(pidl.mkid.cb)]); + STRRET_WSTR: + Result := StrRet.pOleStr; end; -end; } + end; } -function GetDisplayName(Folder: IShellFolder; PIDL: PItemIDList): string; +function GetDisplayName(Folder: IShellFolder; pidl: PItemIdList): string; var StrRet: TStrRet; - P: PChar; + p: PChar; Flags: Integer; begin Result := ''; Flags := SHGDN_NORMAL; - Folder.GetDisplayNameOf(PIDL, Flags, StrRet); + Folder.GetDisplayNameOf(pidl, Flags, StrRet); case StrRet.uType of STRRET_CSTR: SetString(Result, StrRet.cStr, lStrLenA(StrRet.cStr)); STRRET_OFFSET: begin - P := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)]; - SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset); + p := @pidl.mkid.abID[StrRet.uOffset - SizeOf(pidl.mkid.cb)]; + SetString(Result, p, pidl.mkid.cb - StrRet.uOffset); end; STRRET_WSTR: Result := StrRet.pOleStr; end; end; -{function GetFileName(Folder: IShellFolder; pidl: PItemIDList): string; -var +{ function GetFileName(Folder: IShellFolder; pidl: PItemIDList): string; + var StrRet: TStrRet; -begin + begin Folder.GetDisplayNameOf(pidl, SHGDN_FORPARSING, StrRet); case StrRet.uType of - STRRET_CSTR: - SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr)); - STRRET_OFFSET: - Result := Pchar(@pidl.mkid.abID[StrRet.uOffset - SizeOf(pidl.mkid.cb)]); - STRRET_WSTR: - Result := StrRet.pOleStr; + STRRET_CSTR: + SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr)); + STRRET_OFFSET: + Result := Pchar(@pidl.mkid.abID[StrRet.uOffset - SizeOf(pidl.mkid.cb)]); + STRRET_WSTR: + Result := StrRet.pOleStr; end; -end; } + end; } -function GetFileName(Folder: IShellFolder; pidl: PItemIDList): string; +function GetFileName(Folder: IShellFolder; pidl: PItemIdList): string; var StrRet: TStrRet; - P: PChar; + p: PChar; begin Result := ''; - Folder.GetDisplayNameOf(PIDL, SHGDN_FORPARSING, StrRet); + Folder.GetDisplayNameOf(pidl, SHGDN_FORPARSING, StrRet); case StrRet.uType of STRRET_CSTR: SetString(Result, StrRet.cStr, lStrLenA(StrRet.cStr)); STRRET_OFFSET: begin - P := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)]; - SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset); + p := @pidl.mkid.abID[StrRet.uOffset - SizeOf(pidl.mkid.cb)]; + SetString(Result, p, pidl.mkid.cb - StrRet.uOffset); end; STRRET_WSTR: Result := StrRet.pOleStr; end; end; -procedure DisposePIDL(ID: PItemIDList); +procedure DisposePIDL(ID: PItemIdList); var Malloc: IMalloc; begin if ID <> nil then begin - OLECheck(SHGetMalloc(Malloc)); + OleCheck(SHGetMalloc(Malloc)); Malloc.Free(ID); end; end; -function CopyITEMID(Malloc: IMalloc; ID: PItemIDList): PItemIDList; +function CopyITEMID(Malloc: IMalloc; ID: PItemIdList): PItemIdList; begin Result := Malloc.Alloc(ID^.mkid.cb + SizeOf(ID^.mkid.cb)); CopyMemory(Result, ID, ID^.mkid.cb + SizeOf(ID^.mkid.cb)); end; -function NextPIDL(IDList: PItemIDList): PItemIDList; +function NextPIDL(IDList: PItemIdList): PItemIdList; begin Result := IDList; Inc(PAnsiChar(Result), IDList^.mkid.cb); end; -function GetPIDLSize(IDList: PItemIDList): Integer; +function GetPIDLSize(IDList: PItemIdList): Integer; begin Result := 0; if Assigned(IDList) then @@ -3819,9 +4014,9 @@ function GetPIDLSize(IDList: PItemIDList): Integer; end; end; -procedure StripLastID(IDList: PItemIDList); +procedure StripLastID(IDList: PItemIdList); var - MarkerID: PItemIDList; + MarkerID: PItemIdList; begin MarkerID := IDList; if Assigned(IDList) then @@ -3835,10 +4030,10 @@ procedure StripLastID(IDList: PItemIDList); end; end; -function CreatePIDL(Size: Integer): PItemIDList; +function CreatePIDL(Size: Integer): PItemIdList; var Malloc: IMalloc; - HR: HResult; + HR: HRESULT; begin Result := nil; HR := SHGetMalloc(Malloc); @@ -3852,7 +4047,7 @@ function CreatePIDL(Size: Integer): PItemIDList; end; end; -function CopyPIDL(IDList: PItemIDList): PItemIDList; +function CopyPIDL(IDList: PItemIdList): PItemIdList; var Size: Integer; begin @@ -3862,7 +4057,7 @@ function CopyPIDL(IDList: PItemIDList): PItemIDList; CopyMemory(Result, IDList, Size); end; -function ConcatPIDLs(IDList1, IDList2: PItemIDList): PItemIDList; +function ConcatPIDLs(IDList1, IDList2: PItemIdList): PItemIdList; var cb1, cb2: Integer; begin @@ -3880,7 +4075,7 @@ function ConcatPIDLs(IDList1, IDList2: PItemIDList): PItemIDList; end; end; -function DeleteUrl(Url: PWideChar): HResult; +function DeleteUrl(Url: PWideChar): HRESULT; begin Result := DeleteUrl(Url); end; @@ -3889,7 +4084,7 @@ function GetMailClients: TStrings; var Reg: TRegistry; ts: TStrings; - i: Integer; + I: Integer; begin ts := TStringList.Create; Reg := TRegistry.Create; @@ -3902,8 +4097,8 @@ function GetMailClients: TStrings; begin GetKeyNames(ts); CloseKey; - for i := 0 to ts.Count - 1 do - OpenKey(RegMail + ts.Strings[i], False); + for I := 0 to ts.Count - 1 do + OpenKey(RegMail + ts.Strings[I], False); end; Result := ts; finally @@ -3913,7 +4108,4 @@ function GetMailClients: TStrings; end; end; - - end. - diff --git a/Source/EwbUrl.pas b/Source/EwbUrl.pas index e885540..5a40a58 100644 --- a/Source/EwbUrl.pas +++ b/Source/EwbUrl.pas @@ -177,7 +177,7 @@ TUrl = class implementation uses - EwbCoreTools, SysUtils, Forms, IEConst; + EwbCoreTools, SysUtils, Forms, EWB.IEConst; constructor TUrl.Create(const Url: string); begin @@ -276,7 +276,7 @@ procedure TUrl.FillUrlComponent; if (FPort = 0) then nPort := FPort; {$IFDEF DELPHI6_UP} - pad := 1; //force correct allignment regardless of comp. flags + //pad := 1; //force correct allignment regardless of comp. flags {$ENDIF} end; end; diff --git a/Source/ExportFavorites.pas b/Source/ExportFavorites.pas index bd958f1..4e92155 100644 --- a/Source/ExportFavorites.pas +++ b/Source/ExportFavorites.pas @@ -145,7 +145,7 @@ TExportFavorite = class(TComponent) implementation uses - Windows, SysUtils, {$IFDEF DELPHI5}EwbCoreTools, {$ENDIF}Registry, Forms, IEConst; + Windows, SysUtils, {$IFDEF DELPHI5}EwbCoreTools, {$ENDIF}Registry, Forms, EWB.IEConst; constructor TExportFavorite.Create; begin diff --git a/Source/FavoritesTree.pas b/Source/FavoritesTree.pas index c8d5534..d6cc219 100644 --- a/Source/FavoritesTree.pas +++ b/Source/FavoritesTree.pas @@ -43,7 +43,7 @@ interface {$I EWB.inc} uses - ShlObj, Messages, Windows, SysUtils, Classes, Forms, ComCtrls, DIRMonitor, + ShlObj, Messages, Windows, SysUtils, Classes, Forms, ComCtrls, iniFiles, EmbeddedWB, EwbCore, Controls, Imglist, ExportFavorites, ImportFavorites, EwbAcc, EWBTools; diff --git a/Source/FileExtAssociate.pas b/Source/FileExtAssociate.pas index 2bd727e..f635abd 100644 --- a/Source/FileExtAssociate.pas +++ b/Source/FileExtAssociate.pas @@ -179,7 +179,7 @@ TFileExtAssociate = class(TComponent) implementation uses - ShellAPI, SysUtils, ActiveX, Registry, ShlObj, ComObj, IEConst; + ShellAPI, SysUtils, ActiveX, Registry, ShlObj, ComObj, EWB.IEConst; // ExtensionAssociate=========================================================== diff --git a/Source/IEAddress.pas b/Source/IEAddress.pas index 2e27828..a1a5368 100644 --- a/Source/IEAddress.pas +++ b/Source/IEAddress.pas @@ -386,7 +386,7 @@ TIEAddress = class(TCustomIEAddress) implementation uses - ComObj, UrlMon, ImgList, ShellAPI, Forms, SysUtils, Registry, IEConst, EwbCoreTools; + ComObj, UrlMon, ImgList, ShellAPI, Forms, SysUtils, Registry, EWB.IEConst; function TEnumString.Clone(out enm: IEnumString): HResult; begin @@ -503,6 +503,8 @@ function StrToCase(StringOf: string; CasesList: array of string): Integer; end; function GetSpecialFolderNo(bUrl: WideString): Cardinal; +const + CSIDL_PROFILES = $3E; var Url: string; begin @@ -1823,7 +1825,7 @@ procedure TCustomIEAddress.KeyDown(var Key: Word; Shift: TShiftState); if FListIndex >= 24 then Exit; PostMessage(Handle, CB_SETCURSEL, (FListIndex + 1), 0); - PostMessage(EditHandle, EM_SETSEL, -1, 0); + PostMessage(EditHandle, EM_SETSEL, WPARAM(-1), 0); FSelImageIndex := FImageIndex; FImageList.Draw(FCanvas, 4, 3, FSelImageIndex, True); if FNavOnSelected and Assigned(FEmbeddedWB) then @@ -1838,7 +1840,7 @@ procedure TCustomIEAddress.KeyDown(var Key: Word; Shift: TShiftState); if FListIndex <= 0 then Exit; PostMessage(Handle, CB_SETCURSEL, (FListIndex - 1), 0); - PostMessage(EditHandle, EM_SETSEL, -1, 0); + PostMessage(EditHandle, EM_SETSEL, WPARAM(-1), 0); FSelImageIndex := FImageIndex; FImageList.Draw(FCanvas, 4, 3, FSelImageIndex, True); if FNavOnSelected and Assigned(FEmbeddedWB) then @@ -1867,7 +1869,7 @@ procedure TCustomIEAddress.KeyDown(var Key: Word; Shift: TShiftState); Key := VK_CLEAR; PostMessage(Handle, CB_GETCURSEL, 0, 0); // PostMessage(EditHandle, EM_SETREADONLY, 1, 0); - PostMessage(EditHandle, EM_SETSEL, -1, 0); + PostMessage(EditHandle, EM_SETSEL, WPARAM(-1), 0); PostMessage(Handle, CB_SHOWDROPDOWN, 1, 0); if FNavOnSelected and Assigned(FEmbeddedWB) then FEmbeddedWB.Go(Text); diff --git a/Source/IECache.pas b/Source/IECache.pas index d54a6c0..d690193 100644 --- a/Source/IECache.pas +++ b/Source/IECache.pas @@ -47,7 +47,7 @@ interface {$I EWB.inc} uses - WinInet, Windows, Messages, SysUtils, Classes, IeConst; + WinInet, Windows, Messages, SysUtils, Classes, EWB.IeConst; type PInternetCacheTimeStamps = ^TInternetCacheTimeStamps; diff --git a/Source/IEDownload.pas b/Source/IEDownload.pas index b51b487..1ccd0fc 100644 --- a/Source/IEDownload.pas +++ b/Source/IEDownload.pas @@ -1,60 +1,58 @@ -//************************************************************************* -// * -// IEDownload 2010 * -// IEDownload is a UrlMon wrapper with a build-in Callback * -// * -// Freeware Component * -// for Delphi by * -// Eran Bodankin * -// and Per Linds Larsen * -// * -// * -// Updated versions: * -// http://www.bsalsa.com * -//************************************************************************* -{LICENSE: -THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, -EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED -WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. -YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE -AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE -AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE -OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED -OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, -INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR -OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, -AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY -DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. - -You may use, change or modify the component under 4 conditions: -1. In your website, add a link to "http://www.bsalsa.com" -2. In your application, add credits to "Embedded Web Browser" -3. Mail me (bsalsa@gmail.com) any code change in the unit - for the benefit of the other users. -4. Please, consider donation in our web site! -{*******************************************************************************} -//$Id: IEDownload.pas,v 1.6 2009/02/25 11:56:31 bsalsa Exp $ +// ************************************************************************* +// * +// IEDownload 2010 * +// IEDownload is a UrlMon wrapper with a build-in Callback * +// * +// Freeware Component * +// for Delphi by * +// Eran Bodankin * +// and Per Linds Larsen * +// * +// * +// Updated versions: * +// http://www.bsalsa.com * +// ************************************************************************* +{ LICENSE: + THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, + EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED + WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. + YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE + AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE + AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE + OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED + OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, + INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR + OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, + AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY + DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. + + You may use, change or modify the component under 4 conditions: + 1. In your website, add a link to "http://www.bsalsa.com" + 2. In your application, add credits to "Embedded Web Browser" + 3. Mail me (bsalsa@gmail.com) any code change in the unit + for the benefit of the other users. + 4. Please, consider donation in our web site! + {******************************************************************************* } +// $Id: IEDownload.pas,v 1.6 2009/02/25 11:56:31 bsalsa Exp $ unit IEDownload; -{To use the MSHTML, just remove the dot in the line below like {$DEFINE USE_MSHTML}{ -and re-compile the package.} +{ To use the MSHTML, just remove the dot in the line below like {$DEFINE USE_MSHTML }{ + and re-compile the package. } {$DEFINE USE_MSHTML} interface {$I EWB.inc} - {$IFDEF DELPHI6_UP} {$WARN SYMBOL_PLATFORM OFF} {$ENDIF} - {$IFDEF DELPHI7_UP} {$WARN SYMBOL_DEPRECATED OFF} {$ENDIF} uses - Dialogs, IEDownloadAcc, Controls, Shellapi, IEConst, ActiveX, + Dialogs, IEDownloadAcc, Controls, Shellapi, EWB.IEConst, ActiveX, Contnrs, ExtCtrls, Windows, WinInet, UrlMon, Classes, SysUtils {$IFDEF DELPHI5}, FileCtrl{$ENDIF}{$IFDEF USE_MSHTML}, MSHTML_EWB{$ENDIF}; @@ -62,6 +60,7 @@ interface WAIT_BSCB = WAIT_OBJECT_0 + 1; {$IFNDEF UNICODE} + type RawByteString = AnsiString; {$ENDIF UNICODE} @@ -121,26 +120,17 @@ TInfoData = class(TList) TThreadStatus = (tsRunning, tsSuspended, tsWaiting, tsTerminated); TState = (sBusy, sReady, sStopped); - TBSCB = class(TThread, - IAuthenticate, + TBSCB = class(TThread, IAuthenticate, {$IFDEF DELPHI6_UP} - IAuthenticateEx, - IMonikerProp, + IAuthenticateEx, IMonikerProp, {$ENDIF} - IBindHost, - IWindowForBindingUI, - IBindStatusCallback, - IBindStatusCallbackEx, - ICodeInstall, - IHttpNegotiate, - IHttpNegotiate2, - IHttpNegotiate3, - IHTTPSecurity, + IBindHost, IWindowForBindingUI, IBindStatusCallback, IBindStatusCallbackEx, + ICodeInstall, IHttpNegotiate, IHttpNegotiate2, IHttpNegotiate3, + IHTTPSecurity, {$IFDEF USE_MSHTML} - IPropertyNotifySink, + IPropertyNotifySink, {$ENDIF} - IServiceProvider, - IUnknown) + IServiceProvider, IUnknown) private Frequency: Int64; @@ -159,87 +149,82 @@ TBSCB = class(TThread, m_pPrevBSCB: IBindStatusCallback; fsOutputFile: TFileStream; - function GetSerializedClientCertContext(out ppbCert: Byte; var pcbCert: - DWORD): HResult; stdcall; + function GetSerializedClientCertContext(out ppbCert: Byte; + var pcbCert: DWORD): HResult; stdcall; {$IFDEF DELPHI6_UP} - function AuthenticateEx(out phwnd: HWND; out pszUsername, - pszPassword: LPWSTR; var pauthinfo: AUTHENTICATEINFO): HResult; stdcall; - {IMonikerProp Interface} - function PutProperty(mkp: MONIKERPROPERTY; val: LPCWSTR): HResult; - stdcall; + function AuthenticateEx(out phwnd: HWND; + out pszUsername, pszPassword: LPWSTR; var pauthinfo: AUTHENTICATEINFO) + : HResult; stdcall; + { IMonikerProp Interface } + function PutProperty(mkp: MONIKERPROPERTY; val: LPCWSTR): HResult; stdcall; {$ENDIF} - - {IBindStatusCallbackEx} + { IBindStatusCallbackEx } function GetBindInfoEx(out grfBINDF: DWORD; var pbindinfo: BINDINFO; out grfBINDF2: DWORD; out pdwReserved: DWORD): HResult; stdcall; {$IFDEF USE_MSHTML} - {IPropertyNotifySink Interface} - function OnChanged(dispId: TDispId): HRESULT; stdcall; - function OnRequestEdit(dispId: TDispId): HRESULT; stdcall; + { IPropertyNotifySink Interface } + function OnChanged(dispId: TDispId): HResult; stdcall; + function OnRequestEdit(dispId: TDispId): HResult; stdcall; {$ENDIF} - - {IHttpNegotiate2 Interface} - function GetRootSecurityId(var SecurityIdBuffer: TByteArray; var - BufferSize: DWord; dwReserved: DWORD): HResult; stdcall; - - {IBindStatusCallback Interface} - function GetBindInfo(out grfBINDF: DWORD; var BindInfo: TBindInfo): HRESULT; - stdcall; - function GetPriority(out nPriority): HRESULT; stdcall; - function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; FormatEtc: - PFormatEtc; stgmed: PStgMedium): HRESULT; stdcall; - function OnLowResource(Reserved: DWORD): HRESULT; stdcall; + { IHttpNegotiate2 Interface } + function GetRootSecurityId(var SecurityIdBuffer: TByteArray; + var BufferSize: DWORD; dwReserved: DWORD): HResult; stdcall; + + { IBindStatusCallback Interface } + function GetBindInfo(out grfBINDF: DWORD; var BINDINFO: TBindInfo) + : HResult; stdcall; + function GetPriority(out nPriority): HResult; stdcall; + function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; + FormatEtc: PFormatEtc; stgmed: PStgMedium): HResult; stdcall; + function OnLowResource(Reserved: DWORD): HResult; stdcall; function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; - szStatusText: LPCWSTR): HRESULT; stdcall; - function OnObjectAvailable(const IID: TGUID; punk: IUnknown): HRESULT; - stdcall; - function OnStartBinding(dwReserved: DWORD; pib: IBinding): HRESULT; stdcall; - function OnStopBinding(HRESULT: HRESULT; szError: LPCWSTR): HRESULT; - stdcall; - function OnSecurityProblem(dwProblem: DWORD): HRESULT; stdcall; - - {IHTTPNegotiate methods} - function OnResponse(dwResponseCode: DWORD; szResponseHeaders, - szRequestHeaders: LPCWSTR; - out szAdditionalRequestHeaders: LPWSTR): HRESULT; stdcall; + szStatusText: LPCWSTR): HResult; stdcall; + function OnObjectAvailable(const IID: TGUID; punk: IUnknown) + : HResult; stdcall; + function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall; + function OnStopBinding(HResult: HResult; szError: LPCWSTR) + : HResult; stdcall; + function OnSecurityProblem(dwProblem: DWORD): HResult; stdcall; + + { IHTTPNegotiate methods } + function OnResponse(dwResponseCode: DWORD; + szResponseHeaders, szRequestHeaders: LPCWSTR; + out szAdditionalRequestHeaders: LPWSTR): HResult; stdcall; function BeginningTransaction(szURL, szHeaders: LPCWSTR; dwReserved: DWORD; - out szAdditionalHeaders: LPWSTR): HRESULT; stdcall; + out szAdditionalHeaders: LPWSTR): HResult; stdcall; - {IUnknown Interface} - function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall; + { IUnknown Interface } + function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; function _AddRef: Integer; stdcall; function _Release: Integer; stdcall; - {IWindowForBindingUI methods} - function GetWindow(const GUIDReason: TGUID; out hwnd): HRESULT; stdcall; + { IWindowForBindingUI methods } + function GetWindow(const GUIDReason: TGUID; out HWND): HResult; stdcall; - {IAuthenticate Interface} - function Authenticate(var hwnd: HWnd; var szUserName, szPassWord: LPWSTR): - HResult; stdcall; + { IAuthenticate Interface } + function Authenticate(var HWND: HWND; var szUserName, szPassWord: LPWSTR) + : HResult; stdcall; - {ICodeInstall Interface} - function OnCodeInstallProblem(ulStatusCode: ULONG; szDestination, szSource: - LPCWSTR; - dwReserved: DWORD): HResult; stdcall; + { ICodeInstall Interface } + function OnCodeInstallProblem(ulStatusCode: ULONG; + szDestination, szSource: LPCWSTR; dwReserved: DWORD): HResult; stdcall; - {IBindHost Interface} + { IBindHost Interface } function CreateMoniker(szName: POLEStr; BC: IBindCtx; out mk: IMoniker; dwReserved: DWORD): HResult; stdcall; - function MonikerBindToStorage(Mk: IMoniker; BC: IBindCtx; BSC: - IBindStatusCallback; - const iid: TGUID; out pvObj{$IFNDEF DELPHI8_UP}: Pointer{$ENDIF}): HResult; - stdcall; - function MonikerBindToObject(Mk: IMoniker; BC: IBindCtx; BSC: - IBindStatusCallback; - const iid: TGUID; out pvObj{$IFNDEF DELPHI8_UP}: Pointer{$ENDIF}): HResult; - stdcall; - - {IServiceProvider Interface} - function QueryService(const rsid, iid: TGUID; out Obj): HRESULT; stdcall; + function MonikerBindToStorage(mk: IMoniker; BC: IBindCtx; + BSC: IBindStatusCallback; const IID: TGUID; + out pvObj{$IFNDEF DELPHI8_UP}: Pointer{$ENDIF}): HResult; stdcall; + function MonikerBindToObject(mk: IMoniker; BC: IBindCtx; + BSC: IBindStatusCallback; const IID: TGUID; + out pvObj{$IFNDEF DELPHI8_UP}: Pointer{$ENDIF}): HResult; stdcall; + + { IServiceProvider Interface } + function QueryService(const rsid, IID: TGUID; out Obj): HResult; stdcall; function GetBindResult(out clsidProtocol: TCLSID; out dwResult: DWORD; - out szResult: POLEStr): HRESULT; + out szResult: POLEStr): HResult; private function CheckCancelState: Integer; procedure ClearAll; @@ -263,9 +248,9 @@ TBSCB = class(TThread, BscbInfo: TInfoData; ThreadStatus: TThreadStatus; constructor Create(aSender: TCustomIEDownload; const pmk: IMoniker; - const pbc: IBindCtx; CreateSuspended: boolean); + const pbc: IBindCtx; CreateSuspended: Boolean); destructor Destroy; override; - function QueryInfoFileName: HRESULT; + function QueryInfoFileName: HResult; function DoSaveFileAs: string; function QueryInfo(dwOption: DWORD; var Info: Cardinal): Boolean; overload; function QueryInfo(dwOption: DWORD; var Info: string): Boolean; overload; @@ -273,11 +258,11 @@ TBSCB = class(TThread, function IsRunning: Boolean; function GetDisplayName: PWideChar; function GetFileNameFromUrl(Url: string): string; - function AbortBinding: Hresult; + function AbortBinding: HResult; function MkParseDisplayName(var DisplayName: PWideChar): IMoniker; end; - TBSCBList = class(TObjectList) {by Jury Gerasimov} + TBSCBList = class(TObjectList) { by Jury Gerasimov } private function GetItem(Index: Integer): TBSCB; procedure SetItem(Index: Integer; Value: TBSCB); @@ -294,7 +279,7 @@ TSecurity = class(TPersistent) FInheritHandle: Boolean; FDescriptor: RawByteString; published - property InheritHandle: boolean read FInheritHandle write FInheritHandle + property InheritHandle: Boolean read FInheritHandle write FInheritHandle default False; property Descriptor: RawByteString read FDescriptor write FDescriptor; end; @@ -307,14 +292,14 @@ TRange = class(TPersistent) property RangeBegin: Integer read FRangeBegin write FRangeBegin default 0; property RangeEnd: Integer read FRangeEnd write FRangeEnd default 0; end; - {http://msdn.microsoft.com/en-us/library/ms775130(VS.85).aspx} + + { http://msdn.microsoft.com/en-us/library/ms775130(VS.85).aspx } TBindF = (Asynchronous, AsyncStorage, NoProgressiveRendering, OfflineOperation, GetNewestVersion, NoWriteCache, NeedFile, PullData, IgnoreSecurityProblem, Resynchronize, AllowHyperlink, No_UI, - SilentOperation, Pragma_No_Cache, GetClassObject, Reserved_1, - Free_Threaded, DirectReadIgnoreSize, HandleAsFormsSubmit, - GetFromCacheIfNetFail, FromUrlmon, FisrtTryCache, PreferDefaultHandler, - RestrictedSitesZone); + SilentOperation, Pragma_No_Cache, GetClassObject, Reserved_1, Free_Threaded, + DirectReadIgnoreSize, HandleAsFormsSubmit, GetFromCacheIfNetFail, + FromUrlmon, FisrtTryCache, PreferDefaultHandler, RestrictedSitesZone); TBindF_Options = set of TBindF; TBindF2 = (DisableBasicAuth, DisableAutoCookie, DisableRedirectUnlessSID, ReadDataOver4GB, Reserved_2, Reserved_11); @@ -322,98 +307,95 @@ TRange = class(TPersistent) TBindInfoF = (PostData, ExtraInfo); TBindInfoF_Options = set of TBindInfoF; TBindInfoOption = (UseBindInfoOptions, EnableUtf8, DisableUtf8, - UseIE_Encoding, - BindToObject, SecurityOptOut, IgnoreMimeTextPlain, UseBindStrCredentials, - IgnoreHttp2HttpsRedirect, IgnoreSslErrOnce, WpcDownloadBlocked, - WpcLoggingEnabled, - DisableAutoRedirect, ShDocVw_Reserved, AllowConnectMessages); + UseIE_Encoding, BindToObject, SecurityOptOut, IgnoreMimeTextPlain, + UseBindStrCredentials, IgnoreHttp2HttpsRedirect, IgnoreSslErrOnce, + WpcDownloadBlocked, WpcLoggingEnabled, DisableAutoRedirect, + ShDocVw_Reserved, AllowConnectMessages); TBindInfoOptions_Options = set of TBindInfoOption; TBindVerb = (Get, Post, Put, Custom); - TCodePageOption = ( - Ansi, {default to ANSI code page} - OEM, {default to OEM code page} - Mac, {default to MAC code page} - ThreadsAnsi, {Current thread's ANSI code page} - Symbol, {Symbol code page (42)} - UTF7, {Translate using UTF-7} - UTF8); {Translate using UTF-8} + TCodePageOption = (Ansi, { default to ANSI code page } + OEM, { default to OEM code page } + Mac, { default to MAC code page } + ThreadsAnsi, { Current thread's ANSI code page } + Symbol, { Symbol code page (42) } + UTF7, { Translate using UTF-7 } + UTF8); { Translate using UTF-8 } TDownloadTo = (dtNormal, dtDownloadToFile, dtDownloadToCache, dtMoniker); - TDownloadMethod = (dmStream, dmFile); {Set download to a file or astream} - TFileExistsOption = (feOverWrite, feSkip, feRename); {If file exsits then..} + TDownloadMethod = (dmStream, dmFile); { Set download to a file or astream } + TFileExistsOption = (feOverWrite, feSkip, feRename); { If file exsits then.. } - TQueryInterfaceEvent = function(const IID: TGUID; out Obj): HRESULT of object; - TAuthenticateEvent = procedure(Sender: TBSCB; var tmpHWND: HWnd; - var szUserName, szPassWord: WideString; var Rezult: HRESULT) of object; + TQueryInterfaceEvent = function(const IID: TGUID; out Obj): HResult of object; + TAuthenticateEvent = procedure(Sender: TBSCB; var tmpHWND: HWND; + var szUserName, szPassWord: WideString; var Rezult: HResult) of object; {$IFDEF DELPHI6_UP} - TAuthenticateExEvent = procedure(Sender: TBSCB; var tmpHWND: HWnd; + TAuthenticateExEvent = procedure(Sender: TBSCB; var tmpHWND: HWND; var szUserName, szPassWord: WideString; pauthinfo: AUTHENTICATEINFO; - var Rezult: HRESULT) of object; - TOnPutPropertyEvent = function(Sender: TBSCB; mkp: MONIKERPROPERTY; val: - LPCWSTR): HResult of object; + var Rezult: HResult) of object; + TOnPutPropertyEvent = function(Sender: TBSCB; mkp: MONIKERPROPERTY; + val: LPCWSTR): HResult of object; {$ENDIF} - TOnCodeInstallProblemEvent = function(Sender: TBSCB; ulStatusCode: ULONG; - szDestination, szSource: LPCWSTR; - dwReserved: DWORD; stResult: string): HRESULT of object; + szDestination, szSource: LPCWSTR; dwReserved: DWORD; stResult: string) + : HResult of object; TStateChangeEvent = procedure(const State: TState) of object; - TErrorEvent = procedure(const ErrorCode: integer; const - stError: string) of object; - TOnConnectEvent = procedure(Sender: TBSCB; Res: HRESULT; stMessage: string) of - object; - TOnGetBindInfoEvent = function(Sender: TBSCB; out grfBINDF: DWORD; var - BindInfo: TBindInfo): HRESULT of object; + TErrorEvent = procedure(const ErrorCode: Integer; const stError: string) + of object; + TOnConnectEvent = procedure(Sender: TBSCB; Res: HResult; stMessage: string) + of object; + TOnGetBindInfoEvent = function(Sender: TBSCB; out grfBINDF: DWORD; + var BINDINFO: TBindInfo): HResult of object; TOnGetBindInfoExEvent = function(Sender: TBSCB; out grfBINDF: DWORD; - pbindinfo: BINDINFO; - out grfBINDF2: DWORD): HRESULT of object; - TRedirect = procedure(Sender: TBSCB; var AbortRedirect: boolean; const - FromUrl: string; const DestUrl: string) of object; - TBeginningTransactionEvent = function(Sender: TBSCB; szURL, szHeaders: - LPCWSTR; dwReserved: DWORD; - out szAdditionalHeaders: LPWSTR): HRESULT of object; + pbindinfo: BINDINFO; out grfBINDF2: DWORD): HResult of object; + TRedirect = procedure(Sender: TBSCB; var AbortRedirect: Boolean; + const FromUrl: string; const DestUrl: string) of object; + TBeginningTransactionEvent = function(Sender: TBSCB; + szURL, szHeaders: LPCWSTR; dwReserved: DWORD; + out szAdditionalHeaders: LPWSTR): HResult of object; TOnResponseEvent = function(Sender: TBSCB; dwResponseCode: DWORD; szResponseHeaders, szRequestHeaders: LPCWSTR; - out szAdditionalRequestHeaders: LPWSTR): HRESULT of object; - TOnSecurityProblemEvent = function(Sender: TBSCB; dwProblem: DWORD; Problem: - string): HRESULT of object; - TFileExistsEvent = procedure(var Action: TFileExistsOption; const aFileName: - WideString; var NewFileName: WideString) of object; + out szAdditionalRequestHeaders: LPWSTR): HResult of object; + TOnSecurityProblemEvent = function(Sender: TBSCB; dwProblem: DWORD; + Problem: string): HResult of object; + TFileExistsEvent = procedure(var Action: TFileExistsOption; + const aFileName: WideString; var NewFileName: WideString) of object; TOnProgressEvent = procedure(Sender: TBSCB; ulProgress, ulProgressMax, - ulStatusCode, FileSize: ULONG; szStatusText: LPCWSTR; Downloaded, - ElapsedTime, Speed, RemainingTime, Status, Percent: string) of object; - TOnDataAvailableEvent = procedure(Sender: TBSCB; var Buffer: PByte; var - BufLength: Cardinal) of object; + ulStatusCode, FileSize: ULONG; szStatusText: LPCWSTR; + Downloaded, ElapsedTime, Speed, RemainingTime, Status, Percent: string) + of object; + TOnDataAvailableEvent = procedure(Sender: TBSCB; var Buffer: PByte; + var BufLength: Cardinal) of object; TOnDataAvailableInfoEvent = procedure(Sender: TBSCB; grfBSCF: DWORD; - Status: string {; FormatEtc: PFormatEtc}) of object; - TOnCompleteEvent = procedure(Sender: TCustomIEDownload; aFileNameAndPath, - aFileName, - aFolderName, aExtension: WideString; const ActiveConnections: Integer) of - object; - TOnStreamCompleteEvent = procedure(Sender: TBSCB; Stream: TStream; Result: - HRESULT) of object; - TOnResumeEvent = procedure(Sender: TBSCB; FileName: string; var Action: - Cardinal) of object; - TGetWindowEvent = function(Sender: TBSCB; const GUIDReason: TGUID; out hwnd: - LongWord): HRESULT of object; - TOnStartBindingEvent = procedure(Sender: TBSCB; var Cancel: Boolean; pib: - IBinding; const FileName: WideString; const FileSize: integer) of object; - TOnStopBindingEvent = procedure(Sender: TBSCB; HRESULT: HRESULT; + Status: string { ; FormatEtc: PFormatEtc } ) of object; + TOnCompleteEvent = procedure(Sender: TCustomIEDownload; + aFileNameAndPath, aFileName, aFolderName, aExtension: WideString; + const ActiveConnections: Integer) of object; + TOnStreamCompleteEvent = procedure(Sender: TBSCB; Stream: TStream; + Result: HResult) of object; + TOnResumeEvent = procedure(Sender: TBSCB; FileName: string; + var Action: Cardinal) of object; + TGetWindowEvent = function(Sender: TBSCB; const GUIDReason: TGUID; + out HWND: LongWord): HResult of object; + TOnStartBindingEvent = procedure(Sender: TBSCB; var Cancel: Boolean; + pib: IBinding; const FileName: WideString; const FileSize: Integer) + of object; + TOnStopBindingEvent = procedure(Sender: TBSCB; HResult: HResult; szError: LPCWSTR) of object; - TOnGetBindResultsEvent = procedure(var Sender: TBSCB; out clsidProtocol: - TCLSID; out dwResult: DWORD; out szResult: POLEStr; + TOnGetBindResultsEvent = procedure(var Sender: TBSCB; + out clsidProtocol: TCLSID; out dwResult: DWORD; out szResult: POLEStr; const stResult: string) of object; - TOnGetClientCertEvent = function(var Sender: TBSCB; out ppbCert: Byte; var - pcbCert: DWORD): HResult of object; + TOnGetClientCertEvent = function(var Sender: TBSCB; out ppbCert: Byte; + var pcbCert: DWORD): HResult of object; TTerminateEvent = procedure(const Sender: TBSCB; const ThreadId: Integer; - const aFileName: Widestring; var bCancel: Boolean) of object; - TOnGetRootSecurityIdEvent = function(var SecurityIdBuffer: TByteArray; var - BufferSize: DWord): HRESULT of object; - {IServiceProvider Interface} - TQueryServiceEvent = procedure(Sender: TObject; const rsid, iid: TGUID; var - Obj: IUnknown) of object; - TOnBeforeDownloadEvent = procedure(Sender: TInfoData; const Url, FileName, - FileExtension, Host, DownloadFolder: string; const FileSize: Integer; var - Cancel: Boolean) of object; + const aFileName: WideString; var bCancel: Boolean) of object; + TOnGetRootSecurityIdEvent = function(var SecurityIdBuffer: TByteArray; + var BufferSize: DWORD): HResult of object; + { IServiceProvider Interface } + TQueryServiceEvent = procedure(Sender: TObject; const rsid, IID: TGUID; + var Obj: IUnknown) of object; + TOnBeforeDownloadEvent = procedure(Sender: TInfoData; + const Url, FileName, FileExtension, Host, DownloadFolder: string; + const FileSize: Integer; var Cancel: Boolean) of object; TCustomIEDownload = class(TComponent) @@ -422,11 +404,11 @@ TCustomIEDownload = class(TComponent) {$IFNDEF DELPHI7_UP} FOldTimeSep: Char; {$ENDIF} - bCancelAll: boolean; - bDone: boolean; - bRenamed: boolean; + bCancelAll: Boolean; + bDone: Boolean; + bRenamed: Boolean; BS: TBSCB; - FActiveConnections: integer; + FActiveConnections: Integer; FAdditionalHeader: TStrings; FBeginningTransaction: TBeginningTransactionEvent; FBindF: TBindF_Options; @@ -447,7 +429,7 @@ TCustomIEDownload = class(TComponent) FDefaultProtocol: string; FDefaultUrlFileName: string; FDisplayName: PWideChar; - FdlCounter: integer; + FdlCounter: Integer; FDownloadedFile: string; FDownloadFolder: string; FDownloadMethod: TDownloadMethod; @@ -456,7 +438,7 @@ TCustomIEDownload = class(TComponent) FFileExistsOption: TFileExistsOption; FFileExtension: string; FFileName: string; - FFileSize: ULong; + FFileSize: ULONG; FFullUserAgent: string; FGetWindow: TGetWindowEvent; FHWnd: HWND; @@ -510,16 +492,16 @@ TCustomIEDownload = class(TComponent) FUrl: string; FUserAgent: string; FUserName: string; - FUseSystemDownloadFolder: boolean; - FValidateUrl: boolean; + FUseSystemDownloadFolder: Boolean; + FValidateUrl: Boolean; hProcess: THandle; hStop: THandle; private function GoAction(const actUrl, actFileName, actDownloadFolder: string; - pmk: IMoniker; pbc: IBindCtx): boolean; + pmk: IMoniker; pbc: IBindCtx): Boolean; function GoInit(const inUrl: string; const inFileName: string; - const inDownloadFolder: string): boolean; + const inDownloadFolder: string): Boolean; function SetDownloadFolder(const aDownloadFolder: string): string; function SetHttpProtocol(const aUrl: string): string; procedure DoUpdate; @@ -548,21 +530,21 @@ TCustomIEDownload = class(TComponent) ItemsManager: TBSCBList; constructor Create(AOwner: TComponent); override; destructor Destroy; override; - function CheckFileExists(const aFileName: string): boolean; + function CheckFileExists(const aFileName: string): Boolean; function CodeInstallProblemToStr(const ulStatusCode: Integer): string; function FormatSize(const Byte: Double): string; function FormatTickToTime(const TickCount: Cardinal): string; - function IsAsyncMoniker(const pmk: IMoniker): HRESULT; - function IsSynchronous(iedInfo: TInfoData): boolean; + function IsAsyncMoniker(const pmk: IMoniker): HResult; + function IsSynchronous(iedInfo: TInfoData): Boolean; function IsUrlValid(const isUrl: string): Boolean; function OpenFolder(const aFolderName: string): Boolean; function ResponseCodeToStr(const dwResponse: Integer): string; function SetFileNameFromUrl(const aUrl: string): string; function URLDownloadToCacheFile(const aUrl: string): string; - function UrlDownloadToFile(const aUrl: string): HRESULT; - function WaitForProcess(var EventName: THandle; var aStartTick, - aTimeOut: Integer): Boolean; - function WideStringToLPOLESTR(const Source: string): POleStr; + function UrlDownloadToFile(const aUrl: string): HResult; + function WaitForProcess(var EventName: THandle; + var aStartTick, aTimeOut: Integer): Boolean; + function WideStringToLPOLESTR(const Source: string): POLEStr; procedure BeforeDestruction; override; procedure Cancel(const Item: TBSCB); overload; procedure Cancel; overload; @@ -571,11 +553,11 @@ TCustomIEDownload = class(TComponent) procedure Download(const pmk: IMoniker; const pbc: IBindCtx); overload; procedure Go(const aUrl: string); overload; procedure Go(const aUrl: string; const aFileName: string); overload; - procedure Go(const aUrl: string; const aFileName: string; const - aDownloadFolder: string); overload; + procedure Go(const aUrl: string; const aFileName: string; + const aDownloadFolder: string); overload; procedure GoList(const UrlsList: TStrings); overload; - procedure GoList(const UrlsList: TStrings; const FileNameList: TStrings); - overload; + procedure GoList(const UrlsList: TStrings; + const FileNameList: TStrings); overload; procedure GoList(const UrlsList: TStrings; const FileNameList: TStrings; const DownloadFolderList: TStrings); overload; procedure Loaded; override; @@ -583,13 +565,13 @@ TCustomIEDownload = class(TComponent) procedure Suspend; public - property ActiveConnections: integer read FActiveConnections; + property ActiveConnections: Integer read FActiveConnections; property Busy: Boolean read FBusy; property DisplayName: PWideChar read FDisplayName; property DownloadedFile: string read FDownloadedFile; - property DownloadsCounter: integer read FdlCounter; + property DownloadsCounter: Integer read FdlCounter; property FileExtension: string read FFileExtension; - property FileSize: ULong read FFileSize; + property FileSize: ULONG read FFileSize; property MimeType: string read FMimeType; property ServerAddress: string read FServerAddress; property ServerIP: string read FServerIP; @@ -597,98 +579,92 @@ TCustomIEDownload = class(TComponent) published property About: string read FAbout write SetAbout; - property AdditionalHeader: TStrings read FAdditionalHeader write - SetAdditionalHeader; - property BindF: TBindF_Options read FBindF write - SetBindF default [Asynchronous, AsyncStorage, PullData, - NoWriteCache, GetNewestVersion]; - property BindF2: TBindF2_Options read FBindF2 write - SetBindF2 default [ReadDataOver4GB]; - property BindInfoF: TBindInfoF_Options read FBindInfoF write - SetBindInfoF default []; - property BindVerb: TBindVerb read FBindVerb write - SetBindVerb default Get; + property AdditionalHeader: TStrings read FAdditionalHeader + write SetAdditionalHeader; + property BindF: TBindF_Options read FBindF write SetBindF + default [Asynchronous, AsyncStorage, PullData, NoWriteCache, + GetNewestVersion]; + property BindF2: TBindF2_Options read FBindF2 write SetBindF2 + default [ReadDataOver4GB]; + property BindInfoF: TBindInfoF_Options read FBindInfoF write SetBindInfoF + default []; + property BindVerb: TBindVerb read FBindVerb write SetBindVerb default Get; property BindInfoOptions: TBindInfoOptions_Options read FBindInfoOption_ write SetBindInfoOption default [UseBindInfoOptions, - AllowConnectMessages]; - property CodePage: TCodePageOption read FCodePageOption write - SetCodePage default Ansi; + AllowConnectMessages]; + property CodePage: TCodePageOption read FCodePageOption write SetCodePage + default Ansi; property CustomVerb: string read FCustomVerb write FCustomVerb; - property DefaultProtocol: string read FDefaultProtocol write - SetDefaultProtocol; - property DefaultUrlFileName: string read FDefaultUrlFileName write - FDefaultUrlFileName; - property DownloadFolder: string read FDownloadFolder write - FDownloadFolder; - property DownloadMethod: TDownloadMethod read FDownloadMethod write - SetDownloadMethod default dmFile; + property DefaultProtocol: string read FDefaultProtocol + write SetDefaultProtocol; + property DefaultUrlFileName: string read FDefaultUrlFileName + write FDefaultUrlFileName; + property DownloadFolder: string read FDownloadFolder write FDownloadFolder; + property DownloadMethod: TDownloadMethod read FDownloadMethod + write SetDownloadMethod default dmFile; property ExtraInfo: string read FExtraInfo write FExtraInfo; - property FileExistsOption: TFileExistsOption read FFileExistsOption write - FFileExistsOption default feOverwrite; + property FileExistsOption: TFileExistsOption read FFileExistsOption + write FFileExistsOption default feOverWrite; property FileName: string read FFileName write SetFileName; property OnAuthenticate: TAuthenticateEvent read FOnAuthenticate write FOnAuthenticate; {$IFDEF DELPHI6_UP} property OnAuthenticateEx: TAuthenticateExEvent read FOnAuthenticateEx write FOnAuthenticateEx; - property OnPutProperty: TOnPutPropertyEvent read FOnPutProperty write - FOnPutProperty; + property OnPutProperty: TOnPutPropertyEvent read FOnPutProperty + write FOnPutProperty; {$ENDIF} property OnBeforeDownload: TOnBeforeDownloadEvent read FOnBeforeDownload write FOnBeforeDownload; - property OnBeginningTransaction: TBeginningTransactionEvent read - FBeginningTransaction write FBeginningTransaction; - property OnCodeInstallProblem: TOnCodeInstallProblemEvent read - FOnCodeInstallProblem write FOnCodeInstallProblem; - property OnDataAvailable: TOnDataAvailableEvent read - FOnDataAvailable write FOnDataAvailable; - property OnDataAvailableInfo: TOnDataAvailableInfoEvent read - FOnDataAvailableInfo write FOnDataAvailableInfo; + property OnBeginningTransaction: TBeginningTransactionEvent + read FBeginningTransaction write FBeginningTransaction; + property OnCodeInstallProblem: TOnCodeInstallProblemEvent + read FOnCodeInstallProblem write FOnCodeInstallProblem; + property OnDataAvailable: TOnDataAvailableEvent read FOnDataAvailable + write FOnDataAvailable; + property OnDataAvailableInfo: TOnDataAvailableInfoEvent + read FOnDataAvailableInfo write FOnDataAvailableInfo; property OnConnect: TOnConnectEvent read FOnConnect write FOnConnect; property OnComplete: TOnCompleteEvent read FOnComplete write FOnComplete; - property OnStreamComplete: TOnStreamCompleteEvent read - FOnStreamComplete write FOnStreamComplete; + property OnStreamComplete: TOnStreamCompleteEvent read FOnStreamComplete + write FOnStreamComplete; property OnError: TErrorEvent read FOnError write FOnError; - property OnGetBindResults: TOnGetBindResultsEvent read - FOnGetBindResults write FOnGetBindResults; - property OnGetBindInfo: TOnGetBindInfoEvent read - FOnGetBindInfo write FOnGetBindInfo; - property OnGetBindInfoEx: TOnGetBindInfoExEvent read - FOnGetBindInfoEx write FOnGetBindInfoEx; - property OnGetSerializedClientCertContext: TOnGetClientCertEvent read - FOnGetClientCert - write FOnGetClientCert; + property OnGetBindResults: TOnGetBindResultsEvent read FOnGetBindResults + write FOnGetBindResults; + property OnGetBindInfo: TOnGetBindInfoEvent read FOnGetBindInfo + write FOnGetBindInfo; + property OnGetBindInfoEx: TOnGetBindInfoExEvent read FOnGetBindInfoEx + write FOnGetBindInfoEx; + property OnGetSerializedClientCertContext: TOnGetClientCertEvent + read FOnGetClientCert write FOnGetClientCert; property OnGetRootSecurityId: TOnGetRootSecurityIdEvent read FOnGetRootSecurityId write FOnGetRootSecurityId; - property OnGetWindow: TGetWindowEvent read FGetWindow write - FGetWindow; - property OnFileExists: TFileExistsEvent read FOnFileExists write - FOnFileExists; - property OnProgress: TOnProgressEvent read FOnProgress write - FOnProgress; - property OnQueryInterface: TQueryInterfaceEvent read - FOnQueryInterface write FOnQueryInterface; - property OnQueryService: TQueryServiceEvent read FOnQueryService write - FOnQueryService; + property OnGetWindow: TGetWindowEvent read FGetWindow write FGetWindow; + property OnFileExists: TFileExistsEvent read FOnFileExists + write FOnFileExists; + property OnProgress: TOnProgressEvent read FOnProgress write FOnProgress; + property OnQueryInterface: TQueryInterfaceEvent read FOnQueryInterface + write FOnQueryInterface; + property OnQueryService: TQueryServiceEvent read FOnQueryService + write FOnQueryService; property OnRedirect: TRedirect read FOnRedirect write FOnRedirect; - property OnResponse: TOnResponseEvent read FOnResponse - write FOnResponse; + property OnResponse: TOnResponseEvent read FOnResponse write FOnResponse; property OnResume: TOnResumeEvent read FOnResume write FOnResume; property OnSecurityProblem: TOnSecurityProblemEvent read FOnSecurityProblem write FOnSecurityProblem; - property OnStartBinding: TOnStartBindingEvent read FOnStartBinding write - FOnStartBinding; - property OnStateChange: TStateChangeEvent read FOnStateChange write - FOnStateChange; + property OnStartBinding: TOnStartBindingEvent read FOnStartBinding + write FOnStartBinding; + property OnStateChange: TStateChangeEvent read FOnStateChange + write FOnStateChange; property OnTerminate: TTerminateEvent read FOnTerminate write FOnTerminate; property OnStopBinding: TOnStopBindingEvent read FOnStopBinding write FOnStopBinding; - property OpenDownloadFolder: Boolean read FOpenDownloadFolder write - FOpenDownloadFolder default False; + property OpenDownloadFolder: Boolean read FOpenDownloadFolder + write FOpenDownloadFolder default False; property Password: string read FPassword write FPassword; property PostData: string read FPostData write FPostData; - property ProxySettings: TProxySettings read FProxySettings write - FProxySettings; + property ProxySettings: TProxySettings read FProxySettings + write FProxySettings; property PutFileName: string read FPutFileName write FPutFileName; property Range: TRange read FRange write FRange; property Security: TSecurity read FSecurity write FSecurity; @@ -696,10 +672,10 @@ TCustomIEDownload = class(TComponent) property Url: string read FUrl write FUrl; property UserAgent: string read FUserAgent write FUserAgent; property UserName: string read FUserName write FUserName; - property UseSystemDownloadFolder: boolean read FUseSystemDownloadFolder write - FUseSystemDownloadFolder default False; - property ValidateUrl: boolean read FValidateUrl write FValidateUrl default - False; + property UseSystemDownloadFolder: Boolean read FUseSystemDownloadFolder + write FUseSystemDownloadFolder default False; + property ValidateUrl: Boolean read FValidateUrl write FValidateUrl + default False; end; TIEDownload = class(TCustomIEDownload) @@ -707,8 +683,12 @@ TIEDownload = class(TCustomIEDownload) end; var - ThreadStatusDesc: array[TThreadStatus] of string = ('Running', 'Suspended', - 'Waiting', 'Terminated'); + ThreadStatusDesc: array [TThreadStatus] of string = ( + 'Running', + 'Suspended', + 'Waiting', + 'Terminated' + ); implementation @@ -716,37 +696,37 @@ implementation IEDownloadStrings, EwbUrl, IEDownloadTools, Forms {$IFDEF DELPHI6_UP}, StrUtils{$ENDIF}; -{TInfoData---------------------------------------------------------------------} +{ TInfoData--------------------------------------------------------------------- } constructor TInfoData.Create; begin inherited Create; - InfAdditionalHeader := TStringList.Create; + infAdditionalHeader := TStringList.Create; end; destructor TInfoData.Destroy; -begin {Cleaning out and free our resources} +begin { Cleaning out and free our resources } Clear; Remove(Sender); Extract(Self); - {Its just to make sure we cleanly remove the IEDownload as an object} + { Its just to make sure we cleanly remove the IEDownload as an object } Remove(infSender); Extract(Self); if Assigned(infAdditionalHeader) then FreeAndNil(infAdditionalHeader); inherited; end; -{End of TInfoData--------------------------------------------------------------} +{ End of TInfoData-------------------------------------------------------------- } -{Proxy Settings-----------------------------------------------------------------} +{ Proxy Settings----------------------------------------------------------------- } -function TProxySettings.SetProxy(const FullUserAgent, ProxyServer: string): - Boolean; //mladen +function TProxySettings.SetProxy(const FullUserAgent, ProxyServer: string) + : Boolean; // mladen var intList: INTERNET_PER_CONN_OPTION_List; dwBufSize: DWORD; hInternet: Pointer; - intOptions: array[1..3] of INTERNET_PER_CONN_OPTION; + intOptions: array [1 .. 3] of INTERNET_PER_CONN_OPTION; begin Result := False; dwBufSize := SizeOf(intList); @@ -766,76 +746,75 @@ function TProxySettings.SetProxy(const FullUserAgent, ProxyServer: string): if hInternet <> nil then try Result := InternetSetOption(hInternet, - INTERNET_OPTION_PER_CONNECTION_OPTION, - @intList, dwBufSize); - Result := Result and InternetSetOption(hInternet, INTERNET_OPTION_REFRESH, - nil, 0); + INTERNET_OPTION_PER_CONNECTION_OPTION, @intList, dwBufSize); + Result := Result and InternetSetOption(hInternet, + INTERNET_OPTION_REFRESH, nil, 0); finally InternetCloseHandle(hInternet) end; end; -{End of Proxy Settings-----------------------------------------------------------} +{ End of Proxy Settings----------------------------------------------------------- } {$IFDEF USE_MSHTML} -function TBSCB.OnChanged(dispId: TDispId): HRESULT; +function TBSCB.OnChanged(dispId: TDispId): HResult; var DP: TDispParams; vResult: OLEVariant; Doc: IHTMLDocument2; begin if (DISPID_READYSTATE = DispId) then - if Succeeded((Doc as IHTMLDocument2).Invoke(DISPId_READYSTATE, GUId_null, + if Succeeded((Doc as IHTMLDocument2).Invoke(DISPID_READYSTATE, GUId_null, LOCALE_System_DEFAULT, DISPATCH_PROPERTYGET, DP, @vResult, nil, nil)) then if Integer(vResult) = READYSTATE_COMPLETE then PostThreadMessage(GetCurrentThreadId, WM_USER_STARTWALKING, 0, 0); Result := S_OK; end; -function TBSCB.OnRequestEdit(dispId: TDispId): HRESULT; +function TBSCB.OnRequestEdit(dispId: TDispId): HResult; begin Result := E_NOTIMPL; end; {$ENDIF} -{Callback procedure--------------------------------------------------------------} -{IAuthenticate Interface -Provides the URL moniker with information to authenticate the user} - -function TBSCB.Authenticate(var hwnd: HWnd; var szUserName, szPassWord: LPWSTR): - HResult; -{Provides the URL moniker with information to authenticate the user. -S_OK Authentication was successful. -E_ACCESSDENIED Authentication failed. -E_INVALIDARG One or more parameters are invalid. } +{ Callback procedure-------------------------------------------------------------- } +{ IAuthenticate Interface + Provides the URL moniker with information to authenticate the user } + +function TBSCB.Authenticate(var HWND: HWND; + var szUserName, szPassWord: LPWSTR): HResult; +{ Provides the URL moniker with information to authenticate the user. + S_OK Authentication was successful. + E_ACCESSDENIED Authentication failed. + E_INVALIDARG One or more parameters are invalid. } var aUser, aPwd: WideString; begin Result := S_OK; - hwnd := FSender.FHWnd; + HWND := FSender.FHWnd; aUser := EmptyStr; aPwd := EmptyStr; if Assigned(FSender.FOnAuthenticate) then - FSender.FOnAuthenticate(Self, hwnd, aUser, aPwd, Result); + FSender.FOnAuthenticate(Self, HWND, aUser, aPwd, Result); if aUser <> EmptyStr then - szUserName := WidestringToLPOLESTR(aUser) + szUserName := WideStringToLPOLESTR(aUser) else szUserName := nil; if aPwd <> EmptyStr then - szPassWord := WidestringToLPOLESTR(aPwd) + szPassWord := WideStringToLPOLESTR(aPwd) else szPassWord := nil; end; -{IHttpNegotiate Interface -Implemented by a client application to provide support for HTTP negotiations} +{ IHttpNegotiate Interface + Implemented by a client application to provide support for HTTP negotiations } -function TBSCB.BeginningTransaction(szURL, szHeaders: LPCWSTR; dwReserved: - DWORD; out szAdditionalHeaders: LPWSTR): HRESULT; -{IHttpNegotiate::BeginningTransaction Method -Notifies the client of the URL that is being bound to at the beginning of an HTTP transaction. -S_OK The HTTP transaction completed successfully and any additional headers specified have been appended. -E_ABORT The HTTP transaction has been terminated. -E_INVALIDARG A parameter is invalid.} +function TBSCB.BeginningTransaction(szURL, szHeaders: LPCWSTR; + dwReserved: DWORD; out szAdditionalHeaders: LPWSTR): HResult; +{ IHttpNegotiate::BeginningTransaction Method + Notifies the client of the URL that is being bound to at the beginning of an HTTP transaction. + S_OK The HTTP transaction completed successfully and any additional headers specified have been appended. + E_ABORT The HTTP transaction has been terminated. + E_INVALIDARG A parameter is invalid. } var sr: TSearchRec; Action: Cardinal; @@ -851,7 +830,7 @@ function TBSCB.BeginningTransaction(szURL, szHeaders: LPCWSTR; dwReserved: if (FSender.FCancel) and (Binding <> nil) then begin Result := E_ABORT; - binding.Abort; + Binding.Abort; Exit; end; NewHeaders := FSender.FFullUserAgent + #13 + #10; @@ -864,7 +843,7 @@ function TBSCB.BeginningTransaction(szURL, szHeaders: LPCWSTR; dwReserved: BscbInfo.infRangeEnd := 0; Action := 0; - {IBinding still do not support resume (By MS 4.2009)} + { IBinding still do not support resume (By MS 4.2009) } if Assigned(FSender.FOnResume) then begin FSender.FOnResume(Self, BscbInfo.infFileName, Action); @@ -877,7 +856,7 @@ function TBSCB.BeginningTransaction(szURL, szHeaders: LPCWSTR; dwReserved: if tmpNewName = EmptyStr then tmpNewName := TimeToStr(now) + '_' + BscbInfo.infFileName; case ActExists of - feOverwrite: + feOverWrite: begin Binding.Resume; if Assigned(FSender.FOnResume) then @@ -890,18 +869,19 @@ function TBSCB.BeginningTransaction(szURL, szHeaders: LPCWSTR; dwReserved: Binding.Abort; Exit; end; - feRename: BscbInfo.infFileName := tmpNewName; + feRename: + BscbInfo.infFileName := tmpNewName; end end; end - else {Download is starting} - begin {Set the range to 0 which means start download from scratch} + else { Download is starting } + begin { Set the range to 0 which means start download from scratch } BscbInfo.infRangeBegin := 0; BscbInfo.infRangeEnd := 0; end; if ((BscbInfo.infRangeBegin <> 0) or (BscbInfo.infRangeEnd <> 0)) then - begin {We set the new headers to send to the server} + begin { We set the new headers to send to the server } NewHeaders := NewHeaders + 'Range: bytes=' + IntToStr(BscbInfo.infRangeBegin) + '-'; if BscbInfo.infRangeEnd <> 0 then @@ -915,26 +895,29 @@ function TBSCB.BeginningTransaction(szURL, szHeaders: LPCWSTR; dwReserved: Len := Length(NewHeaders); szAdditionalHeaders := CoTaskMemAlloc((Len + 1) * SizeOf(WideChar)); StringToWideChar(NewHeaders, szAdditionalHeaders, Len + 1); - {We will post the event} + { We will post the event } if Assigned(FSender.FBeginningTransaction) then - Result := FSender.FBeginningTransaction(Self, szURL, szHeaders, - dwReserved, szAdditionalHeaders) + Result := FSender.FBeginningTransaction(Self, szURL, szHeaders, dwReserved, + szAdditionalHeaders) else Result := S_OK; - FBSCBTimer.Enabled := True; {Timeout timer} + FBSCBTimer.Enabled := True; { Timeout timer } FTimedOut := False; +{$IFNDEF DELPHIX_SEATTLE_UP } Self._Release; +{$ENDIF} end; -function TBSCB.OnResponse(dwResponseCode: DWORD; szResponseHeaders, - szRequestHeaders: LPCWSTR; out szAdditionalRequestHeaders: LPWSTR): HRESULT; -{Enables the client of a bind operation to examine the response headers, - optionally terminate the bind operation, and add HTTP headers to a - request before resending the request. -Returns one of the following values. -S_OK The operation completed successfully. -E_ABORT Terminate the HTTP transaction. -E_INVALIDARG The parameter is invalid.} +function TBSCB.OnResponse(dwResponseCode: DWORD; + szResponseHeaders, szRequestHeaders: LPCWSTR; + out szAdditionalRequestHeaders: LPWSTR): HResult; +{ Enables the client of a bind operation to examine the response headers, + optionally terminate the bind operation, and add HTTP headers to a + request before resending the request. + Returns one of the following values. + S_OK The operation completed successfully. + E_ABORT Terminate the HTTP transaction. + E_INVALIDARG The parameter is invalid. } var Len: Cardinal; S: string; @@ -943,36 +926,36 @@ function TBSCB.OnResponse(dwResponseCode: DWORD; szResponseHeaders, if (FSender.FCancel) and (Binding <> nil) then begin Result := E_ABORT; - binding.Abort; + Binding.Abort; Exit; end; Result := S_OK; - if (QueryInfo(HTTP_QUERY_CUSTOM, Len) and (Len = 0)) {file size = 0} - or (QueryInfo(HTTP_QUERY_CONTENT_LENGTH, Len) and (Len = 0)) {file size = 0} - or (dwResponseCode >= 400) then {An Error} + if (QueryInfo(HTTP_QUERY_CUSTOM, Len) and (Len = 0)) { file size = 0 } + or (QueryInfo(HTTP_QUERY_CONTENT_LENGTH, Len) and (Len = 0)) + { file size = 0 } + or (dwResponseCode >= 400) then { An Error } begin Result := E_ABORT; if Assigned(FSender.FOnError) then - FSender.FOnError(dwResponseCode, - ResponseCodeToStr(dwResponseCode)); + FSender.FOnError(dwResponseCode, ResponseCodeToStr(dwResponseCode)); end; - begin {Publish the event} + begin { Publish the event } if Assigned(FSender.FOnResponse) then - Result := FSender.FOnResponse(Self, dwResponseCode, - szResponseHeaders, szRequestHeaders, szAdditionalRequestHeaders); - if (FSender.FDownloadTo = dtDownloadToFile) - or (FSender.FDownloadTo = dtDownloadToCache) then + Result := FSender.FOnResponse(Self, dwResponseCode, szResponseHeaders, + szRequestHeaders, szAdditionalRequestHeaders); + if (FSender.FDownloadTo = dtDownloadToFile) or + (FSender.FDownloadTo = dtDownloadToCache) then begin Result := S_OK; Exit; end; if (BscbInfo.infRangeBegin <> 0) and (BscbInfo.infFileName <> EmptyStr) then - begin {Retrieves the types of range requests that are accepted for a resource.} + begin { Retrieves the types of range requests that are accepted for a resource. } QueryInfo(HTTP_QUERY_ACCEPT_RANGES, S); - {'Partial Content'} + { 'Partial Content' } if (S = 'bytes') or (dwResponseCode = 206) then - begin {Create an output file as a stream back from where we finished} + begin { Create an output file as a stream back from where we finished } tmpName := DoSaveFileAs; if tmpName <> EmptyStr then begin @@ -981,7 +964,7 @@ function TBSCB.OnResponse(dwResponseCode: DWORD; szResponseHeaders, end; end else - begin {'Create an output file as a stream from range begin 0'} + begin { 'Create an output file as a stream from range begin 0' } // not needed tmpName := DoSaveFileAs; if tmpName <> EmptyStr then @@ -992,7 +975,7 @@ function TBSCB.OnResponse(dwResponseCode: DWORD; szResponseHeaders, end; end else - begin {Here we create the file} + begin { Here we create the file } if (FSender.FDownloadMethod = dmFile) then begin tmpName := DoSaveFileAs; @@ -1006,11 +989,11 @@ function TBSCB.OnResponse(dwResponseCode: DWORD; szResponseHeaders, end; end; -{IHttpNegotiate2 Interface} +{ IHttpNegotiate2 Interface } -function TBSCB.GetRootSecurityId(var SecurityIdBuffer: TByteArray; var - BufferSize: DWord; dwReserved: DWORD): HResult; -begin {Gets a root security ID.} +function TBSCB.GetRootSecurityId(var SecurityIdBuffer: TByteArray; + var BufferSize: DWORD; dwReserved: DWORD): HResult; +begin { Gets a root security ID. } if Assigned(FSender.FOnGetRootSecurityId) then Result := FSender.FOnGetRootSecurityId(SecurityIdBuffer, BufferSize) else @@ -1026,20 +1009,20 @@ function TBSCB.GetBindInfoEx(out grfBINDF: DWORD; var pbindinfo: BINDINFO; pdwReserved := 0; if Assigned(FSender.FOnGetBindInfoEx) then FSender.FOnGetBindInfoEx(Self, grfBINDF, pbindinfo, grfBINDF2); - grfBINDF := BscbInfo.infBindF_Value; {Insert our options.} - grfBINDF2 := BscbInfo.infBindF2_Value; {Insert our options 2.} - with pbindinfo do {Lets play with our options.} + grfBINDF := BscbInfo.infBindF_Value; { Insert our options. } + grfBINDF2 := BscbInfo.infBindF2_Value; { Insert our options 2. } + with pbindinfo do { Lets play with our options. } begin cbSize := SizeOf(TBindInfo); if FRedirect then - begin {Set method to get in case of redirect} + begin { Set method to get in case of redirect } dwBindVerb := BINDVERB_GET; end - else {Insert the options} + else { Insert the options } dwBindVerb := BscbInfo.infBindVerb_Value; grfBindInfoF := BscbInfo.infBindInfoF_Value; dwCodePage := BscbInfo.infCodePage_Value; - {Insert security arguments} + { Insert security arguments } with SecurityAttributes do begin nLength := SizeOf(TSecurityAttributes); @@ -1049,7 +1032,7 @@ function TBSCB.GetBindInfoEx(out grfBINDF: DWORD; var pbindinfo: BINDINFO; else lpSecurityDescriptor := nil; end; - {Insert Extra Info} + { Insert Extra Info } if BscbInfo.infExtraInfo <> EmptyStr then begin Len := Length(BscbInfo.infExtraInfo); @@ -1059,13 +1042,12 @@ function TBSCB.GetBindInfoEx(out grfBINDF: DWORD; var pbindinfo: BINDINFO; else szExtraInfo := nil; case BscbInfo.infBindVerb_Value of - {Now we will set by our BindVerbOption} - BINDVERB_PUT: {Perform an HTTP PUT operation. The data to put should be - specified in the stgmedData member of the BINDINFO structure.} + { Now we will set by our BindVerbOption } + BINDVERB_PUT: { Perform an HTTP PUT operation. The data to put should be + specified in the stgmedData member of the BINDINFO structure. } if BscbInfo.infPutFileName <> EmptyStr then begin - PutFile := TFileStream.Create(BscbInfo.infPutFileName, - fmOpenRead); + PutFile := TFileStream.Create(BscbInfo.infPutFileName, fmOpenRead); try PutFile.Seek(0, 0); FGlobalData := GlobalAlloc(GPTR, PutFile.Size); @@ -1075,73 +1057,72 @@ function TBSCB.GetBindInfoEx(out grfBINDF: DWORD; var pbindinfo: BINDINFO; PutFile.Free; end; end; - BINDVERB_POST: {Perform an HTTP POST operation. - The data to be posted should be specified in the stgmedData - member of the BINDINFO structure.} + BINDVERB_POST: { Perform an HTTP POST operation. + The data to be posted should be specified in the stgmedData + member of the BINDINFO structure. } if BscbInfo.infPostData <> EmptyStr then begin - FGlobalData := GlobalAlloc(GPTR, Length(BscbInfo.infPostData) - + 1); + FGlobalData := GlobalAlloc(GPTR, Length(BscbInfo.infPostData) + 1); FDataSize := Length(BscbInfo.infPostData) + 1; Move(BscbInfo.infPostData[1], Pointer(FGlobalData)^, Length(BscbInfo.infPostData)); end; - BINDVERB_CUSTOM: {Perform a custom operation that is protocol-specific - See the szCustomVerb member of the BINDINFO structure. - The data to be used in the custom operation should be specified - in the stgmedData structure.} + BINDVERB_CUSTOM: { Perform a custom operation that is protocol-specific + See the szCustomVerb member of the BINDINFO structure. + The data to be used in the custom operation should be specified + in the stgmedData structure. } if (BscbInfo.infCustomVerb <> EmptyStr) then begin Len := Length(BscbInfo.infCustomVerb); szCustomVerb := CoTaskMemAlloc((Len + 1) * SizeOf(WideChar)); StringToWideChar(BscbInfo.infCustomVerb, szCustomVerb, Len + 1); end - else {BINDVERB_GET so no need to play arround.} + else { BINDVERB_GET so no need to play arround. } szCustomVerb := nil; end; FillChar(stgmedData, 0, SizeOf(STGMEDIUM)); cbStgmedData := FDataSize; - with StgmedData do + with stgmedData do begin if dwBindVerb = BINDVERB_GET then - {The stgmedData member of the BINDINFO - structure should be set to TYMED_NULL for the GET operation} + { The stgmedData member of the BINDINFO + structure should be set to TYMED_NULL for the GET operation } Tymed := TYMED_NULL else Tymed := TYMED_HGLOBAL; - {this is the only medium urlmon supports right now} - hGlobal := FGlobalData; - IUnknown(unkForRelease) := Self; {Set the IUnknown interface} + { this is the only medium urlmon supports right now } + HGLOBAL := FGlobalData; + IUnknown(unkForRelease) := Self; { Set the IUnknown interface } end; end; Result := S_OK; end; -{IBindStatusCallback Interface} -{Accepts information on an asynchronous bind operation.} +{ IBindStatusCallback Interface } +{ Accepts information on an asynchronous bind operation. } -function TBSCB.GetBindInfo(out grfBINDF: DWORD; var BindInfo: TBindInfo): - HRESULT; -{Provides information about how the bind operation is handled when - it is called by an asynchronous moniker. -Returns S_OK if this is successful or E_INVALIDARG if one or more parameters are invalid.} +function TBSCB.GetBindInfo(out grfBINDF: DWORD; + var BINDINFO: TBindInfo): HResult; +{ Provides information about how the bind operation is handled when + it is called by an asynchronous moniker. + Returns S_OK if this is successful or E_INVALIDARG if one or more parameters are invalid. } var PutFile: TFileStream; Len: Integer; begin - grfBINDF := BscbInfo.infBindF_Value; {Insert our options.} - with BindInfo do {Lets play with our options.} + grfBINDF := BscbInfo.infBindF_Value; { Insert our options. } + with BINDINFO do { Lets play with our options. } begin cbSize := SizeOf(TBindInfo); if FRedirect then - begin {Set method to get in case of redirect} + begin { Set method to get in case of redirect } dwBindVerb := BINDVERB_GET; end - else {Insert the options} + else { Insert the options } dwBindVerb := BscbInfo.infBindVerb_Value; grfBindInfoF := BscbInfo.infBindInfoF_Value; dwCodePage := BscbInfo.infCodePage_Value; - {Insert security arguments} + { Insert security arguments } with SecurityAttributes do begin nLength := SizeOf(TSecurityAttributes); @@ -1151,7 +1132,7 @@ function TBSCB.GetBindInfo(out grfBINDF: DWORD; var BindInfo: TBindInfo): else lpSecurityDescriptor := nil; end; - {Insert Extra Info} + { Insert Extra Info } if BscbInfo.infExtraInfo <> EmptyStr then begin Len := Length(BscbInfo.infExtraInfo); @@ -1161,13 +1142,12 @@ function TBSCB.GetBindInfo(out grfBINDF: DWORD; var BindInfo: TBindInfo): else szExtraInfo := nil; case BscbInfo.infBindVerb_Value of - {Now we will set by our BindVerbOption} - BINDVERB_PUT: {Perform an HTTP PUT operation. The data to put should be - specified in the stgmedData member of the BINDINFO structure.} + { Now we will set by our BindVerbOption } + BINDVERB_PUT: { Perform an HTTP PUT operation. The data to put should be + specified in the stgmedData member of the BINDINFO structure. } if BscbInfo.infPutFileName <> EmptyStr then - begin {Create a process to put a file} - PutFile := TFileStream.Create(BscbInfo.infPutFileName, - fmOpenRead); + begin { Create a process to put a file } + PutFile := TFileStream.Create(BscbInfo.infPutFileName, fmOpenRead); try PutFile.Seek(0, 0); FGlobalData := GlobalAlloc(GPTR, PutFile.Size); @@ -1178,81 +1158,80 @@ function TBSCB.GetBindInfo(out grfBINDF: DWORD; var BindInfo: TBindInfo): end; end; - BINDVERB_POST: {Perform an HTTP POST operation. - The data to be posted should be specified in the stgmedData - member of the BINDINFO structure.} + BINDVERB_POST: { Perform an HTTP POST operation. + The data to be posted should be specified in the stgmedData + member of the BINDINFO structure. } if BscbInfo.infPostData <> EmptyStr then begin - FGlobalData := GlobalAlloc(GPTR, Length(BscbInfo.infPostData) - + 1); + FGlobalData := GlobalAlloc(GPTR, Length(BscbInfo.infPostData) + 1); FDataSize := Length(BscbInfo.infPostData) + 1; Move(BscbInfo.infPostData[1], Pointer(FGlobalData)^, Length(BscbInfo.infPostData)); end; - BINDVERB_CUSTOM: {Perform a custom operation that is protocol-specific - See the szCustomVerb member of the BINDINFO structure. - The data to be used in the custom operation should be specified - in the stgmedData structure.} + BINDVERB_CUSTOM: { Perform a custom operation that is protocol-specific + See the szCustomVerb member of the BINDINFO structure. + The data to be used in the custom operation should be specified + in the stgmedData structure. } if (BscbInfo.infCustomVerb <> EmptyStr) then begin Len := Length(BscbInfo.infCustomVerb); szCustomVerb := CoTaskMemAlloc((Len + 1) * SizeOf(WideChar)); StringToWideChar(BscbInfo.infCustomVerb, szCustomVerb, Len + 1); end - else {BINDVERB_GET so no need to play arround.} + else { BINDVERB_GET so no need to play arround. } szCustomVerb := nil; end; FillChar(stgmedData, 0, SizeOf(STGMEDIUM)); cbStgmedData := FDataSize; - with StgmedData do + with stgmedData do begin if dwBindVerb = BINDVERB_GET then - {The stgmedData member of the BINDINFO - structure should be set to TYMED_NULL for the GET operation} + { The stgmedData member of the BINDINFO + structure should be set to TYMED_NULL for the GET operation } Tymed := TYMED_NULL else Tymed := TYMED_HGLOBAL; - {this is the only medium urlmon supports right now} - hGlobal := FGlobalData; - IUnknown(unkForRelease) := Self; {Set the IUnknown interface} + { this is the only medium urlmon supports right now } + HGLOBAL := FGlobalData; + IUnknown(unkForRelease) := Self; { Set the IUnknown interface } end; end; if Assigned(FSender.FOnGetBindInfo) then - FSender.FOnGetBindInfo(Self, grfBINDF, BindInfo); + FSender.FOnGetBindInfo(Self, grfBINDF, BINDINFO); Result := S_OK; end; -function TBSCB.GetPriority(out nPriority): HRESULT; -{Gets the priority for the bind operation when it is called by an asynchronous moniker.} -{Returns S_OK if this is successful or E_INVALIDARG if the pnPriority parameter is invalid.} -begin {if you want to set priority you should implement SetPriority in your application} +function TBSCB.GetPriority(out nPriority): HResult; +{ Gets the priority for the bind operation when it is called by an asynchronous moniker. } +{ Returns S_OK if this is successful or E_INVALIDARG if the pnPriority parameter is invalid. } +begin { if you want to set priority you should implement SetPriority in your application } Result := S_OK; if (FSender.FCancel) and (Binding <> nil) then - binding.Abort + Binding.Abort end; function TBSCB.OnDataAvailable(grfBSCF, dwSize: DWORD; FormatEtc: PFormatEtc; - stgmed: PStgMedium): HRESULT; -{Provides data to the client as it becomes available during -asynchronous bind operations.OnDataAvailable return E_PENDING -when they reference data not yet available through their read -methods, rather than blocking until the data becomes available. - This flag applies only to ASYNCHRONOUS operations} -{Returns S_OK if this is successful or E_INVALIDARG if one or more parameters are invalid.} + stgmed: PStgMedium): HResult; +{ Provides data to the client as it becomes available during + asynchronous bind operations.OnDataAvailable return E_PENDING + when they reference data not yet available through their read + methods, rather than blocking until the data becomes available. + This flag applies only to ASYNCHRONOUS operations } +{ Returns S_OK if this is successful or E_INVALIDARG if one or more parameters are invalid. } var Data: PByte; BufL, dwRead, dwActuallyRead: Cardinal; begin if (FSender.FCancel) and (Binding <> nil) then - binding.Abort + Binding.Abort else begin if Assigned(FSender.FOnDataAvailableInfo) then - FSender.FOnDataAvailableInfo(Self, grfBSCF, - DataAvalibleToStr(grfBSCF) {, FormatEtc}); + FSender.FOnDataAvailableInfo(Self, grfBSCF, DataAvalibleToStr(grfBSCF) + { , FormatEtc } ); - if Assigned(FBSCBTimer) then {reset our timer.} + if Assigned(FBSCBTimer) then { reset our timer. } begin FBSCBTimer.Enabled := False; FBSCBTimer.Enabled := True; @@ -1261,15 +1240,16 @@ function TBSCB.OnDataAvailable(grfBSCF, dwSize: DWORD; FormatEtc: PFormatEtc; if (grfBSCF = grfBSCF or BSCF_FIRSTDATANOTIFICATION) then begin - if (fOutStream = nil) and (stgmed.tymed = TYMED_ISTREAM) then + if (fOutStream = nil) and (stgmed.Tymed = TYMED_ISTREAM) then fOutStream := IStream(stgmed.stm); - if Assigned(m_pPrevBSCB) and not Assigned(fsOutputFile) - and (BscbInfo.infFileName <> '') then + if Assigned(m_pPrevBSCB) and not Assigned(fsOutputFile) and + (BscbInfo.infFileName <> '') then try - //TODO: check for resume + // TODO: check for resume fsOutputFile := TFileStream.Create(DoSaveFileAs, fmCreate); BscbInfo.infRangeBegin := 0; - except on EFCreateError do + except + on EFCreateError do begin Binding.Abort; Result := E_FAIL; @@ -1287,7 +1267,7 @@ function TBSCB.OnDataAvailable(grfBSCF, dwSize: DWORD; FormatEtc: PFormatEtc; BufL := dwActuallyRead; if Assigned(FSender.FOnDataAvailable) then begin - FSender.FOnDataAvailable(self, Data, BufL); + FSender.FOnDataAvailable(Self, Data, BufL); end; if (BscbInfo.infFileName <> '') and Assigned(fsOutputFile) then begin @@ -1300,100 +1280,100 @@ function TBSCB.OnDataAvailable(grfBSCF, dwSize: DWORD; FormatEtc: PFormatEtc; until dwActuallyRead = 0; end; Result := S_OK; - {if (grfBSCF = grfBSCF or BSCF_FIRSTDATANOTIFICATION) then - begin + { if (grfBSCF = grfBSCF or BSCF_FIRSTDATANOTIFICATION) then + begin if (fOutStream = nil) and (stgmed.tymed = TYMED_ISTREAM) then - fOutStream := IStream(stgmed.stm); + fOutStream := IStream(stgmed.stm); if Assigned(m_pPrevBSCB) and not Assigned(fsOutputFile) - //and (BscbInfo.infFileName <> '') - then - // and (FSender.FDownloadMethod = dmFile) then + //and (BscbInfo.infFileName <> '') + then + // and (FSender.FDownloadMethod = dmFile) then try - fsOutputFile := TFileStream.Create(DoSaveFileAs, fmCreate); - BscbInfo.infRangeBegin := 0; + fsOutputFile := TFileStream.Create(DoSaveFileAs, fmCreate); + BscbInfo.infRangeBegin := 0; except on EFCreateError do - begin - Binding.Abort; - Result := E_INVALIDARG; - if Assigned(FSender.FOnError) then - FSender.FOnError(GetLastError, SysErrorMessage(GetLastError)); - fsOutputFile.Free; - Exit; - end; + begin + Binding.Abort; + Result := E_INVALIDARG; + if Assigned(FSender.FOnError) then + FSender.FOnError(GetLastError, SysErrorMessage(GetLastError)); + fsOutputFile.Free; + Exit; end; - end; - dwRead := dwSize - FTotalRead; - dwActuallyRead := 0; - if (dwRead > 0) then + end; + end; + dwRead := dwSize - FTotalRead; + dwActuallyRead := 0; + if (dwRead > 0) then repeat - Data := AllocMem(dwRead + 1); //to fix stack overflow - fOutStream.Read(Data, dwRead, @dwActuallyRead); - BufL := dwActuallyRead; - if Assigned(FSender.FOnDataAvailable) then - FSender.FOnDataAvailable(Self, Data, Bufl); - try - Stream.WriteBuffer(Data^, Bufl); - except - on EWriteError do - begin - Binding.Abort; - Result := E_INVALIDARG; - if Assigned(FSender.FOnError) then - FSender.FOnError(GetLastError, SysErrorMessage(GetLastError)); - fsOutputFile.Free; - Exit; - end; - end; + Data := AllocMem(dwRead + 1); //to fix stack overflow + fOutStream.Read(Data, dwRead, @dwActuallyRead); + BufL := dwActuallyRead; + if Assigned(FSender.FOnDataAvailable) then + FSender.FOnDataAvailable(Self, Data, Bufl); + try + Stream.WriteBuffer(Data^, Bufl); + except + on EWriteError do + begin + Binding.Abort; + Result := E_INVALIDARG; + if Assigned(FSender.FOnError) then + FSender.FOnError(GetLastError, SysErrorMessage(GetLastError)); + fsOutputFile.Free; + Exit; + end; + end; - if (FSender.FDownloadMethod = dmFile) and Assigned(fsOutputFile) then - begin - try - fsOutputFile.WriteBuffer(Data^, bufl); - except - on EWriteError do - begin - Binding.Abort; - Result := E_INVALIDARG; - if Assigned(FSender.FOnError) then - FSender.FOnError(GetLastError, SysErrorMessage(GetLastError)); - fsOutputFile.Free; - Exit; - end - end; - end; - Inc(FTotalRead, dwActuallyRead); - FreeMem(Data); + if (FSender.FDownloadMethod = dmFile) and Assigned(fsOutputFile) then + begin + try + fsOutputFile.WriteBuffer(Data^, bufl); + except + on EWriteError do + begin + Binding.Abort; + Result := E_INVALIDARG; + if Assigned(FSender.FOnError) then + FSender.FOnError(GetLastError, SysErrorMessage(GetLastError)); + fsOutputFile.Free; + Exit; + end + end; + end; + Inc(FTotalRead, dwActuallyRead); + FreeMem(Data); until dwActuallyRead = 0; -end; -Result := S_OK;} + end; + Result := S_OK; } end; -function TBSCB.OnLowResource(Reserved: DWORD): HRESULT; -{Not implemented by MS.} +function TBSCB.OnLowResource(Reserved: DWORD): HResult; +{ Not implemented by MS. } begin Result := E_NOTIMPL; end; -function TBSCB.OnObjectAvailable(const IID: TGUID; punk: IUnknown): HRESULT; -{Passes the requested object interface pointer to the client.} -{Returns S_OK if this is successful or E_INVALIDARG if one or more parameters are invalid.} +function TBSCB.OnObjectAvailable(const IID: TGUID; punk: IUnknown): HResult; +{ Passes the requested object interface pointer to the client. } +{ Returns S_OK if this is successful or E_INVALIDARG if one or more parameters are invalid. } begin Self._AddRef; if (FSender.FCancel) and (Binding <> nil) then - binding.Abort; + Binding.Abort; Result := S_OK; end; function TBSCB.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; - szStatusText: LPCWSTR): HRESULT; -{Indicates the progress and the status of the bind operation.} -{Returns S_OK if this is successful or E_INVALIDARG if one or more parameters are invalid.} -{Avalible flags: http://msdn.microsoft.com/en-us/library/ms775133(VS.85).aspx} + szStatusText: LPCWSTR): HResult; +{ Indicates the progress and the status of the bind operation. } +{ Returns S_OK if this is successful or E_INVALIDARG if one or more parameters are invalid. } +{ Avalible flags: http://msdn.microsoft.com/en-us/library/ms775133(VS.85).aspx } var Percent, Speed, Elapsed, Downloaded, RemainingTime, Status: string; _Speed: Single; bAbort: Boolean; - tmpElapsed, iFileSize: integer; + tmpElapsed, iFileSize: Integer; begin if (FSender.FCancel) and (Binding <> nil) then Binding.Abort @@ -1406,50 +1386,54 @@ function TBSCB.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; ulProgressMax := ulProgress; iFileSize := ulProgressMax; FSender.FFileSize := ulProgressMax; - {For a download manager} + { For a download manager } if Assigned(m_pPrevBSCB) then begin - {Weed to do this otherwise a filedownload dlg will be displayed - as we are downloading the file.} + { Weed to do this otherwise a filedownload dlg will be displayed + as we are downloading the file. } if (ulStatusCode = BINDSTATUS_CONTENTDISPOSITIONATTACH) then begin Result := S_OK; - Exit; {We must exit so no DLG will be displayed} + Exit; { We must exit so no DLG will be displayed } end; m_pPrevBSCB.OnProgress(ulProgress, ulProgressMax, ulStatusCode, szStatusText); end; case ulStatusCode of - BINDSTATUS_REDIRECTING: {redirecting} + BINDSTATUS_REDIRECTING: { redirecting } begin FRedirect := True; FSender.FServerAddress := szStatusText; - if (Assigned(FSender.FOnRedirect)) and - (FSender.FUrl <> szStatusText) then + if (Assigned(FSender.FOnRedirect)) and (FSender.FUrl <> szStatusText) + then FSender.FOnRedirect(Self, bAbort, FSender.FUrl, szStatusText); - if bAbort then {If we do not wish to be redirect} + if bAbort then { If we do not wish to be redirect } begin FSender.FCancel := True; Result := E_INVALIDARG; Exit; end; - {Get the new addreess after redirecing} + { Get the new addreess after redirecing } if (FSender.FDownloadMethod = dmFile) then FSender.SetFileNameFromUrl(szStatusText); end; - BINDSTATUS_CONNECTING: FSender.FServerIP := szStatusText; - BINDSTATUS_MIMETYPEAVAILABLE: FSender.FMimeType := szStatusText; - BINDSTATUS_BEGINDOWNLOADDATA: FSender.FServerAddress := szStatusText; - BINDSTATUS_DOWNLOADINGDATA: {We are downloading so here we will calculate download variables} + BINDSTATUS_CONNECTING: + FSender.FServerIP := szStatusText; + BINDSTATUS_MIMETYPEAVAILABLE: + FSender.FMimeType := szStatusText; + BINDSTATUS_BEGINDOWNLOADDATA: + FSender.FServerAddress := szStatusText; + BINDSTATUS_DOWNLOADINGDATA + : { We are downloading so here we will calculate download variables } if Assigned(FSender.FOnProgress) then begin - if (ulProgress {+ BscbInfo.infRangeBegin} > 0) then - Downloaded := FormatSize(ulProgress {+ BscbInfo.infRangeBegin}); + if (ulProgress { + BscbInfo.infRangeBegin } > 0) then + Downloaded := FormatSize(ulProgress { + BscbInfo.infRangeBegin } ); if (ulProgressMax > 0) and (ulProgress > 0) then Percent := Format('%.1f %%', [ulProgress / ulProgressMax * 100]); QueryPerformanceCounter(TimeNow); if (TimeNow > TimeStarted) - {and (Round((TimeNow-TimeStarted)/Frequency) <= tmpElapsed)}then + { and (Round((TimeNow-TimeStarted)/Frequency) <= tmpElapsed) } then begin tmpElapsed := Round((TimeNow - TimeStarted) / Frequency); Elapsed := SecToStr(tmpElapsed); @@ -1460,10 +1444,10 @@ function TBSCB.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; else _Speed := 0; Speed := Format('%.1f ' + kb_sec, [_Speed]); - if (ulProgressMax > 0) and ((_Speed) > 0) and (ulProgressMax > - ulProgress) then - RemainingTime := SecToStr(Round(ulProgressMax / _speed / 1000) - - Round(ulProgress / _speed / 1000)) + if (ulProgressMax > 0) and ((_Speed) > 0) and + (ulProgressMax > ulProgress) then + RemainingTime := SecToStr(Round(ulProgressMax / _Speed / 1000) - + Round(ulProgress / _Speed / 1000)) else RemainingTime := TimeToStr(0); except @@ -1472,7 +1456,8 @@ function TBSCB.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; end; end; - BINDSTATUS_ENDDOWNLOADDATA: {You are joking right? NO MORE DATA TO DOWNLOAD} + BINDSTATUS_ENDDOWNLOADDATA + : { You are joking right? NO MORE DATA TO DOWNLOAD } begin Downloaded := done; ulProgress := 0; @@ -1482,14 +1467,14 @@ function TBSCB.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; Status := done; Percent := '100%'; end; - {Here you can add more handlers to any BINDSTATUS_ you like} + { Here you can add more handlers to any BINDSTATUS_ you like } end; - if Assigned(FSender.FOnProgress) then {Publish the event} - FSender.FOnProgress(Self, ulProgress {+ BscbInfo.infRangeBegin}, - ulProgressMax {+ BscbInfo.infRangeBegin}, ulStatusCode, iFileSize, - szStatusText, - Downloaded, Elapsed, Speed, RemainingTime, Status, Percent); + if Assigned(FSender.FOnProgress) then { Publish the event } + FSender.FOnProgress(Self, ulProgress { + BscbInfo.infRangeBegin } , + ulProgressMax { + BscbInfo.infRangeBegin } , ulStatusCode, iFileSize, + szStatusText, Downloaded, Elapsed, Speed, RemainingTime, + Status, Percent); end; Result := S_OK; end; @@ -1510,15 +1495,15 @@ function TBSCB.GetFileNameFromUrl(Url: string): string; end; end; -function TBSCB.OnStartBinding(dwReserved: DWORD; pib: IBinding): HRESULT; -{Notifies the client about the callback methods that it is registered to receive.} -{Returns S_OK if this is successful or - E_INVALIDARG if the pib parameter is invalid. -To abort the binding we should return E_FAIL.} +function TBSCB.OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; +{ Notifies the client about the callback methods that it is registered to receive. } +{ Returns S_OK if this is successful or + E_INVALIDARG if the pib parameter is invalid. + To abort the binding we should return E_FAIL. } var bAbort: Boolean; begin - //dwReserved:= 0; // A demand by ms that is not needed.} + // dwReserved:= 0; // A demand by ms that is not needed.} if FSender.FCancel then Result := E_FAIL else @@ -1526,9 +1511,9 @@ function TBSCB.OnStartBinding(dwReserved: DWORD; pib: IBinding): HRESULT; Result := S_OK; bAbort := False; - Binding := pib; {A pointer to the IBinding interface} - Binding._AddRef; {To be released on StopBinding} - {We will try to get the file size using query info} + Binding := pib; { A pointer to the IBinding interface } + Binding._AddRef; { To be released on StopBinding } + { We will try to get the file size using query info } QueryInfo(HTTP_QUERY_CONTENT_LENGTH, BscbInfo.infFileSize); QueryInfoFileName; if Assigned(FSender.FOnBeforeDownload) then @@ -1536,19 +1521,20 @@ function TBSCB.OnStartBinding(dwReserved: DWORD; pib: IBinding): HRESULT; BscbInfo.infFileExt, BscbInfo.infHost, BscbInfo.infDownloadFolder, BscbInfo.infFileSize, bAbort); - {For the download manager} + { For the download manager } FSender.FFileName := BscbInfo.infFileName; FSender.FDownloadFolder := BscbInfo.infDownloadFolder; if Assigned(m_pPrevBSCB) then m_pPrevBSCB.OnStopBinding(HTTP_STATUS_OK, nil); - {Remove file name which is not needed for stream} + { Remove file name which is not needed for stream } case FSender.FDownloadMethod of - dmStream: BscbInfo.infFileName := EmptyStr; + dmStream: + BscbInfo.infFileName := EmptyStr; dmFile: - begin {Try # 2} - if (BscbInfo.infFileName = EmptyStr) and (FSender.FDownloadTo = - dtMoniker) then + begin { Try # 2 } + if (BscbInfo.infFileName = EmptyStr) and + (FSender.FDownloadTo = dtMoniker) then BscbInfo.infFileName := GetFileNameFromUrl(FSender.FUrl) else begin @@ -1562,61 +1548,65 @@ function TBSCB.OnStartBinding(dwReserved: DWORD; pib: IBinding): HRESULT; FSender.FOnStartBinding(Self, bAbort, Binding, BscbInfo.infFileName, BscbInfo.infFileSize); if bAbort then - begin {Note: We are still in busy state until OnStopBinding!!} - Result := E_FAIL; {Do not use Binding.Abort! Just send E_FAIL} + begin { Note: We are still in busy state until OnStopBinding!! } + Result := E_FAIL; { Do not use Binding.Abort! Just send E_FAIL } FSender.FCancel := True; end; end; end; -function TBSCB.OnStopBinding(HRESULT: HRESULT; szError: LPCWSTR): HRESULT; -{This method indicates the end of the bind operation. -Returns S_OK if this is successful or an error value otherwise.} +function TBSCB.OnStopBinding(HResult: HResult; szError: LPCWSTR): HResult; +{ This method indicates the end of the bind operation. + Returns S_OK if this is successful or an error value otherwise. } var clsidProtocol: TCLSID; dwResult: DWORD; szResult: POLEStr; - HR: System.HRESULT; -begin //OK - if (FSender.FDownloadTo = dtDownloadToFile) - or (FSender.FDownloadTo = dtDownloadToCache) then + HR: System.HResult; +begin // OK + if (FSender.FDownloadTo = dtDownloadToFile) or + (FSender.FDownloadTo = dtDownloadToCache) then begin Result := S_OK; Exit; end; if (Assigned(m_pPrevBSCB) and Assigned(FBindCtx)) then - {Stores an IUnknown pointer on the specified object } - begin {To be used with a download manager} + { Stores an IUnknown pointer on the specified object } + begin { To be used with a download manager } HR := FBindCtx.RegisterObjectParam('_BSCB_Holder_', m_pPrevBSCB); if Failed(HR) and Assigned(FSender.FOnError) then FSender.FOnError(GetLastError, SysErrorMessage(GetLastError)) else if (Assigned(FSender.FOnConnect)) then FSender.FOnConnect(Self, HR, Registering_new_moniker + ResponseCodeToStr(HR)); +{$IFNDEF DELPHIX_SEATTLE_UP } m_pPrevBSCB._Release; +{$ENDIF} m_pPrevBSCB := nil; +{$IFNDEF DELPHIX_SEATTLE_UP } FBindCtx._Release; +{$ENDIF} FBindCtx := nil; Dec(FSender.FRefCount); end; GetBindResult(clsidProtocol, dwResult, szResult); if FTimedOut then - begin {If we reached TimeOut them we will post the event} - HRESULT := INET_E_CONNECTION_TIMEOUT; + begin { If we reached TimeOut them we will post the event } + HResult := INET_E_CONNECTION_TIMEOUT; if Assigned(FSender.FOnError) then - FSender.FOnError(HRESULT, ResponseCodeToStr(HRESULT)); + FSender.FOnError(HResult, ResponseCodeToStr(HResult)); end; if Assigned(FSender.FOnStopBinding) then - FSender.FOnStopBinding(Self, HRESULT, szError); - Result := HRESULT; + FSender.FOnStopBinding(Self, HResult, szError); + Result := HResult; FSender.FState := sStopped; if Assigned(FSender.FOnStateChange) then FSender.FOnStateChange(FSender.FState); if Assigned(FSender.FOnStreamComplete) then - FSender.FOnStreamComplete(Self, Stream, HRESULT); + FSender.FOnStreamComplete(Self, Stream, HResult); FSender.bDone := True; SetEvent(FSender.hStop); Terminate; @@ -1625,27 +1615,27 @@ function TBSCB.OnStopBinding(HRESULT: HRESULT; szError: LPCWSTR): HRESULT; SetEvent(FSender.hProcess); end; -{IServiceProvider Interface} +{ IServiceProvider Interface } -function TBSCB.QueryService(const rsid, iid: TGUID; out Obj): HRESULT; +function TBSCB.QueryService(const rsid, IID: TGUID; out Obj): HResult; begin Pointer(Obj) := nil; if Assigned(FSender.FOnQueryService) then - FSender.FOnQueryService(Self, rsid, iid, IUnknown(obj)); + FSender.FOnQueryService(Self, rsid, IID, IUnknown(Obj)); if Pointer(Obj) <> nil then Result := S_OK else Result := E_NOINTERFACE; end; -{ICodeInstall Interface} +{ ICodeInstall Interface } -function TBSCB.OnCodeInstallProblem(ulStatusCode: ULONG; szDestination, - szSource: LPCWSTR; dwReserved: DWORD): HResult; stdcall; -{Returns a value based on the status passed in, which indicates -whether to abort the application installation or file download. -S_OK Indicates that the installation or download should continue. -E_ABORT Indicates that the installation or download should abort.} +function TBSCB.OnCodeInstallProblem(ulStatusCode: ULONG; + szDestination, szSource: LPCWSTR; dwReserved: DWORD): HResult; stdcall; +{ Returns a value based on the status passed in, which indicates + whether to abort the application installation or file download. + S_OK Indicates that the installation or download should continue. + E_ABORT Indicates that the installation or download should abort. } begin dwReserved := 0; if Assigned(FSender.FOnCodeInstallProblem) then @@ -1655,10 +1645,10 @@ function TBSCB.OnCodeInstallProblem(ulStatusCode: ULONG; szDestination, Result := S_OK; end; -{IUnknown Interface} +{ IUnknown Interface } -function TBSCB.QueryInterface(const IID: TGUID; out Obj): HRESULT; -{S_OK if the interface is supported, E_NOINTERFACE if not.} +function TBSCB.QueryInterface(const IID: TGUID; out Obj): HResult; +{ S_OK if the interface is supported, E_NOINTERFACE if not. } begin Self._AddRef; if Assigned(FSender.OnQueryInterface) then @@ -1670,41 +1660,41 @@ function TBSCB.QueryInterface(const IID: TGUID; out Obj): HRESULT; end; function TBSCB._AddRef: Integer; -{The IUnknown::AddRef method increments the reference count for - an interface on an object.} +{ The IUnknown::AddRef method increments the reference count for + an interface on an object. } begin Result := InterlockedIncrement(FSender.FRefCount); end; function TBSCB._Release: Integer; -{Decrements the reference count for the calling interface on a object. } +{ Decrements the reference count for the calling interface on a object. } begin Result := InterlockedDecrement(FSender.FRefCount); if Result = 0 then Destroy; end; -{IWindowForBindingUI Interface} +{ IWindowForBindingUI Interface } -function TBSCB.GetWindow(const GUIDReason: TGUID; out hwnd): HRESULT; -{Returns S_OK if the window handle was successfully returned, - or E_INVALIDARG if the phwnd parameter is invalid. - If you implement this interface, you can return S_FALSE - for this method to indicate that no window is available for - to display user interface information.} +function TBSCB.GetWindow(const GUIDReason: TGUID; out HWND): HResult; +{ Returns S_OK if the window handle was successfully returned, + or E_INVALIDARG if the phwnd parameter is invalid. + If you implement this interface, you can return S_FALSE + for this method to indicate that no window is available for + to display user interface information. } begin if Assigned(FSender.FGetWindow) then - Result := FSender.FGetWindow(Self, GUIDReason, LongWord(hwnd)) + Result := FSender.FGetWindow(Self, GUIDReason, LongWord(HWND)) else Result := S_OK; end; -{IHttpSecurity} +{ IHttpSecurity } function TBSCB.OnSecurityProblem(dwProblem: DWORD): HResult; -{RPC_E_RETRY The calling application should continue or retry the download. -S_FALSE The calling application should open a dialog box to warn the user. -E_ABORT The calling application should abort the download.} +{ RPC_E_RETRY The calling application should continue or retry the download. + S_FALSE The calling application should open a dialog box to warn the user. + E_ABORT The calling application should abort the download. } begin if Assigned(FSender.FOnSecurityProblem) then Result := FSender.FOnSecurityProblem(Self, dwProblem, @@ -1713,8 +1703,8 @@ function TBSCB.OnSecurityProblem(dwProblem: DWORD): HResult; Result := S_FALSE; end; -function TBSCB.GetSerializedClientCertContext(out ppbCert: Byte; var pcbCert: - DWORD): HResult; stdcall; +function TBSCB.GetSerializedClientCertContext(out ppbCert: Byte; + var pcbCert: DWORD): HResult; stdcall; begin if Assigned(FSender.FOnGetClientCert) then Result := FSender.FOnGetClientCert(Self, ppbCert, pcbCert) @@ -1723,8 +1713,9 @@ function TBSCB.GetSerializedClientCertContext(out ppbCert: Byte; var pcbCert: end; {$IFDEF DELPHI6_UP} -function TBSCB.AuthenticateEx(out phwnd: HWND; out pszUsername, - pszPassword: LPWSTR; var pauthinfo: AUTHENTICATEINFO): HResult; stdcall; +function TBSCB.AuthenticateEx(out phwnd: HWND; + out pszUsername, pszPassword: LPWSTR; var pauthinfo: AUTHENTICATEINFO) + : HResult; stdcall; var aUser, aPwd: WideString; tmpHWND: HWND; @@ -1734,22 +1725,21 @@ function TBSCB.AuthenticateEx(out phwnd: HWND; out pszUsername, aUser := EmptyStr; aPwd := EmptyStr; if Assigned(FSender.FOnAuthenticateEx) then - FSender.FOnAuthenticateEx(Self, tmpHWND, aUser, aPwd, - pauthinfo, Result); + FSender.FOnAuthenticateEx(Self, tmpHWND, aUser, aPwd, pauthinfo, Result); if aUser <> EmptyStr then - pszUserName := WidestringToLPOLESTR(aUser) + pszUsername := WideStringToLPOLESTR(aUser) else - pszUserName := nil; + pszUsername := nil; if aPwd <> EmptyStr then - pszPassWord := WidestringToLPOLESTR(aPwd) + pszPassword := WideStringToLPOLESTR(aPwd) else - pszPassWord := nil; + pszPassword := nil; end; function TBSCB.PutProperty(mkp: MONIKERPROPERTY; val: LPCWSTR): HResult; -{This interface is implemented by persistent monikers, - such as a MIME handler, to get properties about the moniker - being handled.} +{ This interface is implemented by persistent monikers, + such as a MIME handler, to get properties about the moniker + being handled. } begin if Assigned(FSender.FOnPutProperty) then Result := FSender.FOnPutProperty(Self, mkp, val) @@ -1759,8 +1749,8 @@ function TBSCB.PutProperty(mkp: MONIKERPROPERTY; val: LPCWSTR): HResult; {$ENDIF} function TBSCB.GetBindResult(out clsidProtocol: TCLSID; out dwResult: DWORD; - out szResult: POLEStr): HRESULT; -{Gets the protocol-specific outcome of a bind operation.} + out szResult: POLEStr): HResult; +{ Gets the protocol-specific outcome of a bind operation. } var dwReserved: DWORD; begin @@ -1771,8 +1761,8 @@ function TBSCB.GetBindResult(out clsidProtocol: TCLSID; out dwResult: DWORD; else Result := E_FAIL; if Assigned(FSender.FOnGetBindResults) then - FSender.FOnGetBindResults(Self, clsidProtocol, dwResult, - szResult, ResponseCodeToStr(dwResult)); + FSender.FOnGetBindResults(Self, clsidProtocol, dwResult, szResult, + ResponseCodeToStr(dwResult)); if (Result <> S_OK) and (Assigned(FSender.FOnError)) then FSender.FOnError(Result, ResponseCodeToStr(Result)); end; @@ -1791,7 +1781,7 @@ procedure TBSCB.TimerExpired(Sender: TObject); end; procedure TBSCB.ClearAll; -begin {Reset our resources} +begin { Reset our resources } if Assigned(Binding) then Binding.Abort; FGlobalData := 0; @@ -1826,7 +1816,7 @@ function TBSCB.QueryInfo(dwOption: DWORD; var Info: Cardinal): Boolean; function TBSCB.QueryInfo(dwOption: DWORD; var Info: string): Boolean; var - Buf: array[0..INTERNET_MAX_PATH_LENGTH] of AnsiChar; + Buf: array [0 .. INTERNET_MAX_PATH_LENGTH] of AnsiChar; HttpInfo: IWinInetHttpInfo; BufLength, dwReserved, dwFlags: Cardinal; begin @@ -1860,10 +1850,9 @@ function TBSCB.QueryInfo(dwOption: DWORD; var Info: TDateTime): Boolean; Info := 0; Reserved := 0; dwFlags := 0; - BufferLength := SizeOf(TSystemTime); + BufferLength := SizeOf(TSystemtime); Result := not Boolean(HttpInfo.QueryInfo(dwOption or - HTTP_QUERY_FLAG_SYSTEMTIME, - @SysTime, BufferLength, dwFlags, Reserved)); + HTTP_QUERY_FLAG_SYSTEMTIME, @SysTime, BufferLength, dwFlags, Reserved)); HttpInfo := nil; if Result then Info := SystemTimeToDateTime(SysTime); @@ -1891,23 +1880,22 @@ function TBSCB.DoSaveFileAs: string; FFileName := BscbInfo.infFileName; FDownloadFolder := BscbInfo.infDownloadFolder; end; - Result := CharReplace(FSender.FDownloadedFile, '?', '_'); - ; + Result := CharReplace(FSender.FDownloadedFile, '?', '_');; end; end; -function TBSCB.QueryInfoFileName: HRESULT; +function TBSCB.QueryInfoFileName: HResult; const CD_FILE_PARAM = 'filename='; var i: Integer; st, sTmp: string; - res: Boolean; + Res: Boolean; begin Result := E_FAIL; sTmp := ''; - res := QueryInfo(HTTP_QUERY_CONTENT_DISPOSITION, sTmp); - if not res then + Res := QueryInfo(HTTP_QUERY_CONTENT_DISPOSITION, sTmp); + if not Res then Exit; i := Pos(CD_FILE_PARAM, sTmp); if (i > 0) then @@ -1917,7 +1905,7 @@ function TBSCB.QueryInfoFileName: HRESULT; i := Pos('";', sTmp) else i := Pos(';', sTmp); - //TODO: what's happen, if the filename contains a quotion mark? + // TODO: what's happen, if the filename contains a quotion mark? if (i > 0) then sTmp := Copy(sTmp, 1, i); if (sTmp[1] = '"') then @@ -1930,7 +1918,7 @@ function TBSCB.QueryInfoFileName: HRESULT; if (Length(sTmp) > 0) then Result := S_OK; end; - FSender.FFileName := BscbInfo.infFileName; {Return Data} + FSender.FFileName := BscbInfo.infFileName; { Return Data } end; function TBSCB.IsRunning: Boolean; @@ -1942,15 +1930,15 @@ function TBSCB.IsRunning: Boolean; end; function TBSCB.GetDisplayName: PWideChar; -begin {Expensive operation so I'll do it only once. - For extra info use MkParseDisplayName } +begin { Expensive operation so I'll do it only once. + For extra info use MkParseDisplayName } if IsRunning then FMoniker.GetDisplayName(FBindCtx, nil, Result); end; function TBSCB.MkParseDisplayName(var DisplayName: PWideChar): IMoniker; var - i: cardinal; + i: Cardinal; begin UrlMon.MkParseDisplayNameEx(FBindCtx, DisplayName, i, Result); end; @@ -1960,38 +1948,38 @@ function TBSCB.CreateMoniker(szName: POLEStr; BC: IBindCtx; out mk: IMoniker; begin szName := StringToOleStr(BscbInfo.infUrl); Result := CreateURLMonikerEx(nil, szName, FMoniker, URL_MK_UNIFORM - {URL_MK_LEGACY}); + { URL_MK_LEGACY } ); end; -function TBSCB.MonikerBindToStorage(Mk: IMoniker; BC: IBindCtx; BSC: - IBindStatusCallback; - const iid: TGUID; out pvObj{$IFNDEF DELPHI8_UP}: Pointer{$ENDIF}): HResult; +function TBSCB.MonikerBindToStorage(mk: IMoniker; BC: IBindCtx; + BSC: IBindStatusCallback; const IID: TGUID; + out pvObj{$IFNDEF DELPHI8_UP}: Pointer{$ENDIF}): HResult; begin - Mk := FMoniker; + mk := FMoniker; BC := FBindCtx; BSC := Self; - Result := Mk.BindToStorage(BC, nil, IStream, fOutStream); + Result := mk.BindToStorage(BC, nil, IStream, fOutStream); end; -function TBSCB.MonikerBindToObject(Mk: IMoniker; BC: IBindCtx; BSC: - IBindStatusCallback; - const iid: TGUID; out pvObj{$IFNDEF DELPHI8_UP}: Pointer{$ENDIF}): HResult; +function TBSCB.MonikerBindToObject(mk: IMoniker; BC: IBindCtx; + BSC: IBindStatusCallback; const IID: TGUID; + out pvObj{$IFNDEF DELPHI8_UP}: Pointer{$ENDIF}): HResult; begin - Mk := FMoniker; + mk := FMoniker; BC := FBindCtx; BSC := Self; - Result := Mk.BindToObject(BC, nil, IStream, fOutStream); + Result := mk.BindToObject(BC, nil, IStream, fOutStream); end; -function TBSCB.AbortBinding: HRESULT; +function TBSCB.AbortBinding: HResult; begin - Result := E_Fail; + Result := E_FAIL; if Assigned(Binding) then Result := Binding.Abort; end; destructor TBSCB.Destroy; -begin {Cleaning out and free our resources} +begin { Cleaning out and free our resources } ClearAll; if Assigned(Stream) then FreeAndNil(Stream); @@ -2005,7 +1993,7 @@ destructor TBSCB.Destroy; end; constructor TBSCB.Create(aSender: TCustomIEDownload; const pmk: IMoniker; - const pbc: IBindCtx; CreateSuspended: boolean); + const pbc: IBindCtx; CreateSuspended: Boolean); var tmp: PWideChar; begin @@ -2015,7 +2003,7 @@ constructor TBSCB.Create(aSender: TCustomIEDownload; const pmk: IMoniker; ThreadStatus := tsSuspended else ThreadStatus := tsWaiting; - Stream := TMemoryStream.Create; {A stream to contain the download} + Stream := TMemoryStream.Create; { A stream to contain the download } FSender := aSender; FMoniker := pmk; FBindCtx := pbc; @@ -2030,18 +2018,18 @@ constructor TBSCB.Create(aSender: TCustomIEDownload; const pmk: IMoniker; end; procedure TBSCB.SetComponents; -begin {Initial all internals before the process} +begin { Initial all internals before the process } QueryPerformanceFrequency(Frequency); QueryPerformanceCounter(TimeStarted); - ClearAll; {Clearing Internals} - FBSCBTimer := TTimer.Create(nil); {Creating Timer for a TimeOut option} + ClearAll; { Clearing Internals } + FBSCBTimer := TTimer.Create(nil); { Creating Timer for a TimeOut option } FBSCBTimer.OnTimer := TimerExpired; FBSCBTimer.Interval := BscbInfo.infTimeOut; FTimedOut := False; - if not FSender.IsSynchronous(BscbInfo) then {We are on Asynchronous mode} + if not FSender.IsSynchronous(BscbInfo) then { We are on Asynchronous mode } begin - FSender.ItemsManager.Add(Self); {Adding asynchronous items} - Inc(BscbInfo.infIndex); {Pass the index} + FSender.ItemsManager.Add(Self); { Adding asynchronous items } + Inc(BscbInfo.infIndex); { Pass the index } Inc(FSender.FdlCounter); end; end; @@ -2067,7 +2055,7 @@ procedure TBSCB.Terminate; ThreadStatus := tsTerminated; bCanc := False; if Assigned(FSender.FOnTerminate) then - FSender.FOnTerminate(Self, ThreadID, BscbInfo.infFileName, bCanc); + FSender.FOnTerminate(Self, ThreadId, BscbInfo.infFileName, bCanc); if bCanc then FSender.CancelAll; inherited; @@ -2078,7 +2066,7 @@ procedure TBSCB.Execute; if Terminated then Exit; try - {Dont be in shock, as a tread it sometimes fail so we should succeed now} + { Dont be in shock, as a tread it sometimes fail so we should succeed now } OleInitialize(nil); except end; @@ -2096,982 +2084,1024 @@ procedure TBSCB.Execute; Synchronize(DoConnect); Synchronize(ReturnData); end; - dtDownloadToCache: Synchronize(DoDownloadToCache); - dtDownloadToFile: Synchronize(DoDownloadToFile); + dtDownloadToCache: + Synchronize(DoDownloadToCache); + dtDownloadToFile: + Synchronize(DoDownloadToFile); end; try if (Assigned(BscbInfo)) then - finally - BscbInfo.Clear; - FreeAndNil(BscbInfo); + finally + BscbInfo.Clear; + FreeAndNil(BscbInfo); + end; + OleUninitialize; end; - OleUninitialize; -end; - -procedure TBSCB.ReceiveData; -begin - BscbInfo := TInfoData.Create; - GetData(FSender); {Pass Data to the TObject} - FSender := TCustomIEDownload(BscbInfo.Sender); -end; -procedure TBSCB.ReturnData; -begin - with FSender do + procedure TBSCB.ReceiveData; begin - FDownloadedFile := BscbInfo.infDownloadFolder + BscbInfo.infFileName; - FFileExtension := ExtractFileExt(FSender.FDownloadedFile); - BscbInfo.infFileExt := FFileExtension; - FFileName := BscbInfo.infFileName; - FDownloadFolder := BscbInfo.infDownloadFolder; + BscbInfo := TInfoData.Create; + GetData(FSender); { Pass Data to the TObject } + FSender := TCustomIEDownload(BscbInfo.Sender); end; -end; - -procedure TBSCB.DoDownloadToCache; -var - Buf: array[0..INTERNET_MAX_PATH_LENGTH] of char; -begin - if Succeeded(UrlMon.URLDownloadToCacheFile(nil, Pchar(BscbInfo.infUrl), - Buf, SizeOf(Buf), 0, Self)) then - FSender.ExtractDataFromFile(Buf); - FSender.ItemsManager.Extract(Self); -end; - -procedure TBSCB.DoDownloadToFile; -var - HR: integer; - tmp: string; -begin - tmp := BscbInfo.infDownloadFolder + BscbInfo.infFileName; - HR := UrlMon.URLDownloadToFile(nil, Pchar(BscbInfo.infUrl), - PChar(tmp), 0, Self); - if Failed(HR) and Assigned(FSender.FOnError) then - FSender.FOnError(GetLastError, Err_ToFile + SysErrorMessage(GetLastError)) - else if (Assigned(FSender.FOnConnect)) then - FSender.FOnConnect(Self, HR, DL_ToFile + ResponseCodeToStr(HR)); - FSender.ExtractDataFromFile(tmp); - FSender.ItemsManager.Extract(Self); -end; -procedure TBSCB.DoConnect; -var - Ut: TUrl; - HR: HRESULT; - pPrevBSCB, tmpBSC: IBindStatusCallback; -begin - FSender.bDone := False; - FSender.hStop := 0; - if FSender.FDownloadTo <> dtMoniker then + procedure TBSCB.ReturnData; begin - HR := CreateURLMonikerEx(nil, BscbInfo.infUrl, FMoniker, URL_MK_UNIFORM - {URL_MK_LEGACY}); - if Failed(HR) and Assigned(FSender.FOnError) then + with FSender do begin - FSender.FOnError(GetLastError, Err_URLMEx + - ResponseCodeToStr(HR)); - Exit; - end - else if (Assigned(FSender.FOnConnect)) then - FSender.FOnConnect(Self, HR, CreateURLMEx + ResponseCodeToStr(HR)); + FDownloadedFile := BscbInfo.infDownloadFolder + BscbInfo.infFileName; + FFileExtension := ExtractFileExt(FSender.FDownloadedFile); + BscbInfo.infFileExt := FFileExtension; + FFileName := BscbInfo.infFileName; + FDownloadFolder := BscbInfo.infDownloadFolder; + end; + end; + + procedure TBSCB.DoDownloadToCache; + var + Buf: array [0 .. INTERNET_MAX_PATH_LENGTH] of Char; + begin + if Succeeded(UrlMon.URLDownloadToCacheFile(nil, PChar(BscbInfo.infUrl), Buf, + SizeOf(Buf), 0, Self)) then + FSender.ExtractDataFromFile(Buf); + FSender.ItemsManager.Extract(Self); + end; - HR := CreateAsyncBindCtx(0, Self, nil, FBindCtx); + procedure TBSCB.DoDownloadToFile; + var + HR: Integer; + tmp: string; + begin + tmp := BscbInfo.infDownloadFolder + BscbInfo.infFileName; + HR := UrlMon.UrlDownloadToFile(nil, PChar(BscbInfo.infUrl), + PChar(tmp), 0, Self); if Failed(HR) and Assigned(FSender.FOnError) then - begin - FSender.FOnError(GetLastError, Err_AsyncBindCtx + - ResponseCodeToStr(HR)); - Exit; - end + FSender.FOnError(GetLastError, Err_ToFile + SysErrorMessage(GetLastError)) else if (Assigned(FSender.FOnConnect)) then - FSender.FOnConnect(Self, HR, CreateABindCtx + ResponseCodeToStr(HR)); + FSender.FOnConnect(Self, HR, DL_ToFile + ResponseCodeToStr(HR)); + FSender.ExtractDataFromFile(tmp); + FSender.ItemsManager.Extract(Self); end; - FSender.FDisplayName := GetDisplayName; + procedure TBSCB.DoConnect; + var + Ut: TUrl; + HR: HResult; + pPrevBSCB, tmpBSC: IBindStatusCallback; begin - if FSender.FDisplayName <> EmptyStr then + FSender.bDone := False; + FSender.hStop := 0; + if FSender.FDownloadTo <> dtMoniker then begin - BscbInfo.infUrl := FSender.FDisplayName; - FSender.FUrl := FSender.FDisplayName; - end; - Ut := TUrl.Create(BscbInfo.infUrl); - try - Ut.QueryUrl(BscbInfo.infUrl); - BscbInfo.infFileName := Ut.Document; - BscbInfo.infHost := Ut.HostName; - finally - Ut.Free; - end; - end; + HR := CreateURLMonikerEx(nil, BscbInfo.infUrl, FMoniker, URL_MK_UNIFORM + { URL_MK_LEGACY } ); + if Failed(HR) and Assigned(FSender.FOnError) then + begin + FSender.FOnError(GetLastError, Err_URLMEx + ResponseCodeToStr(HR)); + Exit; + end + else if (Assigned(FSender.FOnConnect)) then + FSender.FOnConnect(Self, HR, CreateURLMEx + ResponseCodeToStr(HR)); - HR := RegisterBindStatusCallback(FBindCtx, Self, pPrevBSCB, 0); - if Failed(HR) and Assigned(pPrevBSCB) then - begin - HR := FBindCtx.RevokeObjectParam('_BSCB_Holder_'); - if (Succeeded(HR)) then - begin {Attempt register again, should succeed now} - HR := RegisterBindStatusCallback(FBindCtx, Self, tmpBSC, 0); - if (SUCCEEDED(HR)) then - begin //Need to pass a pointer for BindCtx and previous BSCB to our implementation - m_pPrevBSCB := pPrevBSCB; - Self._AddRef; - m_pPrevBSCB._AddRef; - FBindCtx._AddRef; - if (Assigned(FSender.FOnConnect)) then - FSender.FOnConnect(Self, HR, Reg_BSCB + ResponseCodeToStr(HR)); + HR := CreateAsyncBindCtx(0, Self, nil, FBindCtx); + if Failed(HR) and Assigned(FSender.FOnError) then + begin + FSender.FOnError(GetLastError, Err_AsyncBindCtx + + ResponseCodeToStr(HR)); + Exit; end - else if Assigned(FSender.FOnError) then - FSender.FOnError(GetLastError, Err_RegBSCB - + ResponseCodeToStr(HR)); + else if (Assigned(FSender.FOnConnect)) then + FSender.FOnConnect(Self, HR, CreateABindCtx + ResponseCodeToStr(HR)); end; - end - else if (Assigned(FSender.FOnConnect)) then - FSender.FOnConnect(Self, HR, Reg_BSCB + - ResponseCodeToStr(HR)); - FSender.hStop := CreateEvent(nil, True, False, nil); - HR := FMoniker.BindToStorage(FBindCtx, nil, IStream, fOutStream); - if Failed(HR) and Assigned(FSender.FOnError) then - begin - FSender.FOnError(GetLastError, Err_BindToSt + - ResponseCodeToStr(HR)); - Exit; - end - else if (Assigned(FSender.FOnConnect)) then - FSender.FOnConnect(Self, HR, Bind_To_St + ResponseCodeToStr(HR)); - repeat - try - if FSender.WaitForProcess(FSender.hStop, FSender.FStartTick, - FSender.FTimeOut) then - except - if Assigned(FSender.FOnError) then - FSender.FOnError(E_FAIL, Err_Proc_Ev); - raise; + + FSender.FDisplayName := GetDisplayName; + begin + if FSender.FDisplayName <> EmptyStr then + begin + BscbInfo.infUrl := FSender.FDisplayName; + FSender.FUrl := FSender.FDisplayName; + end; + Ut := TUrl.Create(BscbInfo.infUrl); + try + Ut.QueryUrl(BscbInfo.infUrl); + BscbInfo.infFileName := Ut.Document; + BscbInfo.infHost := Ut.HostName; + finally + Ut.Free; + end; end; - until (FSender.FCancel) or (FSender.bDone) - {and (stream = nil)}{or (BscbInfo.infIndex = 0)}; - HR := RevokeBindStatusCallback(FBindCtx, pPrevBSCB); - if Failed(HR) then - HR := RevokeBindStatusCallback(FBindCtx, tmpBSC); - if Failed(HR) and Assigned(FSender.FOnError) then - FSender.FOnError(HR, Err_Revoke + ResponseCodeToStr(HR)) - else if (Assigned(FSender.FOnConnect)) then - FSender.FOnConnect(Self, HR, Revoke_BSCB + ResponseCodeToStr(S_OK)); - if FSender.FActiveConnections = 0 then - FSender.FBusy := False; - if not FSender.IsSynchronous(BscbInfo) then {We are on asynchronous mode} - begin - FSender.ItemsManager.Extract(Self); - {Remove the item from our list because we finished} - Dec(BscbInfo.infIndex); {Pass the new index} - end; -end; + HR := RegisterBindStatusCallback(FBindCtx, Self, pPrevBSCB, 0); + if Failed(HR) and Assigned(pPrevBSCB) then + begin + HR := FBindCtx.RevokeObjectParam('_BSCB_Holder_'); + if (Succeeded(HR)) then + begin { Attempt register again, should succeed now } + HR := RegisterBindStatusCallback(FBindCtx, Self, tmpBSC, 0); + if (Succeeded(HR)) then + begin // Need to pass a pointer for BindCtx and previous BSCB to our implementation + m_pPrevBSCB := pPrevBSCB; + Self._AddRef; + m_pPrevBSCB._AddRef; + FBindCtx._AddRef; + if (Assigned(FSender.FOnConnect)) then + FSender.FOnConnect(Self, HR, Reg_BSCB + ResponseCodeToStr(HR)); + end + else if Assigned(FSender.FOnError) then + FSender.FOnError(GetLastError, Err_RegBSCB + ResponseCodeToStr(HR)); + end; + end + else if (Assigned(FSender.FOnConnect)) then + FSender.FOnConnect(Self, HR, Reg_BSCB + ResponseCodeToStr(HR)); + FSender.hStop := CreateEvent(nil, True, False, nil); + HR := FMoniker.BindToStorage(FBindCtx, nil, IStream, fOutStream); + if Failed(HR) and Assigned(FSender.FOnError) then + begin + FSender.FOnError(GetLastError, Err_BindToSt + ResponseCodeToStr(HR)); + Exit; + end + else if (Assigned(FSender.FOnConnect)) then + FSender.FOnConnect(Self, HR, Bind_To_St + ResponseCodeToStr(HR)); + repeat + try + if FSender.WaitForProcess(FSender.hStop, FSender.FStartTick, + FSender.FTimeOut) then + except + if Assigned(FSender.FOnError) then + FSender.FOnError(E_FAIL, Err_Proc_Ev); + raise; + end; + until (FSender.FCancel) or (FSender.bDone) + { and (stream = nil) }{ or (BscbInfo.infIndex = 0) }; + HR := RevokeBindStatusCallback(FBindCtx, pPrevBSCB); + if Failed(HR) then + HR := RevokeBindStatusCallback(FBindCtx, tmpBSC); + if Failed(HR) and Assigned(FSender.FOnError) then + FSender.FOnError(HR, Err_Revoke + ResponseCodeToStr(HR)) + else if (Assigned(FSender.FOnConnect)) then + FSender.FOnConnect(Self, HR, Revoke_BSCB + ResponseCodeToStr(S_OK)); + + if FSender.FActiveConnections = 0 then + FSender.FBusy := False; + if not FSender.IsSynchronous(BscbInfo) + then { We are on asynchronous mode } + begin + FSender.ItemsManager.Extract(Self); + { Remove the item from our list because we finished } + Dec(BscbInfo.infIndex); { Pass the new index } + end; + end; -procedure TBSCB.GetData(aSender: TCustomIEDownload); -begin {Get data from IEDownload to the iedInfo} - with BscbInfo do - begin - infAdditionalHeader.AddStrings(aSender.FAdditionalHeader); - infBindF_Value := aSender.FBindF_Value; - infBindF2_Value := aSender.FBindF2_Value; - infBindInfoF_Value := aSender.FBindInfoF_Value; - infBindVerb_Value := aSender.FBindVerb_Value; - infBindInfoOptions_Value := aSender.FBindVerb_Value; - infCodePage_Value := aSender.FCodePageValue; - infCustomVerb := aSender.FCustomVerb; - infDescriptor := aSender.Security.FDescriptor; - infDownloadFolder := aSender.FDownloadFolder; - infExtraInfo := aSender.FExtraInfo; - infFileName := aSender.FFileName; - inFFileSize := 0; - infInheritHandle := aSender.Security.FInheritHandle; - infPassword := aSender.FPassword; - infPostData := aSender.FPostData; - infPutFileName := aSender.FPutFileName; - infRangeBegin := aSender.Range.FRangeBegin; - infRangeEnd := aSender.Range.FRangeEnd; - infTimeOut := aSender.FTimeOut; - infUrl := StringToOleStr(aSender.FUrl); - infUserName := aSender.FUserName; - Sender := aSender; - end; -end; + procedure TBSCB.GetData(aSender: TCustomIEDownload); + begin { Get data from IEDownload to the iedInfo } + with BscbInfo do + begin + infAdditionalHeader.AddStrings(aSender.FAdditionalHeader); + infBindF_Value := aSender.FBindF_Value; + infBindF2_Value := aSender.FBindF2_Value; + infBindInfoF_Value := aSender.FBindInfoF_Value; + infBindVerb_Value := aSender.FBindVerb_Value; + infBindInfoOptions_Value := aSender.FBindVerb_Value; + infCodePage_Value := aSender.FCodePageValue; + infCustomVerb := aSender.FCustomVerb; + infDescriptor := aSender.Security.FDescriptor; + infDownloadFolder := aSender.FDownloadFolder; + infExtraInfo := aSender.FExtraInfo; + infFileName := aSender.FFileName; + infFileSize := 0; + infInheritHandle := aSender.Security.FInheritHandle; + infPassword := aSender.FPassword; + infPostData := aSender.FPostData; + infPutFileName := aSender.FPutFileName; + infRangeBegin := aSender.Range.FRangeBegin; + infRangeEnd := aSender.Range.FRangeEnd; + infTimeOut := aSender.FTimeOut; + infUrl := StringToOleStr(aSender.FUrl); + infUserName := aSender.FUserName; + Sender := aSender; + end; + end; -{Enf of Callback procedure------------------------------------------------------} + { Enf of Callback procedure------------------------------------------------------ } -{BSCBList----------------------------------------------------------------------} + { BSCBList---------------------------------------------------------------------- } -function TBSCBList.byURL(Url: string): TBSCB; //by Jury Gerasimov -var - i: integer; -begin - Result := nil; - for i := 0 to Count - 1 do - if Items[i].BscbInfo.infUrl = Url then - begin - Result := Items[i]; - Break; - end; -end; + function TBSCBList.byURL(Url: string): TBSCB; // by Jury Gerasimov + var + i: Integer; + begin + Result := nil; + for i := 0 to Count - 1 do + if Items[i].BscbInfo.infUrl = Url then + begin + Result := Items[i]; + Break; + end; + end; -function TBSCBList.GetItem(Index: Integer): TBSCB; -begin - Result := TBSCB(inherited GetItem(Index)); -end; + function TBSCBList.GetItem(Index: Integer): TBSCB; + begin + Result := TBSCB(inherited GetItem(Index)); + end; -procedure TBSCBList.SetItem(Index: Integer; Value: TBSCB); -begin - inherited SetItem(Index, Value); -end; + procedure TBSCBList.SetItem(Index: Integer; Value: TBSCB); + begin + inherited SetItem(Index, Value); + end; -constructor TBSCBList.Create; -begin - inherited Create; - SessionList := TStringList.Create; -end; + constructor TBSCBList.Create; + begin + inherited Create; + SessionList := TStringList.Create; + end; -destructor TBSCBList.Destroy; -begin - FreeAndNil(SessionList); - inherited Destroy; -end; + destructor TBSCBList.Destroy; + begin + FreeAndNil(SessionList); + inherited Destroy; + end; -{End of BSCBList---------------------------------------------------------------} + { End of BSCBList--------------------------------------------------------------- } -{IEDownload--------------------------------------------------------------------} + { IEDownload-------------------------------------------------------------------- } -constructor TCustomIEDownload.Create(AOwner: TComponent); -begin - inherited; + constructor TCustomIEDownload.Create(AOwner: TComponent); + begin + inherited; {$IFDEF DELPHI7_UP} - // TO Do: W1000 Symbol 'GetLocaleFormatSettings' is deprecated: 'Use TFormatSettings.Create(Locale)' - GetLocaleFormatSettings(SysLocale.DefaultLCID, FFormatSettings); - FFormatSettings.LongTimeFormat := Frmt_Time; - // FFormatSettings:= TFormatSettings.Create(''); //use default locale - FFormatSettings.TimeSeparator := '_'; {For the feRename} + // TO Do: W1000 Symbol 'GetLocaleFormatSettings' is deprecated: 'Use TFormatSettings.Create(Locale)' + GetLocaleFormatSettings(SysLocale.DefaultLCID, FFormatSettings); + FFormatSettings.LongTimeFormat := Frmt_Time; + // FFormatSettings:= TFormatSettings.Create(''); //use default locale + FFormatSettings.TimeSeparator := '_'; { For the feRename } {$ELSE} - FOldTimeSep := TimeSeparator; - LongTimeFormat := Frmt_Time; - TimeSeparator := '_'; {For the feRename} + FOldTimeSep := TimeSeparator; + LongTimeFormat := Frmt_Time; + TimeSeparator := '_'; { For the feRename } {$ENDIF} - FAbout := IED_INFO; - hProcess := 0; - bDone := False; - bCancelAll := False; - FAdditionalHeader := TStringlist.Create; - FAdditionalHeader.Add('Content-Type: application/x-www-form-urlencoded '); - FBindF := [Asynchronous, AsyncStorage, PullData, NoWriteCache, - GetNewestVersion]; - FBindF2 := [ReadDataOver4GB]; - FBindVerb := Get; - FCodePageOption := Ansi; - FBindInfoOption_ := [UseBindInfoOptions, AllowConnectMessages]; - FDefaultProtocol := 'http://'; - FDefaultUrlFileName := 'index.html'; - FdlCounter := 0; - FActiveConnections := 0; - FDownloadMethod := dmFile; - FProxySettings := TProxySettings.Create; - FProxySettings.FPort := 80; - FRange := TRange.Create; - FRefCount := 0; - FSecurity := TSecurity.Create; - FState := sReady; - FBindInfoF := []; - ItemsManager := TBSCBList.Create; - SetUserAgent; -end; + FAbout := IED_INFO; + hProcess := 0; + bDone := False; + bCancelAll := False; + FAdditionalHeader := TStringList.Create; + FAdditionalHeader.Add + ('Content-Type: application/x-www-form-urlencoded '); + FBindF := [Asynchronous, AsyncStorage, PullData, NoWriteCache, + GetNewestVersion]; + FBindF2 := [ReadDataOver4GB]; + FBindVerb := Get; + FCodePageOption := Ansi; + FBindInfoOption_ := [UseBindInfoOptions, AllowConnectMessages]; + FDefaultProtocol := 'http://'; + FDefaultUrlFileName := 'index.html'; + FdlCounter := 0; + FActiveConnections := 0; + FDownloadMethod := dmFile; + FProxySettings := TProxySettings.Create; + FProxySettings.FPort := 80; + FRange := TRange.Create; + FRefCount := 0; + FSecurity := TSecurity.Create; + FState := sReady; + FBindInfoF := []; + ItemsManager := TBSCBList.Create; + SetUserAgent; + end; -procedure TCustomIEDownload.Loaded; -begin - inherited Loaded; - if FTimeOut = 0 then - FTimeOut := MaxInt; - if (FProxySettings.FAutoLoadProxy) and (FProxySettings.FServer <> EmptyStr) - then - FProxySettings.SetProxy(FFullUserAgent, FProxySettings.FServer + ':' + - IntToStr(FProxySettings.FPort)); -end; + procedure TCustomIEDownload.Loaded; + begin + inherited Loaded; + if FTimeOut = 0 then + FTimeOut := MaxInt; + if (FProxySettings.FAutoLoadProxy) and + (FProxySettings.FServer <> EmptyStr) then + FProxySettings.SetProxy(FFullUserAgent, FProxySettings.FServer + ':' + + IntToStr(FProxySettings.FPort)); + end; -procedure TCustomIEDownload.Resume; -begin - if BS <> nil then - BS.Resume; -end; + procedure TCustomIEDownload.Resume; + begin + if BS <> nil then + BS.Resume; + end; -procedure TCustomIEDownload.Suspend; -begin - if BS <> nil then - BS.Suspend; -end; + procedure TCustomIEDownload.Suspend; + begin + if BS <> nil then + BS.Suspend; + end; -destructor TCustomIEDownload.Destroy; -begin + destructor TCustomIEDownload.Destroy; + begin {$IFNDEF DELPHI7_UP} - TimeSeparator := FOldTimeSep; + TimeSeparator := FOldTimeSep; {$ENDIF} - FTimeOut := 0; - FRange.Free; - FSecurity.Free; - FProxySettings.Free; - ItemsManager.Free; - if Assigned(FAdditionalHeader) then - FreeAndNil(FAdditionalHeader); - inherited; -end; - -procedure TCustomIEDownload.BeforeDestruction; -begin - if FProxySettings.FAutoLoadProxy then - FProxySettings.SetProxy(EmptyStr, EmptyStr); {To restore proxy settings} - inherited BeforeDestruction; -end; - -procedure TCustomIEDownload.Cancel; -begin - if (not FBusy) or (FState <> sBusy) then - Exit; - FCancel := True; - Application.ProcessMessages; -end; - -procedure TCustomIEDownload.Reset; -begin - if (FState = sBusy) then - Exit; - FCancel := False; - bCancelAll := False; - Application.ProcessMessages; -end; - -procedure TCustomIEDownload.CancelAll; -begin - if (not FBusy) or (FState <> sBusy) then - Exit; - bCancelAll := True; - FCancel := True; - Application.ProcessMessages; -end; - -procedure TCustomIEDownload.Cancel(const Item: TBSCB); -begin - Item.CheckCancelState; - FCancel := True; -end; - -procedure TCustomIEDownload.Update_BindInfoF_Value; -const - Acard_BindInfoF_Values: array[TBindInfoF] of Cardinal = ( - $00000001, $00000002); -var - i: TBindInfoF; -begin - FBindInfoF_Value := 0; - if (FBindInfoF <> []) then - for i := Low(TBindInfoF) to High(TBindInfoF) do - if (i in FBindInfoF) then - Inc(FBindInfoF_Value, Acard_BindInfoF_Values[i]); -end; - -procedure TCustomIEDownload.Update_BindF_Value; -const - Acard_BindF_Values: array[TBindF] of Cardinal = ( - $00000001, $00000002, $00000004, $00000008, $00000010, $00000020, - $00000040, $00000080, $00000100, $00000200, $00000400, $00000800, - $00001000, $00002000, $00004000, $00008000, $00010000, $00020000, - $00040000, $00080000, $00100000, $00200000, $00400000, $00800000); -var - i: TBindF; -begin - FBindF_Value := 0; - if (FBindF <> []) then - for i := Low(TBindF) to High(TBindF) do - if (i in FBindF) then - Inc(FBindF_Value, Acard_BindF_Values[i]); -end; - -procedure TCustomIEDownload.Update_BindInfoOptions_Value; -const - AcardBindInfoOption_Values: array[TBindInfoOption] of Cardinal = ( - $00010000, $00020000, $00040000, $00080000, $00100000, $00200000, - $00400000, $00800000, $01000000, $02000000, $08000000, $10000000, - $40000000, $80000000, $20000000); -var - i: TBindInfoOption; -begin - FBindInfoOption_Value := 0; - if (FBindInfoOption_ <> []) then - for i := Low(TBindInfoOption) to High(TBindInfoOption) do - if (i in FBindInfoOption_) then - Inc(FBindInfoOption_Value, AcardBindInfoOption_Values[i]); -end; - -procedure TCustomIEDownload.Update_BindF2_Value; -const - AcardBindF2_Values: array[TBindF2] of Cardinal = ($00000001, - $00000002, $00000004, $00000008, $40000000, $80000000); -var - i: TBindF2; -begin - FBindF2_Value := 0; - if (FBindF2 <> []) then - for i := Low(TBindF2) to High(TBindF2) do - if (i in FBindF2) then - Inc(FBindF2_Value, AcardBindF2_Values[i]); -end; - -function TCustomIEDownload.OpenFolder(const aFolderName: string): Boolean; -var - Int: integer; -begin - Result := False; - if (FDownloadMethod = dmFile) then - begin - Int := ShellExecute(Forms.Application.Handle, PChar('explore'), - PChar(aFolderName), nil, nil, SW_SHOWNORMAL); - Result := (Int > 32); - if not Result and Assigned(FOnError) then - FOnError(Int, Err_Folder); - end; -end; - -procedure TCustomIEDownload.DoUpdate; -begin - Update_BindF_Value; - Update_BindF2_Value; - Update_BindInfoF_Value; - Update_BindInfoOptions_Value; -end; - -function TCustomIEDownload.CodeInstallProblemToStr(const ulStatusCode: Integer): - string; -begin - Result := IEDownloadTools.CodeInstallProblemToStr(ulStatusCode); -end; - -function TCustomIEDownload.CheckFileExists(const aFileName: string): boolean; -begin - Result := FileExists(aFileName); -end; - -procedure TCustomIEDownload.Go(const aUrl: string); -begin - GoAction(aUrl, EmptyStr, EmptyStr, nil, nil); - if FOpenDownloadFolder then - OpenFolder(FDownloadFolder); -end; - -procedure TCustomIEDownload.Go(const aUrl: string; const aFileName: string); -begin - GoAction(aUrl, aFileName, EmptyStr, nil, nil); - if FOpenDownloadFolder then - OpenFolder(FDownloadFolder); -end; - -procedure TCustomIEDownload.Go(const aUrl: string; const aFileName: string; - const aDownloadFolder: string); -begin - GoAction(aUrl, aFileName, aDownloadFolder, nil, nil); - if FOpenDownloadFolder then - OpenFolder(FDownloadFolder); -end; - -procedure TCustomIEDownload.GoList(const UrlsList: TStrings); -var - Idx: integer; -begin - for Idx := 0 to UrlsList.Count - 1 do - if (UrlsList[Idx] <> EmptyStr) and (not bCancelAll) then - GoAction(UrlsList[Idx], EmptyStr, EmptyStr, nil, nil); - if FOpenDownloadFolder then - OpenFolder(FDownloadFolder); -end; - -procedure TCustomIEDownload.GoList(const UrlsList: TStrings; const FileNameList: - TStrings); -var - Idx: integer; -begin - for Idx := 0 to UrlsList.Count - 1 do - if (UrlsList[Idx] <> EmptyStr) and (not bCancelAll) then - GoAction(UrlsList[Idx], FileNameList[Idx], EmptyStr, nil, nil); - if FOpenDownloadFolder then - OpenFolder(FDownloadFolder); -end; - -procedure TCustomIEDownload.GoList(const UrlsList: TStrings; const FileNameList: - TStrings; - const DownloadFolderList: TStrings); -var - Idx: integer; -begin - for Idx := 0 to UrlsList.Count - 1 do - if (UrlsList[Idx] <> EmptyStr) and (not bCancelAll) then - GoAction(UrlsList[Idx], FileNameList[Idx], DownloadFolderList[Idx], nil, - nil); - if FOpenDownloadFolder then - OpenFolder(FDownloadFolder); -end; + FTimeOut := 0; + FRange.Free; + FSecurity.Free; + FProxySettings.Free; + ItemsManager.Free; + if Assigned(FAdditionalHeader) then + FreeAndNil(FAdditionalHeader); + inherited; + end; -procedure TCustomIEDownload.Download(const pmk: IMoniker; const pbc: IBindCtx); -begin - FDownloadTo := dtMoniker; - PrepareForStart; - hProcess := CreateEvent(nil, True, False, nil); - if (not GoInit('', FFileName, FDownloadFolder)) then - begin - PrepareForExit; - Exit; - end; - BS := TBSCB.Create(Self, pmk, pbc, True); - try - BS.Execute; - repeat - try - if WaitForProcess(hProcess, FStartTick, FTimeOut) then - except - if Assigned(FOnError) then - FOnError(E_FAIL, Err_Proc_Ev); - raise; + procedure TCustomIEDownload.BeforeDestruction; + begin + if FProxySettings.FAutoLoadProxy then + FProxySettings.SetProxy(EmptyStr, EmptyStr); + { To restore proxy settings } + inherited BeforeDestruction; end; - until (FCancel) or (FActiveConnections = 0); - finally - FreeAndNil(BS); - end; - PrepareForExit; -end; -function TCustomIEDownload.GoAction(const actUrl, actFileName, - actDownloadFolder: string; - pmk: IMoniker; pbc: IBindCtx): boolean; -begin - Result := False; - PrepareForStart; - hProcess := CreateEvent(nil, True, False, nil); - if (not GoInit(actUrl, actFileName, actDownloadFolder)) then - begin - PrepareForExit; - Exit; - end; - BS := TBSCB.Create(Self, pmk, pbc, True); {Creating Download Callback} - try //Fix Deadlock? - BS.Execute; - repeat - try - if WaitForProcess(hProcess, FStartTick, FTimeOut) then - except - if Assigned(FOnError) then - FOnError(E_FAIL, Err_Proc_Ev); - raise; + procedure TCustomIEDownload.Cancel; + begin + if (not FBusy) or (FState <> sBusy) then + Exit; + FCancel := True; + Application.ProcessMessages; end; - until (FCancel) or (FActiveConnections = 0); - finally - FreeAndNil(BS); - end; - PrepareForExit; - Result := True; -end; -function TCustomIEDownload.URLDownloadToCacheFile(const aUrl: string): string; -begin - Result := EmptyStr; - PrepareForStart; - if not GoInit(aUrl, '', '') then - Exit; - FDownloadTo := dtDownloadToCache; - BS := TBSCB.Create(Self, nil, nil, True); - try - BS.Execute; - BS.Terminate; - Dec(FActiveConnections); - finally - FreeAndNil(BS); - end; - SetBeforeExit; - PrepareForExit; - Result := FDownloadFolder; -end; + procedure TCustomIEDownload.Reset; + begin + if (FState = sBusy) then + Exit; + FCancel := False; + bCancelAll := False; + Application.ProcessMessages; + end; -function TCustomIEDownload.UrlDownloadToFile(const aUrl: string): HRESULT; -begin - Result := E_FAIL; - PrepareForStart; - if not GoInit(aUrl, '', '') then - Exit; - FDownloadTo := dtDownloadToFile; - BS := TBSCB.Create(Self, nil, nil, True); - try - BS.Execute; - BS.Terminate; - Dec(FActiveConnections); - finally - FreeAndNil(BS); - end; - SetBeforeExit; - PrepareForExit; - Result := S_OK; -end; + procedure TCustomIEDownload.CancelAll; + begin + if (not FBusy) or (FState <> sBusy) then + Exit; + bCancelAll := True; + FCancel := True; + Application.ProcessMessages; + end; -procedure TCustomIEDownload.SetBeforeExit; -begin - if FOpenDownloadFolder then - OpenFolder(FDownloadFolder); - if FActiveConnections = 0 then - FBusy := False; - FState := sStopped; - if Assigned(FOnStateChange) then - FOnStateChange(FState); -end; + procedure TCustomIEDownload.Cancel(const Item: TBSCB); + begin + Item.CheckCancelState; + FCancel := True; + end; -function TCustomIEDownload.GoInit(const inUrl: string; const inFileName: - string; const inDownloadFolder: string): boolean; -var - tmpNewName: WideString; - Act: TFileExistsOption; -begin - act := FFileExistsOption; - tmpNewName := ''; - Result := False; - if FDownloadTo <> dtMoniker then - begin - if inUrl = EmptyStr then - begin - PrepareForExit; - Exit; - end; - FUrl := SetHttpProtocol(inUrl); {We pass the Address we got to the component} - if (FValidateUrl) and not (IsUrlValid(FUrl)) then - begin - PrepareForExit; - Exit; - end; - ItemsManager.SessionList.Add(FUrl); - if FDownloadMethod = dmFile then - begin - FDownloadFolder := SetDownloadFolder(inDownloadFolder); - if FDownloadFolder = EmptyStr then - Exit; - FFileName := inFileName; - if (FFileName = EmptyStr) then - FFileName := SetFileNameFromUrl(FUrl); {First try} - if (CheckFileExists(FDownloadFolder + FFileName)) then + procedure TCustomIEDownload.Update_BindInfoF_Value; + const + Acard_BindInfoF_Values: array [TBindInfoF] of Cardinal = ($00000001, + $00000002); + var + i: TBindInfoF; begin - if Assigned(FOnFileExists) then - FOnFileExists(Act, FDownloadFolder + FFileName, tmpNewName); - case Act of - feSkip: - begin - PrepareForExit; - Exit; - end; - feRename: - begin -{$IFDEF DELPHI7_UP} - if tmpNewName = EmptyStr then - tmpNewName := TimeToStr(now, FFormatSettings) + '_' + FFileName; -{$ELSE} - if tmpNewName = EmptyStr then - tmpNewName := TimeToStr(now) + '_' + FFileName; -{$ENDIF} - FFileName := tmpNewName; - bRenamed := True; - end; - feOverwrite: FBindF := FBindF + [GetNewestVersion]; - end; + FBindInfoF_Value := 0; + if (FBindInfoF <> []) then + for i := Low(TBindInfoF) to High(TBindInfoF) do + if (i in FBindInfoF) then + Inc(FBindInfoF_Value, Acard_BindInfoF_Values[i]); end; - end - else - FBindF := FBindF + [GetNewestVersion]; - end; - DoUpdate; - Result := True; -end; -function TCustomIEDownload.WaitForProcess(var EventName: THandle; - var aStartTick, aTimeOut: Integer): Boolean; -var - dwResult: DWORD; - Msg: TMsg; - EventList: array[0..0] of THandle; -begin - EventList[0] := EventName; - dwResult := MsgWaitForMultipleObjects(1, EventList, False, DWORD(ATimeOut), - QS_ALLEVENTS); + procedure TCustomIEDownload.Update_BindF_Value; + const + Acard_BindF_Values: array [TBindF] of Cardinal = ($00000001, $00000002, + $00000004, $00000008, $00000010, $00000020, $00000040, $00000080, + $00000100, $00000200, $00000400, $00000800, $00001000, $00002000, + $00004000, $00008000, $00010000, $00020000, $00040000, $00080000, + $00100000, $00200000, $00400000, $00800000); + var + i: TBindF; + begin + FBindF_Value := 0; + if (FBindF <> []) then + for i := Low(TBindF) to High(TBindF) do + if (i in FBindF) then + Inc(FBindF_Value, Acard_BindF_Values[i]); + end; - case dwResult of - WAIT_FAILED: {Waiting failed} + procedure TCustomIEDownload.Update_BindInfoOptions_Value; + const + AcardBindInfoOption_Values: array [TBindInfoOption] of Cardinal = + ($00010000, $00020000, $00040000, $00080000, $00100000, $00200000, + $00400000, $00800000, $01000000, $02000000, $08000000, $10000000, + $40000000, $80000000, $20000000); + var + i: TBindInfoOption; begin - if Assigned(FOnError) then - FOnError(GetLastError, SysErrorMessage(GetLastError)); + FBindInfoOption_Value := 0; + if (FBindInfoOption_ <> []) then + for i := Low(TBindInfoOption) to High(TBindInfoOption) do + if (i in FBindInfoOption_) then + Inc(FBindInfoOption_Value, AcardBindInfoOption_Values[i]); end; - WAIT_TIMEOUT: {Waiting Timo out} + + procedure TCustomIEDownload.Update_BindF2_Value; + const + AcardBindF2_Values: array [TBindF2] of Cardinal = ($00000001, $00000002, + $00000004, $00000008, $40000000, $80000000); + var + i: TBindF2; begin - if Assigned(FOnError) then - FOnError(GetLastError, SysErrorMessage(GetLastError)); + FBindF2_Value := 0; + if (FBindF2 <> []) then + for i := Low(TBindF2) to High(TBindF2) do + if (i in FBindF2) then + Inc(FBindF2_Value, AcardBindF2_Values[i]); end; - WAIT_BSCB: {Our state to process messages} + + function TCustomIEDownload.OpenFolder(const aFolderName: string): Boolean; + var + Int: Integer; begin - while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do + Result := False; + if (FDownloadMethod = dmFile) then begin - TranslateMessage(Msg); - DispatchMessage(Msg); - if (Integer(GetTickCount) - aStartTick > aTimeOut) then - begin - if Assigned(FOnError) then - FOnError(GetLastError, Err_TimeOut); - end; - end; - if (Integer(GetTickCount) - aStartTick > aTimeOut) then - begin - if Assigned(FOnError) then - FOnError(GetLastError, Err_TimeOut); + Int := ShellExecute(Forms.Application.Handle, PChar('explore'), + PChar(aFolderName), nil, nil, SW_SHOWNORMAL); + Result := (Int > 32); + if not Result and Assigned(FOnError) then + FOnError(Int, Err_Folder); end; end; - end; - Result := (dwResult = WAIT_OBJECT_0); {We are done waiting} -end; -function TCustomIEDownload.IsSynchronous(iedInfo: TInfoData): boolean; -begin {Return True if mode is Synchronous} - if iedInfo.infBindF_Value <> (iedInfo.infBindF_Value or - BINDF_ASYNCHRONOUS) then - Result := True - else - Result := False; -end; - -function TCustomIEDownload.IsAsyncMoniker(const pmk: IMoniker): HRESULT; -begin - Result := UrlMon.IsAsyncMoniker(pmk); -end; - -function TCustomIEDownload.FormatSize(const Byte: Double): string; -begin - Result := IEDownloadTools.FormatSize(Byte); -end; - -function TCustomIEDownload.FormatTickToTime(const TickCount: Cardinal): string; -begin - Result := IEDownloadTools.FormatTickToTime(TickCount); -end; - -function TCustomIEDownload.IsUrlValid(const isUrl: string): Boolean; -var - U: TUrl; -begin - U := TUrl.Create(isUrl); - try - Result := U.IsUrlValid(isUrl); - if not Result and Assigned(FOnError) then - FOnError(GetLastError, SysErrorMessage(GetLastError) + isUrl); - finally - U.Free; - end; -end; - -procedure TCustomIEDownload.PrepareForExit; -begin - if Assigned(FOnComplete) then - FOnComplete(Self, FDownloadedFile, FFileName, FDownloadFolder, - FFileExtension, ActiveConnections); - FState := sReady; - if Assigned(FOnStateChange) then - FOnStateChange(FState); -end; - -procedure TCustomIEDownload.PrepareForStart; -begin - FBusy := True; - bRenamed := False; - FCancel := False; - FDownloadedFile := EmptyStr; - FDownloadFolder := EmptyStr; - FFileExtension := EmptyStr; - FFileName := EmptyStr; - FFileSize := 0; - FMimeType := EmptyStr; - FServerAddress := EmptyStr; - FServerIP := EmptyStr; - FUrl := EmptyStr; - FState := sBusy; - if Assigned(FOnStateChange) then - FOnStateChange(FState); - FStartTick := GetTickCount; - Inc(FRefCount); - Inc(FActiveConnections); -end; - -procedure TCustomIEDownload.SetCodePage(const Value: TCodePageOption); -begin - FCodePageOption := Value; - case FCodePageOption of - Ansi: FCodePageValue := CP_ACP; - Mac: FCodePageValue := CP_MACCP; - OEM: FCodePageValue := CP_OEMCP; - Symbol: FCodePageValue := CP_SYMBOL; - ThreadsAnsi: FCodePageValue := CP_THREAD_ACP; - UTF7: FCodePageValue := CP_UTF7; - UTF8: FCodePageValue := CP_UTF8; - end; -end; - -procedure TCustomIEDownload.SetBindVerb(const Value: TBindVerb); -begin {Contains values that specify an action, such as an HTTP request, to be performed during the binding operation.} - FBindVerb := Value; - case FBindVerb of - Get: FBindVerb_Value := BINDVERB_GET; - Put: FBindVerb_Value := BINDVERB_PUT; - Post: FBindVerb_Value := BINDVERB_POST; - Custom: FBindVerb_Value := BINDVERB_CUSTOM; - end; -end; - -procedure TCustomIEDownload.SetFileName(const Value: string); -begin - FFileName := Value; -end; - -function TCustomIEDownload.SetFileNameFromUrl(const aUrl: string): string; -var - Ut: TUrl; - sTmp1, sTmp2: string; -begin - if FDownloadMethod = dmFile then - begin - Ut := TUrl.Create(aUrl); - try - Ut.CrackUrl(aUrl, ICU_ESCAPE); - if AnsiPos('.', Ut.ExtraInfo) <> 0 then - sTmp1 := Ut.ExtraInfo; - Ut.QueryUrl(aUrl); - sTmp2 := Ut.Document; - finally - Ut.Free; - end; - if sTmp1 <> EmptyStr then - begin - Result := sTmp1; - Exit; - end - else - Result := sTmp2; - end; -end; + procedure TCustomIEDownload.DoUpdate; + begin + Update_BindF_Value; + Update_BindF2_Value; + Update_BindInfoF_Value; + Update_BindInfoOptions_Value; + end; -procedure TCustomIEDownload.ExtractDataFromFile(const aFileName: string); -begin - FDownloadedFile := aFileName; - FFileName := ExtractFileName(aFileName); - FDownloadFolder := ExtractFilePath(aFileName); - FFileExtension := ExtractFileExt(aFileName); -end; + function TCustomIEDownload.CodeInstallProblemToStr(const ulStatusCode + : Integer): string; + begin + Result := IEDownloadTools.CodeInstallProblemToStr(ulStatusCode); + end; -procedure TCustomIEDownload.SetAdditionalHeader(const Value: TStrings); -begin {Sets additional headers to append to the HTTP request.} - FAdditionalHeader.Assign(Value); -end; + function TCustomIEDownload.CheckFileExists(const aFileName + : string): Boolean; + begin + Result := FileExists(aFileName); + end; -procedure TCustomIEDownload.SetAbout(Value: string); -begin - Exit; -end; + procedure TCustomIEDownload.Go(const aUrl: string); + begin + GoAction(aUrl, EmptyStr, EmptyStr, nil, nil); + if FOpenDownloadFolder then + OpenFolder(FDownloadFolder); + end; -procedure TCustomIEDownload.SetDefaultProtocol(const Value: string); -begin - FDefaultProtocol := (Value); - if FDefaultProtocol = EmptyStr then - FDefaultProtocol := 'http://'; -end; + procedure TCustomIEDownload.Go(const aUrl: string; + const aFileName: string); + begin + GoAction(aUrl, aFileName, EmptyStr, nil, nil); + if FOpenDownloadFolder then + OpenFolder(FDownloadFolder); + end; -procedure TCustomIEDownload.SetUserAgent; -begin - FFullUserAgent := USER_AGENT_IE6 + '(' + FUserAgent + ')' + #13#10; -end; + procedure TCustomIEDownload.Go(const aUrl: string; + const aFileName: string; const aDownloadFolder: string); + begin + GoAction(aUrl, aFileName, aDownloadFolder, nil, nil); + if FOpenDownloadFolder then + OpenFolder(FDownloadFolder); + end; -procedure TCustomIEDownload.SetBindInfoF(const Value: TBindInfoF_Options); -begin - FBindInfoF := Value; - Update_BindInfoF_Value; -end; + procedure TCustomIEDownload.GoList(const UrlsList: TStrings); + var + Idx: Integer; + begin + for Idx := 0 to UrlsList.Count - 1 do + if (UrlsList[Idx] <> EmptyStr) and (not bCancelAll) then + GoAction(UrlsList[Idx], EmptyStr, EmptyStr, nil, nil); + if FOpenDownloadFolder then + OpenFolder(FDownloadFolder); + end; -procedure TCustomIEDownload.SetBindF2(const Value: TBindF2_Options); -begin - FBindF2 := Value; - Update_BindF2_Value; -end; + procedure TCustomIEDownload.GoList(const UrlsList: TStrings; + const FileNameList: TStrings); + var + Idx: Integer; + begin + for Idx := 0 to UrlsList.Count - 1 do + if (UrlsList[Idx] <> EmptyStr) and (not bCancelAll) then + GoAction(UrlsList[Idx], FileNameList[Idx], EmptyStr, nil, nil); + if FOpenDownloadFolder then + OpenFolder(FDownloadFolder); + end; -procedure TCustomIEDownload.SetBindInfoOption(const Value: - TBindInfoOptions_Options); -begin - FBindInfoOption_ := Value; - Update_BindInfoOptions_Value; -end; + procedure TCustomIEDownload.GoList(const UrlsList: TStrings; + const FileNameList: TStrings; const DownloadFolderList: TStrings); + var + Idx: Integer; + begin + for Idx := 0 to UrlsList.Count - 1 do + if (UrlsList[Idx] <> EmptyStr) and (not bCancelAll) then + GoAction(UrlsList[Idx], FileNameList[Idx], DownloadFolderList[Idx], + nil, nil); + if FOpenDownloadFolder then + OpenFolder(FDownloadFolder); + end; -procedure TCustomIEDownload.SetBindF(const Value: TBindF_Options); -begin - if FFileExistsOption = feOverWrite then - FBindF := FBindF + [GetNewestVersion]; - FBindF := Value; - Update_BindF_Value; -end; + procedure TCustomIEDownload.Download(const pmk: IMoniker; + const pbc: IBindCtx); + begin + FDownloadTo := dtMoniker; + PrepareForStart; + hProcess := CreateEvent(nil, True, False, nil); + if (not GoInit('', FFileName, FDownloadFolder)) then + begin + PrepareForExit; + Exit; + end; + BS := TBSCB.Create(Self, pmk, pbc, True); + try + BS.Execute; + repeat + try + if WaitForProcess(hProcess, FStartTick, FTimeOut) then + except + if Assigned(FOnError) then + FOnError(E_FAIL, Err_Proc_Ev); + raise; + end; + until (FCancel) or (FActiveConnections = 0); + finally + FreeAndNil(BS); + end; + PrepareForExit; + end; -procedure TCustomIEDownload.SetDownloadMethod(const Value: TDownloadMethod); -begin - FDownloadMethod := Value; -end; + function TCustomIEDownload.GoAction(const actUrl, actFileName, + actDownloadFolder: string; pmk: IMoniker; pbc: IBindCtx): Boolean; + begin + Result := False; + PrepareForStart; + hProcess := CreateEvent(nil, True, False, nil); + if (not GoInit(actUrl, actFileName, actDownloadFolder)) then + begin + PrepareForExit; + Exit; + end; + BS := TBSCB.Create(Self, pmk, pbc, True); + { Creating Download Callback } + try // Fix Deadlock? + BS.Execute; + repeat + try + if WaitForProcess(hProcess, FStartTick, FTimeOut) then + except + if Assigned(FOnError) then + FOnError(E_FAIL, Err_Proc_Ev); + raise; + end; + until (FCancel) or (FActiveConnections = 0); + finally + FreeAndNil(BS); + end; + PrepareForExit; + Result := True; + end; + + function TCustomIEDownload.URLDownloadToCacheFile + (const aUrl: string): string; + begin + Result := EmptyStr; + PrepareForStart; + if not GoInit(aUrl, '', '') then + Exit; + FDownloadTo := dtDownloadToCache; + BS := TBSCB.Create(Self, nil, nil, True); + try + BS.Execute; + BS.Terminate; + Dec(FActiveConnections); + finally + FreeAndNil(BS); + end; + SetBeforeExit; + PrepareForExit; + Result := FDownloadFolder; + end; + + function TCustomIEDownload.UrlDownloadToFile + (const aUrl: string): HResult; + begin + Result := E_FAIL; + PrepareForStart; + if not GoInit(aUrl, '', '') then + Exit; + FDownloadTo := dtDownloadToFile; + BS := TBSCB.Create(Self, nil, nil, True); + try + BS.Execute; + BS.Terminate; + Dec(FActiveConnections); + finally + FreeAndNil(BS); + end; + SetBeforeExit; + PrepareForExit; + Result := S_OK; + end; + + procedure TCustomIEDownload.SetBeforeExit; + begin + if FOpenDownloadFolder then + OpenFolder(FDownloadFolder); + if FActiveConnections = 0 then + FBusy := False; + FState := sStopped; + if Assigned(FOnStateChange) then + FOnStateChange(FState); + end; + + function TCustomIEDownload.GoInit(const inUrl: string; + const inFileName: string; + const inDownloadFolder: string): Boolean; + var + tmpNewName: WideString; + Act: TFileExistsOption; + begin + Act := FFileExistsOption; + tmpNewName := ''; + Result := False; + if FDownloadTo <> dtMoniker then + begin + if inUrl = EmptyStr then + begin + PrepareForExit; + Exit; + end; + FUrl := SetHttpProtocol(inUrl); + { We pass the Address we got to the component } + if (FValidateUrl) and not(IsUrlValid(FUrl)) then + begin + PrepareForExit; + Exit; + end; + ItemsManager.SessionList.Add(FUrl); + if FDownloadMethod = dmFile then + begin + FDownloadFolder := SetDownloadFolder(inDownloadFolder); + if FDownloadFolder = EmptyStr then + Exit; + FFileName := inFileName; + if (FFileName = EmptyStr) then + FFileName := SetFileNameFromUrl(FUrl); { First try } + if (CheckFileExists(FDownloadFolder + FFileName)) then + begin + if Assigned(FOnFileExists) then + FOnFileExists(Act, FDownloadFolder + FFileName, + tmpNewName); + case Act of + feSkip: + begin + PrepareForExit; + Exit; + end; + feRename: + begin +{$IFDEF DELPHI7_UP} + if tmpNewName = EmptyStr then + tmpNewName := TimeToStr(now, FFormatSettings) + + '_' + FFileName; +{$ELSE} + if tmpNewName = EmptyStr then + tmpNewName := TimeToStr(now) + '_' + FFileName; +{$ENDIF} + FFileName := tmpNewName; + bRenamed := True; + end; + feOverWrite: + FBindF := FBindF + [GetNewestVersion]; + end; + end; + end + else + FBindF := FBindF + [GetNewestVersion]; + end; + DoUpdate; + Result := True; + end; + + function TCustomIEDownload.WaitForProcess(var EventName: THandle; + var aStartTick, aTimeOut: Integer): Boolean; + var + dwResult: DWORD; + Msg: TMsg; + EventList: array [0 .. 0] of THandle; + begin + EventList[0] := EventName; + dwResult := MsgWaitForMultipleObjects(1, EventList, False, + DWORD(aTimeOut), QS_ALLEVENTS); + + case dwResult of + WAIT_FAILED: { Waiting failed } + begin + if Assigned(FOnError) then + FOnError(GetLastError, SysErrorMessage(GetLastError)); + end; + WAIT_TIMEOUT: { Waiting Timo out } + begin + if Assigned(FOnError) then + FOnError(GetLastError, SysErrorMessage(GetLastError)); + end; + WAIT_BSCB: { Our state to process messages } + begin + while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do + begin + TranslateMessage(Msg); + DispatchMessage(Msg); + if (Integer(GetTickCount) - aStartTick > aTimeOut) then + begin + if Assigned(FOnError) then + FOnError(GetLastError, Err_TimeOut); + end; + end; + if (Integer(GetTickCount) - aStartTick > aTimeOut) then + begin + if Assigned(FOnError) then + FOnError(GetLastError, Err_TimeOut); + end; + end; + end; + Result := (dwResult = WAIT_OBJECT_0); { We are done waiting } + end; + + function TCustomIEDownload.IsSynchronous + (iedInfo: TInfoData): Boolean; + begin { Return True if mode is Synchronous } + if iedInfo.infBindF_Value <> + (iedInfo.infBindF_Value or BINDF_ASYNCHRONOUS) then + Result := True + else + Result := False; + end; + + function TCustomIEDownload.IsAsyncMoniker + (const pmk: IMoniker): HResult; + begin + Result := UrlMon.IsAsyncMoniker(pmk); + end; + + function TCustomIEDownload.FormatSize(const Byte: Double): string; + begin + Result := IEDownloadTools.FormatSize(Byte); + end; + + function TCustomIEDownload.FormatTickToTime(const TickCount + : Cardinal): string; + begin + Result := IEDownloadTools.FormatTickToTime(TickCount); + end; + + function TCustomIEDownload.IsUrlValid + (const isUrl: string): Boolean; + var + U: TUrl; + begin + U := TUrl.Create(isUrl); + try + Result := U.IsUrlValid(isUrl); + if not Result and Assigned(FOnError) then + FOnError(GetLastError, + SysErrorMessage(GetLastError) + isUrl); + finally + U.Free; + end; + end; + + procedure TCustomIEDownload.PrepareForExit; + begin + if Assigned(FOnComplete) then + FOnComplete(Self, FDownloadedFile, FFileName, FDownloadFolder, + FFileExtension, ActiveConnections); + FState := sReady; + if Assigned(FOnStateChange) then + FOnStateChange(FState); + end; + + procedure TCustomIEDownload.PrepareForStart; + begin + FBusy := True; + bRenamed := False; + FCancel := False; + FDownloadedFile := EmptyStr; + FDownloadFolder := EmptyStr; + FFileExtension := EmptyStr; + FFileName := EmptyStr; + FFileSize := 0; + FMimeType := EmptyStr; + FServerAddress := EmptyStr; + FServerIP := EmptyStr; + FUrl := EmptyStr; + FState := sBusy; + if Assigned(FOnStateChange) then + FOnStateChange(FState); + FStartTick := GetTickCount; + Inc(FRefCount); + Inc(FActiveConnections); + end; + + procedure TCustomIEDownload.SetCodePage + (const Value: TCodePageOption); + begin + FCodePageOption := Value; + case FCodePageOption of + Ansi: + FCodePageValue := CP_ACP; + Mac: + FCodePageValue := CP_MACCP; + OEM: + FCodePageValue := CP_OEMCP; + Symbol: + FCodePageValue := CP_SYMBOL; + ThreadsAnsi: + FCodePageValue := CP_THREAD_ACP; + UTF7: + FCodePageValue := CP_UTF7; + UTF8: + FCodePageValue := CP_UTF8; + end; + end; + + procedure TCustomIEDownload.SetBindVerb(const Value: TBindVerb); + begin { Contains values that specify an action, such as an HTTP request, to be performed during the binding operation. } + FBindVerb := Value; + case FBindVerb of + Get: + FBindVerb_Value := BINDVERB_GET; + Put: + FBindVerb_Value := BINDVERB_PUT; + Post: + FBindVerb_Value := BINDVERB_POST; + Custom: + FBindVerb_Value := BINDVERB_CUSTOM; + end; + end; + + procedure TCustomIEDownload.SetFileName(const Value: string); + begin + FFileName := Value; + end; + + function TCustomIEDownload.SetFileNameFromUrl + (const aUrl: string): string; + var + Ut: TUrl; + sTmp1, sTmp2: string; + begin + if FDownloadMethod = dmFile then + begin + Ut := TUrl.Create(aUrl); + try + Ut.CrackUrl(aUrl, ICU_ESCAPE); + if AnsiPos('.', Ut.ExtraInfo) <> 0 then + sTmp1 := Ut.ExtraInfo; + Ut.QueryUrl(aUrl); + sTmp2 := Ut.Document; + finally + Ut.Free; + end; + if sTmp1 <> EmptyStr then + begin + Result := sTmp1; + Exit; + end + else + Result := sTmp2; + end; + end; + + procedure TCustomIEDownload.ExtractDataFromFile + (const aFileName: string); + begin + FDownloadedFile := aFileName; + FFileName := ExtractFileName(aFileName); + FDownloadFolder := ExtractFilePath(aFileName); + FFileExtension := ExtractFileExt(aFileName); + end; + + procedure TCustomIEDownload.SetAdditionalHeader + (const Value: TStrings); + begin { Sets additional headers to append to the HTTP request. } + FAdditionalHeader.Assign(Value); + end; + + procedure TCustomIEDownload.SetAbout(Value: string); + begin + Exit; + end; + + procedure TCustomIEDownload.SetDefaultProtocol + (const Value: string); + begin + FDefaultProtocol := (Value); + if FDefaultProtocol = EmptyStr then + FDefaultProtocol := 'http://'; + end; + + procedure TCustomIEDownload.SetUserAgent; + begin + FFullUserAgent := USER_AGENT_IE6 + '(' + FUserAgent + + ')' + #13#10; + end; + + procedure TCustomIEDownload.SetBindInfoF + (const Value: TBindInfoF_Options); + begin + FBindInfoF := Value; + Update_BindInfoF_Value; + end; + + procedure TCustomIEDownload.SetBindF2 + (const Value: TBindF2_Options); + begin + FBindF2 := Value; + Update_BindF2_Value; + end; + + procedure TCustomIEDownload.SetBindInfoOption + (const Value: TBindInfoOptions_Options); + begin + FBindInfoOption_ := Value; + Update_BindInfoOptions_Value; + end; + + procedure TCustomIEDownload.SetBindF(const Value: TBindF_Options); + begin + if FFileExistsOption = feOverWrite then + FBindF := FBindF + [GetNewestVersion]; + FBindF := Value; + Update_BindF_Value; + end; + + procedure TCustomIEDownload.SetDownloadMethod + (const Value: TDownloadMethod); + begin + FDownloadMethod := Value; + end; + + function TCustomIEDownload.SetHttpProtocol + (const aUrl: string): string; + type { Insert http to an address like bsalsa.com } + TProtocols = array [1 .. 23] of string; + const + Protocols: TProtocols = ('about', 'cdl', 'dvd', 'file', 'ftp', + 'gopher', 'http', 'ipp', 'its', 'javascript', 'local', + 'mailto', 'mk', 'msdaipp', 'ms-help', 'ms-its', 'mso', 'res', + 'sysimage', 'tv', 'vbscript', 'via', 'https'); + var + i: Integer; + begin + for i := 1 to 23 do + begin + if (AnsiPos(AnsiUpperCase(Protocols[i]), AnsiUpperCase(aUrl)) + <> 0) then + begin + Result := aUrl; + Exit; + end; + end; + Result := 'http://' + aUrl; + end; + + function TCustomIEDownload.SetDownloadFolder(const aDownloadFolder + : string): string; + begin + if (FDownloadMethod = dmFile) then + begin + Result := aDownloadFolder; + if (Result = EmptyStr) then + Result := ExtractFilePath(Application.ExeName) + DL_DIR; + if Result <> EmptyStr then + try + ForceDirectories(Result); + except + if Assigned(FOnError) then + FOnError(GetLastError, SysErrorMessage(GetLastError) + + Err_Creating_Dir); + end; + end; + end; + + function TCustomIEDownload.ResponseCodeToStr(const dwResponse + : Integer): string; + begin + Result := IEDownloadTools.ResponseCodeToStr(dwResponse); + end; + + function TCustomIEDownload.WideStringToLPOLESTR + (const Source: string): POLEStr; + begin + Result := IEDownloadTools.WideStringToLPOLESTR(Source); + end; -function TCustomIEDownload.SetHttpProtocol(const aUrl: string): string; -type {Insert http to an address like bsalsa.com } - TProtocols = array[1..23] of string; -const - Protocols: TProtocols = ( - 'about', 'cdl', 'dvd', 'file', 'ftp', 'gopher', 'http', 'ipp', 'its', - 'javascript', 'local', 'mailto', 'mk', 'msdaipp', 'ms-help', 'ms-its', - 'mso', 'res', 'sysimage', 'tv', 'vbscript', 'via', 'https'); -var - i: Integer; -begin - for i := 1 to 23 do - begin - if (AnsiPos(AnsiUpperCase(Protocols[i]), AnsiUpperCase(aUrl)) <> 0) then - begin - Result := aUrl; - Exit; - end; - end; - Result := 'http://' + aUrl; -end; +initialization -function TCustomIEDownload.SetDownloadFolder(const aDownloadFolder: string): - string; -begin - if (FDownloadMethod = dmFile) then - begin - Result := aDownloadFolder; - if (Result = EmptyStr) then - Result := ExtractFilePath(Application.ExeName) + DL_DIR; - if Result <> EmptyStr then - try - ForceDirectories(Result); - except - if Assigned(FOnError) then - FOnError(GetLastError, SysErrorMessage(GetLastError) + - Err_Creating_Dir); - end; - end; -end; +coInitialize(nil); -function TCustomIEDownload.ResponseCodeToStr(const dwResponse: Integer): string; -begin - Result := IEDownloadTools.ResponseCodeToStr(dwResponse); -end; +finalization -function TCustomIEDownload.WideStringToLPOLESTR(const Source: string): POleStr; -begin - Result := IEDownloadTools.WidestringToLPOLESTR(Source); -end; +coUninitialize; -initialization - coInitialize(nil); -finalization - coUninitialize; end. - diff --git a/Source/IEDownloadAcc.pas b/Source/IEDownloadAcc.pas index 4e7e5ac..a8847fa 100644 --- a/Source/IEDownloadAcc.pas +++ b/Source/IEDownloadAcc.pas @@ -40,7 +40,7 @@ interface {$I EWB.inc} uses - ActiveX, SysUtils, ShlObj, Windows, UrlMon, IEConst; + ActiveX, SysUtils, ShlObj, Windows, UrlMon, EWB.IEConst; {$IFDEF DELPHI6_UP} type diff --git a/Source/IEDownloadTools.pas b/Source/IEDownloadTools.pas index b95dc37..b0d96e8 100644 --- a/Source/IEDownloadTools.pas +++ b/Source/IEDownloadTools.pas @@ -38,7 +38,7 @@ interface uses - Windows, IeConst, SysUtils, ActiveX; + Windows, EWB.IeConst, SysUtils, ActiveX; function ResponseCodeToStr(dwResponse: Integer): string; function FormatSize(Byte: Double): string; diff --git a/Source/IEGuid.pas b/Source/IEGuid.pas index e367e03..f1b11e8 100644 --- a/Source/IEGuid.pas +++ b/Source/IEGuid.pas @@ -45,7 +45,7 @@ interface uses - Mshtml_Ewb, Clipbrd, Comobj, Activex, Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs; + Clipbrd, Comobj, Activex, Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs; type diff --git a/Source/IEParser.pas b/Source/IEParser.pas index 5d52378..7870e5f 100644 --- a/Source/IEParser.pas +++ b/Source/IEParser.pas @@ -272,7 +272,7 @@ TIEParser = class( implementation uses - IEConst, IEDownloadStrings, IEDownloadTools, SysUtils, IeDownloadAcc, UrlMon, WinInet; + EWB.IEConst, IEDownloadStrings, IEDownloadTools, SysUtils, IeDownloadAcc, UrlMon, WinInet; function TIEParser.GetContainer(out container: IOleContainer): HRESULT; diff --git a/Source/IETravelLog.pas b/Source/IETravelLog.pas index 7c8c0e5..ef39c58 100644 --- a/Source/IETravelLog.pas +++ b/Source/IETravelLog.pas @@ -42,7 +42,7 @@ interface {$I EWB.inc} uses - Activex, Windows, Classes, EmbeddedWB, IEConst, EwbAcc; + Activex, Windows, Classes, EmbeddedWB, EWB.IEConst, EwbAcc; type TOnEntryEvent = procedure(Title, Url: WideString; var Cancel: Boolean) of object; diff --git a/Source/ImportFavorites.pas b/Source/ImportFavorites.pas index 6a860c9..4c5188a 100644 --- a/Source/ImportFavorites.pas +++ b/Source/ImportFavorites.pas @@ -144,7 +144,7 @@ TImportFavorite = class(TComponent) implementation uses - IEConst, EwbCoreTools; + EWB.IEConst; constructor TImportFavorite.Create; begin diff --git a/Source/MenuContext.pas b/Source/MenuContext.pas index 0174139..d9b7a6b 100644 --- a/Source/MenuContext.pas +++ b/Source/MenuContext.pas @@ -38,6 +38,8 @@ interface +{$I EWB.inc} + uses Windows, Classes, ShlObj, ActiveX; @@ -416,7 +418,9 @@ function InvokeListInterfaceElement(const Directory: string; Items: TStringList; FreeMem(ItemPIDLs); end; ShellMalloc.Free(FolderID); + {$IFNDEF DELPHIX_SEATTLE_UP } ShellMalloc._Release; + {$ENDIF} end; function NextPIDL(PIDL: PItemIDList): PItemIDList; diff --git a/Source/RichEditBrowser.pas b/Source/RichEditBrowser.pas index 41b1a0f..dc82a9f 100644 --- a/Source/RichEditBrowser.pas +++ b/Source/RichEditBrowser.pas @@ -1,40 +1,40 @@ -//***************************************************************** -// Rich Edit for Web Browser * -// * -// For Delphi 5 to XE * -// Freeware Component * -// by * -// Eran Bodankin (bsalsa) * -// bsalsa@gmail.com * -// Based on a Ideas from: http://www.torry.net/ * -// * -// Documentation and updated versions: * -// http://www.bsalsa.com * -//***************************************************************** - -{*******************************************************************************} -{LICENSE: -THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, -EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED -WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. -YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE -AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE -AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE -OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED -OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, -INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR -OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, -AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY -DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. - -You may use, change or modify the component under 4 conditions: -1. In your website, add a link to "http://www.bsalsa.com" -2. In your application, add credits to "Embedded Web Browser" -3. Mail me (bsalsa@gmail.com) any code change in the unit - for the benefit of the other users. -4. Please consider donation in our web site! -{*******************************************************************************} -//$Id: RichEditBrowser.pas,v 1.2 2006/11/15 21:01:44 sergev Exp $ +// ***************************************************************** +// Rich Edit for Web Browser * +// * +// For Delphi 5 to XE * +// Freeware Component * +// by * +// Eran Bodankin (bsalsa) * +// bsalsa@gmail.com * +// Based on a Ideas from: http://www.torry.net/ * +// * +// Documentation and updated versions: * +// http://www.bsalsa.com * +// ***************************************************************** + +{ ******************************************************************************* } +{ LICENSE: + THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, + EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED + WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. + YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE + AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE + AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE + OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED + OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, + INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR + OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, + AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY + DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. + + You may use, change or modify the component under 4 conditions: + 1. In your website, add a link to "http://www.bsalsa.com" + 2. In your application, add credits to "Embedded Web Browser" + 3. Mail me (bsalsa@gmail.com) any code change in the unit + for the benefit of the other users. + 4. Please consider donation in our web site! + {******************************************************************************* } +// $Id: RichEditBrowser.pas,v 1.2 2006/11/15 21:01:44 sergev Exp $ unit RichEditBrowser; @@ -43,8 +43,12 @@ interface {$I EWB.inc} uses - Windows, Messages, Classes, Controls, ComCtrls, ExtCtrls, Graphics, ComObj, Menus, - HighLightHTML, HighLightXML, EmbeddedWB, ImgList, RichEdit, ClipBrd, ActiveX; + Windows, Messages, Classes, Controls, ComCtrls, ExtCtrls, Graphics, ComObj, + Menus, + HighLightHTML, HighLightXML, EmbeddedWB, +{$IFDEF DELPHIXE8_UP} + +{$ENDIF} ImgList, System.UITypes, RichEdit, ClipBrd, ActiveX; const REO_GETOBJ_NO_INTERFACES = $00000000; @@ -85,15 +89,16 @@ interface clHyperlink = clBlue; clHyperlinkBk = clWindow; -// type - // TRichEditVersion = 1..4; + // type + // TRichEditVersion = 1..4; type TURLClickEvent = procedure(Sender: TObject; const URL: string) of object; TTextAlignment = (taLeftJustify, taRightJustify, taCenter); TThemes = (tDefault, tXP, tBlack, tAluminum, tLight); + type - TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte; cb: - Longint; var pcb: Longint): DWORD; stdcall; + TEditStreamCallBack = function(dwCookie: Longint; pbBuff: PByte; cb: Longint; + var pcb: Longint): DWORD; stdcall; TEditStream = record dwCookie: Longint; @@ -105,15 +110,15 @@ TEditStream = record ['{00020d03-0000-0000-c000-000000000046}'] function GetNewStorage(out stg: IStorage): HResult; stdcall; function GetInPlaceContext(out Frame: IOleInPlaceFrame; - out Doc: IOleInPlaceUIWindow; - lpFrameInfo: POleInPlaceFrameInfo): HResult; stdcall; + out Doc: IOleInPlaceUIWindow; lpFrameInfo: POleInPlaceFrameInfo) + : HResult; stdcall; function ShowContainerUI(fShow: BOOL): HResult; stdcall; function QueryInsertObject(const clsid: TCLSID; const stg: IStorage; cp: Longint): HResult; stdcall; function DeleteObject(const oleobj: IOleObject): HResult; stdcall; function QueryAcceptData(const dataobj: IDataObject; - var cfFormat: TClipFormat; reco: DWORD; fReally: BOOL; - hMetaPict: HGLOBAL): HResult; stdcall; + var cfFormat: TClipFormat; reco: DWORD; fReally: BOOL; hMetaPict: HGLOBAL) + : HResult; stdcall; function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall; function GetClipboardData(const chrg: TCharRange; reco: DWORD; out dataobj: IDataObject): HResult; stdcall; @@ -123,7 +128,6 @@ TEditStream = record const chrg: TCharRange; out Menu: HMENU): HResult; stdcall; end; - type TRichEditOleCallback = class(TInterfacedObject, IRichEditOleCallback) public @@ -136,14 +140,15 @@ TRichEditOleCallback = class(TInterfacedObject, IRichEditOleCallback) function GetContextMenu(seltype: Word; const oleobj: IOleObject; const chrg: TCharRange; out Menu: HMENU): HResult; stdcall; function GetInPlaceContext(out Frame: IOleInPlaceFrame; - out Doc: IOleInPlaceUIWindow; - lpFrameInfo: POleInPlaceFrameInfo): HResult; stdcall; + out Doc: IOleInPlaceUIWindow; lpFrameInfo: POleInPlaceFrameInfo) + : HResult; stdcall; function ShowContainerUI(fShow: BOOL): HResult; stdcall; function QueryInsertObject(const clsid: TCLSID; const stg: IStorage; cp: Longint): HResult; stdcall; function DeleteObject(const oleobj: IOleObject): HResult; stdcall; - function QueryAcceptData(const dataobj: IDataObject; var cfFormat: TClipFormat; - reco: DWORD; fReally: BOOL; hMetaPict: HGLOBAL): HResult; stdcall; + function QueryAcceptData(const dataobj: IDataObject; + var cfFormat: TClipFormat; reco: DWORD; fReally: BOOL; hMetaPict: HGLOBAL) + : HResult; stdcall; function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall; function GetDragDropEffect(fDrag: BOOL; grfKeyState: DWORD; var dwEffect: DWORD): HResult; stdcall; @@ -152,18 +157,18 @@ TRichEditOleCallback = class(TInterfacedObject, IRichEditOleCallback) TRichEditWB = class(TRichEdit) private - // OldStatusBarW : Integer; + // OldStatusBarW : Integer; FAcceptDragComponnents: boolean; FAcceptDragFiles: boolean; - FAutoNavigate: Boolean; + FAutoNavigate: boolean; FEmbeddedWB: TEmbeddedWB; FFileName: string; - FHideCaret: Boolean; - FHighlightURL: Boolean; - FHTMLHighlight: Boolean; + FHideCaret: boolean; + FHighlightURL: boolean; + FHTMLHighlight: boolean; FImage: TImage; - FModified: Boolean; - FMoreThen64KB: Boolean; + FModified: boolean; + FMoreThen64KB: boolean; FOnURLClick: TURLClickEvent; FSelPos: Integer; FStatusbar: TStatusbar; @@ -172,13 +177,13 @@ TRichEditWB = class(TRichEdit) FTextAlignment: TAlignment; FTopGap, fLeftGap: Integer; FRightGap, fBottomGap: Integer; - FXMLHighlight: Boolean; + FXMLHighlight: boolean; FPopupVerbMenu: TPopupMenu; - FAutoVerbMenu: Boolean; + FAutoVerbMenu: boolean; FMyCallback: TRichEditOleCallback; - inserted: Boolean; - function GetCanUndo: Boolean; - function GetModified: Boolean; + inserted: boolean; + function GetCanUndo: boolean; + function GetModified: boolean; function GetRTFText: string; procedure CheckFileSave; procedure ClearAll(Sender: TObject); @@ -197,9 +202,9 @@ TRichEditWB = class(TRichEdit) procedure ReplaceDialogReplace(Sender: TObject); procedure SetEditRect; procedure SetFileName(const FileName: string); - procedure SetHideCaret(const Value: Boolean); - procedure SetHyperlink(Setlink: Boolean; wParam: Integer); - procedure SetModified(Value: Boolean); + procedure SetHideCaret(const Value: boolean); + procedure SetHyperlink(Setlink: boolean; wParam: Integer); + procedure SetModified(Value: boolean); procedure SetRTFText(RichText: string); procedure SetTextAlignment(al: TAlignment); procedure UpdateInfo; @@ -239,27 +244,27 @@ TRichEditWB = class(TRichEdit) constructor Create(AOwner: TComponent); override; procedure Loaded; override; destructor Destroy; override; - function AddBitmapFromImagelist(const ASource: TCustomImageList; const - AImageIndex: TImageIndex): Integer; + function AddBitmapFromImagelist(const ASource: TCustomImageList; + const AImageIndex: TImageIndex): Integer; function AddBullets: Integer; - function AddButton(bCaption, bName: string; reLeft, bLeft, bTop: Integer): Integer; - function AddCheckBox(cbCaption, cbName: string; reLeft, cbLeft, cbTop: - Integer; Chk: Boolean): Integer; + function AddButton(bCaption, bName: string; + reLeft, bLeft, bTop: Integer): Integer; + function AddCheckBox(cbCaption, cbName: string; + reLeft, cbLeft, cbTop: Integer; Chk: boolean): Integer; function AddDateAndTime: Integer; - function AddEditBox(eText, eName: string; reLeft, eLeft, eTop: Integer): Integer; + function AddEditBox(eText, eName: string; + reLeft, eLeft, eTop: Integer): Integer; function AddEmptyLine: Integer; - function AddFile(FilePath: string; Linked: bool; AsIcon: - Bool): Integer; - function AddFiles(Files: TStrings; Linked: bool; AsIcon: - Bool): Integer; - function AddFormatedText(const txt: string; Bold, Italic, Strikeout, Underline: - boolean; txtColor: TColor): Integer; + function AddFile(FilePath: string; Linked: BOOL; AsIcon: BOOL): Integer; + function AddFiles(Files: TStrings; Linked: BOOL; AsIcon: BOOL): Integer; + function AddFormatedText(const txt: string; + Bold, Italic, Strikeout, Underline: boolean; txtColor: TColor): Integer; function AddImage(FilePath: string): Integer; function AddImages(Files: TStrings): Integer; function AddImageUsingClipboard(FilePath: string): Integer; function AddLineNumbering: Integer; - function AddRadioButton(rbCaption, rbName: string; reLeft, rbLeft, rbTop: - Integer; Chk: boolean): Integer; + function AddRadioButton(rbCaption, rbName: string; + reLeft, rbLeft, rbTop: Integer; Chk: boolean): Integer; function AddRomanNumbering: Integer; function AddRTFSelection(sourceStream: TStream): Integer; function AddRtfText(str: string): Integer; @@ -272,13 +277,13 @@ TRichEditWB = class(TRichEdit) function GetLineFromChar(CharIndex: Integer): Integer; function GetLineIndex(LineNo: Integer): Integer; function GetLineLength(CharIndex: Integer): Integer; - function GetNextWord(var s: string; var PrevWord: string): string; + function GetNextWord(var S: string; var PrevWord: string): string; function GetRTFSelection(intoStream: TStream): string; function GetRTFTextToString: string; function GetSelectedText(var SelectedText: string): boolean; function GetVisibleLines: Integer; - function IsNumber(s: string): Boolean; - function IsSeparator(Car: Char): Boolean; + function IsNumber(S: string): boolean; + function IsSeparator(Car: Char): boolean; function RemoveTextFormats: Integer; function SearchAndReplace(InSearch, InReplace: string): Integer; function SearchForTextAndSelect(SearchText: string): string; @@ -327,51 +332,52 @@ TRichEditWB = class(TRichEdit) procedure SetLineSpacing(lineSpacing: Byte); procedure SetOffSetsValues(SetTo: Integer); procedure SetSelectedBgColor; - procedure SetSelectionHyperLink(Hyperlink: Boolean); + procedure SetSelectionHyperLink(Hyperlink: boolean); procedure SetTabWidth(FTabWidth: Integer); procedure SetThemes(Thm: TThemes); procedure SetToMoreThen64KB; procedure SetToOEM(var Key: AnsiChar); - procedure SetWordHyperLink(Hyperlink: Boolean); + procedure SetWordHyperLink(Hyperlink: boolean); procedure UndoLast(Sender: TObject); - property CanUndo: Boolean read GetCanUndo; - property Modified: Boolean read GetModified write SetModified; - property AutoVerbMenu: boolean read FAutoVerbMenu write FAutoVerbMenu default True; + property CanUndo: boolean read GetCanUndo; + property Modified: boolean read GetModified write SetModified; + property AutoVerbMenu: boolean read FAutoVerbMenu write FAutoVerbMenu + default True; published procedure DblClick; override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure KeyPress(var Key: Char); override; - procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: - Integer); override; + procedure MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; - procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: - Integer); override; - property AcceptDragComponnents: Boolean read fAcceptDragComponnents write - fAcceptDragComponnents default True; - property AcceptDragFiles: Boolean read fAcceptDragFiles write - fAcceptDragFiles default True; - property AutoNavigate: boolean read fAutoNavigate write fAutoNavigate; + procedure MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); override; + property AcceptDragComponnents: boolean read FAcceptDragComponnents + write FAcceptDragComponnents default True; + property AcceptDragFiles: boolean read FAcceptDragFiles + write FAcceptDragFiles default True; + property AutoNavigate: boolean read FAutoNavigate write FAutoNavigate; property EmbeddedWB: TEmbeddedWB read FEmbeddedWB write FEmbeddedWB; - property FileName: string read fFileName write SetFileName; - property GapBottom: Integer read FBottomGap write setBottomGap default 0; - property GapLeft: Integer read FLeftGap write setLeftGap default 0; + property FileName: string read FFileName write SetFileName; + property GapBottom: Integer read fBottomGap write setBottomGap default 0; + property GapLeft: Integer read fLeftGap write setLeftGap default 0; property GapRight: Integer read FRightGap write setRightGap default 0; property GapTop: Integer read FTopGap write setTopGap default 0; - property HighlightHTML: boolean read fHTMLHighlight write fHTMLHighlight; - property HighlightURL: boolean read fHighlightURL write fHighlightURL; - property HighlightXML: boolean read fXMLHighlight write fXMLHighlight; - property Image: TImage read fImage write fImage; + property HighLightHTML: boolean read FHTMLHighlight write FHTMLHighlight; + property HighlightURL: boolean read FHighlightURL write FHighlightURL; + property HighLightXML: boolean read FXMLHighlight write FXMLHighlight; + property Image: TImage read FImage write FImage; property OnURLClick: TURLClickEvent read FOnURLClick write FOnURLClick; property RTFText: string read GetRTFText write SetRTFText; - property Statusbar: TStatusbar read fStatusbar write fStatusbar; - property SupprtMoreThen64KB: boolean read fMoreThen64KB write fMoreThen64KB; - property TextAlignment: TAlignment read fTextAlignment write fTextAlignment; - property HideCaret: Boolean read FHideCaret write SetHideCaret; + property Statusbar: TStatusbar read FStatusbar write FStatusbar; + property SupprtMoreThen64KB: boolean read FMoreThen64KB write FMoreThen64KB; + property TextAlignment: TAlignment read FTextAlignment write FTextAlignment; + property HideCaret: boolean read FHideCaret write SetHideCaret; property Themes: TThemes read FThemes write FThemes; property Align; - property Alignment; + property alignment; property Anchors; property BevelEdges; property BevelInner; @@ -442,7 +448,7 @@ TRichEditWB = class(TRichEdit) type TREObject = packed record cbStruct: DWORD; - cp: longint; + cp: Longint; clsid: TCLSID; oleobj: IOleObject; stg: IStorage; @@ -454,18 +460,19 @@ TRichEditWB = class(TRichEdit) end; type - IRichEditOle = interface(IUnknown)['{00020d00-0000-0000-c000-000000000046}'] - function GetClientSite(out clientSite: IOleClientSite): HResult; stdcall; + IRichEditOle = interface(IUnknown) + ['{00020d00-0000-0000-c000-000000000046}'] + function GetClientSite(out clientSite: IOLEClientSite): HResult; stdcall; function GetObjectCount: HResult; stdcall; function GetLinkCount: HResult; stdcall; - function GetObject(iob: Longint; out reobject: TReObject; - dwFlags: DWORD): HResult; stdcall; - function InsertObject(var reobject: TReObject): HResult; stdcall; + function GetObject(iob: Longint; out reobject: TREObject; dwFlags: DWORD) + : HResult; stdcall; + function InsertObject(var reobject: TREObject): HResult; stdcall; function ConvertObject(iob: Longint; rclsidNew: TIID; lpstrUsertypeNew: LPCSTR): HResult; stdcall; function ActivateAs(rclsid: TIID; rclsidAs: TIID): HResult; stdcall; - function SetHostNames(lpstrContainerApp: LPCSTR; - lpstrContainerObj: LPCSTR): HResult; stdcall; + function SetHostNames(lpstrContainerApp: LPCSTR; lpstrContainerObj: LPCSTR) + : HResult; stdcall; function SetLinkAvailable(iob: Longint; fAvailable: BOOL): HResult; stdcall; function SetDvaspect(iob: Longint; dvaspect: DWORD): HResult; stdcall; function HandsOffStorage(iob: Longint): HResult; stdcall; @@ -478,21 +485,23 @@ TRichEditWB = class(TRichEdit) hMetaPict: HGLOBAL): HResult; stdcall; end; - - -procedure CreateIStorage(out Fstorage: Istorage); -function GetRichOleInterface(ARichEdit: TRichEdit; out RichOleInterface: IRichEditOle; out OleClientSite: IOleclientSite): boolean; -procedure REOleSetCallback(RichEdit: TRichEdit; OleInterface: IRichEditOleCallback); +procedure CreateIStorage(out Fstorage: IStorage); +function GetRichOleInterface(ARichEdit: TRichEdit; + out RichOleInterface: IRichEditOle; + out OleClientSite: IOLEClientSite): boolean; +procedure REOleSetCallback(RichEdit: TRichEdit; + OleInterface: IRichEditOleCallback); procedure ReleaseObject(var Obj); -function SetFormatEtc(Cf: TClipFormat; med: Longint; td: PDVTargetDevice = nil; +function SetFormatEtc(cf: TClipFormat; med: Longint; td: PDVTargetDevice = nil; Asp: Longint = DVASPECT_CONTENT; li: Longint = -1): TFormatEtc; function OleSwitchDisplayAspect(OleObject: IOleObject; var CurrentAspect: DWORD; - NewAspect: DWORD; METAFILEPICT: THandle; DeleteOldAspect, SetUpViewAdvise: boolean; - AdviseSink: IAdviseSink; var MustUpdate: boolean): HRESULT; + NewAspect: DWORD; METAFILEPICT: THandle; + DeleteOldAspect, SetUpViewAdvise: boolean; AdviseSink: IAdviseSink; + var MustUpdate: boolean): HResult; function GetOleClassFile(const Name: string): TCLSID; function OleCopyPasString(const Source: string; Malloc: IMalloc = nil): POleStr; -function SetStgMedium(Stg, Handle: longint; Release: pointer = nil): TStgMedium; -procedure OleFreeString(Str: POleStr; Malloc: IMalloc = nil); +function SetStgMedium(stg, Handle: Longint; Release: pointer = nil): TStgMedium; +procedure OleFreeString(str: POleStr; Malloc: IMalloc = nil); function OleMalloc(Size: Longword; Malloc: IMalloc = nil): pointer; procedure OleFree(Mem: pointer; Malloc: IMalloc = nil); procedure ChangeOleIcon(REdit: TRichEdit; HIcon: Hwnd; LabelIcon: string); @@ -502,7 +511,7 @@ procedure AddBitmapToRichEdit(bmp: TBitmap; RichEdit: TRichEditWB); FRichEditModule: THandle; RichEditOle: IRichEditOle; RichEditOleCallback: IRichEditOleCallback; - // RichEditVersion : TRichEditVersion; + // RichEditVersion : TRichEditVersion; implementation @@ -516,7 +525,7 @@ implementation sSaveChanges = 'Save changes to %s?'; sOverWrite = 'The file already exist. Do you want to overwrite %s ?'; sUntitled = 'Untitled'; -// sModified = 'Modified'; + // sModified = 'Modified'; sColRowInfo = 'Line: %3d Col: %3d'; type @@ -524,19 +533,25 @@ TImageDataObject = class(TInterfacedObject, IDataObject) private FMedium: STGMEDIUM; FFormat: FORMATETC; - FHasData: Boolean; + FHasData: boolean; protected - function GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium): HResult; stdcall; - function GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium): HResult; stdcall; - function QueryGetData(const formatetc: TFormatEtc): HResult; stdcall; - function GetCanonicalFormatEtc(const formatetc: TFormatEtc; out formatetcOut: TFormatEtc): HResult; stdcall; - function SetData(const formatetc: TFormatEtc; var medium: TStgMedium; fRelease: BOOL): HResult; stdcall; - function EnumFormatEtc(dwDirection: Longint; out enumFormatEtc: IEnumFormatEtc): HResult; stdcall; - function DAdvise(const formatetc: TFormatEtc; advf: Longint; const advSink: IAdviseSink; out dwConnection: Longint): HResult; stdcall; + function GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium) + : HResult; stdcall; + function GetDataHere(const FORMATETC: TFormatEtc; out medium: TStgMedium) + : HResult; stdcall; + function QueryGetData(const FORMATETC: TFormatEtc): HResult; stdcall; + function GetCanonicalFormatEtc(const FORMATETC: TFormatEtc; + out formatetcOut: TFormatEtc): HResult; stdcall; + function SetData(const FORMATETC: TFormatEtc; var medium: TStgMedium; + fRelease: BOOL): HResult; stdcall; + function EnumFormatEtc(dwDirection: Longint; + out EnumFormatEtc: IEnumFormatEtc): HResult; stdcall; + function DAdvise(const FORMATETC: TFormatEtc; advf: Longint; + const advSink: IAdviseSink; out dwConnection: Longint): HResult; stdcall; function DUnadvise(dwConnection: Longint): HResult; stdcall; function EnumDAdvise(out enumAdvise: IEnumStatData): HResult; stdcall; procedure SetBitmap(const ASource: TBitmap); - function GetOleObject(const AClient: IOleClientSite; + function GetOleObject(const AClient: IOLEClientSite; const AStorage: IStorage): IOleObject; public class procedure InsertBitmap(ADest: TCustomRichEdit; ASource: TBitmap); @@ -548,70 +563,71 @@ class procedure TImageDataObject.InsertBitmap; idoImage: TImageDataObject; ifOLE: IRichEditOle; ifData: IDataObject; - ifClient: IOleClientSite; + ifClient: IOLEClientSite; ifStorage: IStorage; ifBytes: ILockBytes; ifOLEObject: IOleObject; - sCode: HRESULT; + sCode: HResult; reObj: TREObject; gdClass: TGUID; begin ifOLE := nil; SendMessage(ADest.Handle, EM_GETOLEINTERFACE, 0, LPARAM(@ifOLE)); if Assigned(ifOLE) then - try - idoImage := TImageDataObject.Create(); - if idoImage.GetInterface(IDataObject, ifData) then try - idoImage.SetBitmap(ASource); - ifClient := nil; - ifOLE.GetClientSite(ifClient); - if Assigned(ifClient) then - try - ifBytes := nil; - sCode := CreateILockBytesOnHGlobal(0, True, ifBytes); - if (sCode = S_OK) and (Assigned(ifBytes)) then + idoImage := TImageDataObject.Create(); + if idoImage.GetInterface(IDataObject, ifData) then try - sCode := StgCreateDocfileOnILockBytes(ifBytes, STGM_SHARE_EXCLUSIVE or - STGM_CREATE or STGM_READWRITE, 0, ifStorage); - if sCode = S_OK then - try - ifOLEObject := idoImage.GetOleObject(ifClient, ifStorage); - if Assigned(ifOLEObject) then + idoImage.SetBitmap(ASource); + ifClient := nil; + ifOLE.GetClientSite(ifClient); + if Assigned(ifClient) then try - OleSetContainedObject(ifOLEObject, True); - sCode := ifOLEObject.GetUserClassID(gdClass); - if sCode = S_OK then - begin - with reObj do - begin - //clsid := ''; - cp := LongInt(REO_CP_SELECTION); - dvaspect := DVASPECT_CONTENT; - oleobj := ifOLEObject; - olesite := ifClient; - stg := ifStorage; + ifBytes := nil; + sCode := CreateILockBytesOnHGlobal(0, True, ifBytes); + if (sCode = S_OK) and (Assigned(ifBytes)) then + try + sCode := StgCreateDocfileOnILockBytes(ifBytes, + STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, 0, + ifStorage); + if sCode = S_OK then + try + ifOLEObject := idoImage.GetOleObject(ifClient, ifStorage); + if Assigned(ifOLEObject) then + try + OleSetContainedObject(ifOLEObject, True); + sCode := ifOLEObject.GetUserClassID(gdClass); + if sCode = S_OK then + begin + with reObj do + begin + // clsid := ''; + cp := Longint(REO_CP_SELECTION); + dvaspect := DVASPECT_CONTENT; + oleobj := ifOLEObject; + olesite := ifClient; + stg := ifStorage; + end; + ifOLE.InsertObject(reObj); + end; + finally + ifOLEObject := nil; + end; + finally + ifStorage := nil; + end; + finally + ifBytes := nil; end; - ifOLE.InsertObject(reObj); - end; finally - ifOLEObject := nil; + ifClient := nil; end; - finally - ifStorage := nil; - end; finally - ifBytes := nil; + ifData := nil; end; - finally - ifClient := nil; - end; finally - ifData := nil; + ifOLE := nil; end; - finally - ifOLE := nil; - end; end; procedure TImageDataObject.SetBitmap; @@ -628,10 +644,10 @@ procedure TImageDataObject.SetBitmap; function TImageDataObject.GetOleObject; var - sCode: HRESULT; + sCode: HResult; begin - sCode := OleCreateStaticFromData(Self, IOleObject, OLERendER_FORMAT, - @FFormat, AClient, AStorage, Result); + sCode := OleCreateStaticFromData(Self, IOleObject, OLERendER_FORMAT, @FFormat, + AClient, AStorage, Result); if sCode <> S_OK then begin OleCheck(sCode); @@ -681,7 +697,7 @@ function TImageDataObject.GetCanonicalFormatEtc; function TImageDataObject.SetData; begin FMedium := medium; - FFormat := formatetc; + FFormat := FORMATETC; FHasData := True; Result := S_OK; end; @@ -706,7 +722,8 @@ function TImageDataObject.EnumDAdvise; Result := E_NOTIMPL; end; -function TRichEditOleCallback.QueryInterface(const iid: TGUID; out Obj): HResult; +function TRichEditOleCallback.QueryInterface(const iid: TGUID; out Obj) + : HResult; begin if GetInterface(iid, Obj) then Result := S_OK @@ -714,13 +731,13 @@ function TRichEditOleCallback.QueryInterface(const iid: TGUID; out Obj): HResult Result := E_NOINTERFACE; end; -function TRichEditOleCallback._AddRef: LongInt; +function TRichEditOleCallback._AddRef: Longint; begin Inc(FRefCount); Result := FRefCount; end; -function TRichEditOleCallback._Release: LongInt; +function TRichEditOleCallback._Release: Longint; begin Dec(FRefCount); Result := FRefCount; @@ -736,27 +753,27 @@ function TRichEditOleCallback.GetNewStorage(out stg: IStorage): HResult; end; end; -function TRichEditOleCallback.GetClipboardData(const chrg: TCharRange; reco: DWORD; - out dataobj: IDataObject): HResult; +function TRichEditOleCallback.GetClipboardData(const chrg: TCharRange; + reco: DWORD; out dataobj: IDataObject): HResult; begin Result := E_NOTIMPL; end; function TRichEditOleCallback.GetContextMenu(seltype: Word; - const oleobj: IOleObject; const chrg: TCharRange; - out Menu: HMENU): HResult; + const oleobj: IOleObject; const chrg: TCharRange; out Menu: HMENU): HResult; begin - // menu:=0; + // menu:=0; Result := S_OK; // Result := E_NOTIMPL; end; -function TRichEditOleCallback.GetInPlaceContext(out Frame: IOleInPlaceFrame; out Doc: IOleInPlaceUIWindow; lpFrameInfo: POleInPlaceFrameInfo): HResult; +function TRichEditOleCallback.GetInPlaceContext(out Frame: IOleInPlaceFrame; + out Doc: IOleInPlaceUIWindow; lpFrameInfo: POleInPlaceFrameInfo): HResult; begin Result := S_OK; end; -function TRichEditOleCallback.QueryInsertObject(const clsid: TCLSID; const stg: IStorage; - cp: Longint): HResult; +function TRichEditOleCallback.QueryInsertObject(const clsid: TCLSID; + const stg: IStorage; cp: Longint): HResult; begin Result := NOERROR; end; @@ -791,27 +808,31 @@ function TRichEditOleCallback.ShowContainerUI(fShow: BOOL): HResult; Result := S_OK; end; -procedure CreateIStorage(out Fstorage: Istorage); +procedure CreateIStorage(out Fstorage: IStorage); var - FlockBytes: IlockBytes; + FlockBytes: ILockBytes; begin - OleCheck(CreateILockBytesOnHGlobal(0, True, FLockBytes)); - OleCheck(StgCreateDocfileOnILockBytes(FLockBytes, STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, 0, FStorage)) + OleCheck(CreateILockBytesOnHGlobal(0, True, FlockBytes)); + OleCheck(StgCreateDocfileOnILockBytes(FlockBytes, STGM_SHARE_EXCLUSIVE or + STGM_CREATE or STGM_READWRITE, 0, Fstorage)) end; -function GetRichOleInterface(ARichEdit: TRichEdit; out RichOleInterface: IRichEditOle; out OleClientSite: IOleclientSite): boolean; +function GetRichOleInterface(ARichEdit: TRichEdit; + out RichOleInterface: IRichEditOle; + out OleClientSite: IOLEClientSite): boolean; var AppName: AnsiString; begin Result := False; - if boolean(SendMessage(ARichEdit.Handle, EM_GETOLEINTERFACE, 0, longint(@RichOleInterface))) then + if boolean(SendMessage(ARichEdit.Handle, EM_GETOLEINTERFACE, 0, + Longint(@RichOleInterface))) then begin try AppName := AnsiString(Application.Title); if Trim(AppName) = '' then AppName := AnsiString(ExtractFileName(Application.ExeName)); RichOleInterface.SetHostNames(PAnsiChar(AppName), PAnsiChar(AppName)); - RichOleInterface.GetClientSite(OleclientSite); + RichOleInterface.GetClientSite(OleClientSite); Result := True; except Result := False; @@ -819,9 +840,10 @@ function GetRichOleInterface(ARichEdit: TRichEdit; out RichOleInterface: IRichEd end; end; -procedure REOleSetCallback(RichEdit: TRichEdit; OleInterface: IRichEditOleCallback); +procedure REOleSetCallback(RichEdit: TRichEdit; + OleInterface: IRichEditOleCallback); begin - SendMessage(RichEdit.Handle, EM_SETOLECALLBACK, 0, LPARAM(Oleinterface)); + SendMessage(RichEdit.Handle, EM_SETOLECALLBACK, 0, LPARAM(OleInterface)); end; procedure ReleaseObject(var Obj); @@ -833,13 +855,13 @@ procedure ReleaseObject(var Obj); end; end; -function SetFormatEtc(Cf: TClipFormat; med: Longint; td: PDVTargetDevice = nil; +function SetFormatEtc(cf: TClipFormat; med: Longint; td: PDVTargetDevice = nil; Asp: Longint = DVASPECT_CONTENT; li: Longint = -1): TFormatEtc; begin with Result do begin cfFormat := cf; - dwAspect := asp; + dwAspect := Asp; ptd := td; tymed := med; lindex := li @@ -847,19 +869,18 @@ function SetFormatEtc(Cf: TClipFormat; med: Longint; td: PDVTargetDevice = nil; end; function OleSwitchDisplayAspect(OleObject: IOleObject; var CurrentAspect: DWORD; - NewAspect: DWORD; METAFILEPICT: THandle; DeleteOldAspect, SetUpViewAdvise: boolean; - AdviseSink: IAdviseSink; var MustUpdate: boolean): HRESULT; + NewAspect: DWORD; METAFILEPICT: THandle; + DeleteOldAspect, SetUpViewAdvise: boolean; AdviseSink: IAdviseSink; + var MustUpdate: boolean): HResult; var OleCache: IOleCache; ViewObject: IViewObject; EnumStatData: IEnumStatData; StatData: TStatData; - FormatEtc: TFormatEtc; - Medium: TStgMedium; - Advf, - NewConnection, - OldAspect: longint; - Error: HRESULT; + FORMATETC: TFormatEtc; + medium: TStgMedium; + advf, NewConnection, OldAspect: Longint; + Error: HResult; begin OleCache := nil; ViewObject := nil; @@ -871,20 +892,21 @@ function OleSwitchDisplayAspect(OleObject: IOleObject; var CurrentAspect: DWORD; Result := E_INVALIDARG; Exit end; - FormatEtc := SetFormatEtc(0, TYMED_NULL, nil, NewAspect); + FORMATETC := SetFormatEtc(0, TYMED_NULL, nil, NewAspect); if (NewAspect = dvaspect_Icon) and (METAFILEPICT <> 0) then - Advf := advf_nodata + advf := advf_nodata else - Advf := ADVF_PRIMEFIRST; - Result := OleCache.Cache(FormatEtc, Advf, NewConnection); + advf := ADVF_PRIMEFIRST; + Result := OleCache.Cache(FORMATETC, advf, NewConnection); if Failed(Result) then Exit; CurrentAspect := NewAspect; if (NewAspect = dvaspect_Icon) and (METAFILEPICT <> 0) then begin - FormatEtc := SetFormatEtc(CF_METAFILEPICT, TYMED_MFPICT, nil, dvaspect_Icon); - Medium := SetStgMedium(TYMED_MFPICT, METAFILEPICT); - OleCache.SetData(FormatEtc, Medium, False) + FORMATETC := SetFormatEtc(CF_METAFILEPICT, TYMED_MFPICT, nil, + dvaspect_Icon); + medium := SetStgMedium(TYMED_MFPICT, METAFILEPICT); + OleCache.SetData(FORMATETC, medium, False) end else MustUpdate := True; @@ -901,7 +923,7 @@ function OleSwitchDisplayAspect(OleObject: IOleObject; var CurrentAspect: DWORD; begin Error := EnumStatData.Next(1, StatData, nil); if Error = S_OK then - if StatData.FormatEtc.dwAspect = OldAspect then + if StatData.FORMATETC.dwAspect = OldAspect then OleCache.Uncache(StatData.dwConnection) end end; @@ -939,16 +961,16 @@ function OleCopyPasString(const Source: string; Malloc: IMalloc = nil): POleStr; end end; -function SetStgMedium(Stg, Handle: longint; Release: pointer = nil): TStgMedium; +function SetStgMedium(stg, Handle: Longint; Release: pointer = nil): TStgMedium; begin - Result.tymed := Stg; - Result.hGlobal := Handle; + Result.tymed := stg; + Result.HGLOBAL := Handle; Result.unkForRelease := Release end; -procedure OleFreeString(Str: POleStr; Malloc: IMalloc = nil); +procedure OleFreeString(str: POleStr; Malloc: IMalloc = nil); begin - OleFree(Str, Malloc) + OleFree(str, Malloc) end; function OleMalloc(Size: Longword; Malloc: IMalloc = nil): pointer; @@ -977,22 +999,25 @@ procedure OleFree(Mem: pointer; Malloc: IMalloc = nil); procedure ChangeOleIcon(REdit: TRichEdit; HIcon: Hwnd; LabelIcon: string); var - Update: Boolean; + Update: boolean; Selectiontype: Integer; RichEditOle: IRichEditOle; - OleClientSite: IOleClientSite; - REObject: TReObject; + OleClientSite: IOLEClientSite; + reobject: TREObject; begin Update := True; - FillChar(ReObject, SizeOf(ReObject), 0); - ReObject.cbStruct := SizeOf(ReObject); - Selectiontype := SendMessage(Redit.Handle, EM_SELECTIONtype, 0, 0); - if selectionType = SEL_OBJECT then + FillChar(reobject, SizeOf(reobject), 0); + reobject.cbStruct := SizeOf(reobject); + Selectiontype := SendMessage(REdit.Handle, EM_SELECTIONtype, 0, 0); + if Selectiontype = SEL_OBJECT then GetRichOleInterface(REdit, RichEditOle, OleClientSite); - OleCheck(RichEditOle.GetObject(Longint(REO_IOB_SELECTION), ReObject, REO_GETOBJ_POLEOBJ or REO_GETOBJ_POLESITE)); - HIcon := OleMetafilePictFromIconAndLabel(Hicon, OleCopyPasString(LabelIcon), '', 0); - OleSwitchDisplayAspect(REObject.oleobj, REObject.dvaspect, REObject.dvaspect, Hicon, False, False, nil, Update); - OleCheck(REobject.oleobj.Update); + OleCheck(RichEditOle.GetObject(Longint(REO_IOB_SELECTION), reobject, + REO_GETOBJ_POLEOBJ or REO_GETOBJ_POLESITE)); + HIcon := OleMetafilePictFromIconAndLabel(HIcon, + OleCopyPasString(LabelIcon), '', 0); + OleSwitchDisplayAspect(reobject.oleobj, reobject.dvaspect, reobject.dvaspect, + HIcon, False, False, nil, Update); + OleCheck(reobject.oleobj.Update); end; function TRichEditWB.ConvertBitmapToRTF(pict: TBitmap): string; @@ -1033,54 +1058,60 @@ function TRichEditWB.ConvertBitmapToRTF(pict: TBitmap): string; Result := rtf; end; -function TRichEditWB.AddFiles(Files: TStrings; Linked: bool; AsIcon: Bool): Integer; +function TRichEditWB.AddFiles(Files: TStrings; Linked: BOOL; + AsIcon: BOOL): Integer; var I: Integer; FilePath: string; - Ind: word; - HIcon: hwnd; + Ind: Word; + HIcon: Hwnd; Update: boolean; - OleClientSite: IOleClientSite; + OleClientSite: IOLEClientSite; Storage: IStorage; OleObject: IOleObject; - ReObject: TReObject; - RichEditOle: IrichEditOle; + reobject: TREObject; + RichEditOle: IRichEditOle; begin Ind := 1; Update := True; - FillChar(ReObject, SizeOf(TReObject), 0); + FillChar(reobject, SizeOf(TREObject), 0); for I := 0 to Files.Count - 1 do begin FilePath := Files[I]; - if GetRichOleInterface(Self, RichEDitOle, OleClientSite) then + if GetRichOleInterface(Self, RichEditOle, OleClientSite) then begin Storage := nil; try CreateIStorage(Storage); if Linked then - OleCheck(OleCreateLinkToFile(OleCopyPasString(FilePath), IOleObject, OLERendER_DRAW, nil, OleClientSite, Storage, OleObject)) + OleCheck(OleCreateLinkToFile(OleCopyPasString(FilePath), IOleObject, + OLERendER_DRAW, nil, OleClientSite, Storage, OleObject)) else - OleCheck(OleCreateLinkToFile(OleCopyPasString(FilePath), IOleObject, OLERendER_DRAW, nil, OleClientSite, Storage, OleObject)); - with ReObject do + OleCheck(OleCreateLinkToFile(OleCopyPasString(FilePath), IOleObject, + OLERendER_DRAW, nil, OleClientSite, Storage, OleObject)); + with reobject do begin - cbStruct := SizeOf(TReObject); + cbStruct := SizeOf(TREObject); cp := Integer(REO_CP_SELECTION); - OleObject.GetUserClassId(CLSID); + OleObject.GetUserClassID(clsid); oleobj := OleObject; stg := Storage; olesite := OleClientSite; - if Asicon then - DvAspect := DVASPECT_ICON + if AsIcon then + dvaspect := dvaspect_Icon else - DvAspect := DVASPECT_CONTENT; + dvaspect := DVASPECT_CONTENT; dwFlags := REO_RESIZABLE or REO_DYNAMICSIZE; end; - if IsEqualCLSID(REObject.CLSID, CLSID_NULL) then - REObject.CLSID := GetOleClassFile(FilePath); - HIcon := ShellAPI.ExtractAssociatedIcon(Application.Handle, PChar(FilePath), Ind); - HIcon := OleMetafilePictFromIconAndLabel(Hicon, OleCopyPasString(ExtractFileName(FilePath)), '', 0); - OleSwitchDisplayAspect(OleObject, REObject.dvaspect, REObject.dvaspect, Hicon, False, False, nil, Update); - OleCheck(RichEditOle.InsertObject(ReObject)); + if IsEqualCLSID(reobject.clsid, CLSID_NULL) then + reobject.clsid := GetOleClassFile(FilePath); + HIcon := ShellAPI.ExtractAssociatedIcon(Application.Handle, + PChar(FilePath), Ind); + HIcon := OleMetafilePictFromIconAndLabel(HIcon, + OleCopyPasString(ExtractFileName(FilePath)), '', 0); + OleSwitchDisplayAspect(OleObject, reobject.dvaspect, reobject.dvaspect, + HIcon, False, False, nil, Update); + OleCheck(RichEditOle.InsertObject(reobject)); SendMessage(Self.Handle, EM_SCROLLCARET, 0, 0); OleCheck(OleObject.Update); finally @@ -1092,52 +1123,56 @@ function TRichEditWB.AddFiles(Files: TStrings; Linked: bool; AsIcon: Bool): Inte Result := Lines.Count; end; -function TRichEditWB.AddFile(FilePath: string; Linked: bool; AsIcon: Bool): Integer; +function TRichEditWB.AddFile(FilePath: string; Linked: BOOL; + AsIcon: BOOL): Integer; var - Ind: word; - HIcon: hwnd; + Ind: Word; + HIcon: Hwnd; Update: boolean; - OleClientSite: IOleClientSite; + OleClientSite: IOLEClientSite; Storage: IStorage; OleObject: IOleObject; - ReObject: TReObject; - RichEditOle: IrichEditOle; + reobject: TREObject; + RichEditOle: IRichEditOle; begin inserted := True; Ind := 1; Update := True; - FillChar(ReObject, SizeOf(TReObject), 0); - if GetRichOleInterface(Self, RichEDitOle, OleClientSite) then + FillChar(reobject, SizeOf(TREObject), 0); + if GetRichOleInterface(Self, RichEditOle, OleClientSite) then begin Storage := nil; try CreateIStorage(Storage); if Linked then - OleCheck(OleCreateLinkToFile(OleCopyPasString(FilePath), - IOleObject, OLERendER_DRAW, nil, OleClientSite, Storage, OleObject)) + OleCheck(OleCreateLinkToFile(OleCopyPasString(FilePath), IOleObject, + OLERendER_DRAW, nil, OleClientSite, Storage, OleObject)) else - OleCheck(OleCreateLinkToFile(OleCopyPasString(FilePath), - IOleObject, OLERendER_DRAW, nil, OleClientSite, Storage, OleObject)); - with ReObject do + OleCheck(OleCreateLinkToFile(OleCopyPasString(FilePath), IOleObject, + OLERendER_DRAW, nil, OleClientSite, Storage, OleObject)); + with reobject do begin - cbStruct := SizeOf(TReObject); + cbStruct := SizeOf(TREObject); cp := Integer(REO_CP_SELECTION); - OleObject.GetUserClassId(CLSID); + OleObject.GetUserClassID(clsid); oleobj := OleObject; stg := Storage; olesite := OleClientSite; - if Asicon then - DvAspect := DVASPECT_ICON + if AsIcon then + dvaspect := dvaspect_Icon else - DvAspect := DVASPECT_CONTENT; + dvaspect := DVASPECT_CONTENT; dwFlags := REO_RESIZABLE or REO_DYNAMICSIZE; end; - if IsEqualCLSID(REObject.CLSID, CLSID_NULL) then - REObject.CLSID := GetOleClassFile(FilePath); - HIcon := ShellAPI.ExtractAssociatedIcon(Application.Handle, PChar(FilePath), Ind); - HIcon := OleMetafilePictFromIconAndLabel(Hicon, OleCopyPasString(ExtractFileName(FilePath)), '', 0); - OleSwitchDisplayAspect(OleObject, REObject.dvaspect, REObject.dvaspect, Hicon, False, False, nil, Update); - OleCheck(RichEditOle.InsertObject(ReObject)); + if IsEqualCLSID(reobject.clsid, CLSID_NULL) then + reobject.clsid := GetOleClassFile(FilePath); + HIcon := ShellAPI.ExtractAssociatedIcon(Application.Handle, + PChar(FilePath), Ind); + HIcon := OleMetafilePictFromIconAndLabel(HIcon, + OleCopyPasString(ExtractFileName(FilePath)), '', 0); + OleSwitchDisplayAspect(OleObject, reobject.dvaspect, reobject.dvaspect, + HIcon, False, False, nil, Update); + OleCheck(RichEditOle.InsertObject(reobject)); SendMessage(Self.Handle, EM_SCROLLCARET, 0, 0); OleCheck(OleObject.Update); finally @@ -1145,10 +1180,10 @@ function TRichEditWB.AddFile(FilePath: string; Linked: bool; AsIcon: Bool): Inte Storage := nil; end; end; - result := Lines.Count; + Result := Lines.Count; end; -procedure AddBitmapToRichEdit(bmp: Tbitmap; RichEdit: TRichEditWB); +procedure AddBitmapToRichEdit(bmp: TBitmap; RichEdit: TRichEditWB); function BitmapToRTF(pict: TBitmap): string; var @@ -1187,12 +1222,13 @@ procedure AddBitmapToRichEdit(bmp: Tbitmap; RichEdit: TRichEditWB); rtf := rtf + hexpict + ' }}'; Result := rtf; end; + var - s: TstringStream; + S: TstringStream; begin - S := TStringStream.Create(BitmapToRTF(bmp)); + S := TstringStream.Create(BitmapToRTF(bmp)); RichEdit.PlainText := False; - // RichEdit.StreamMode := [smSelection]; + // RichEdit.StreamMode := [smSelection]; RichEdit.Lines.LoadFromStream(S); S.Free; end; @@ -1200,46 +1236,48 @@ procedure AddBitmapToRichEdit(bmp: Tbitmap; RichEdit: TRichEditWB); function TRichEditWB.AddImages(Files: TStrings): Integer; var Ext: string; - Pict: TPicture; + pict: TPicture; I: Integer; begin Result := 0; - Pict := TPicture.Create; + pict := TPicture.Create; try for I := 0 to Files.Count - 1 do begin Ext := ExtractFileExt(Files[I]); - if (Ext = '.bmp') or (Ext = '.gif') or (Ext = '.jpg') or (Ext = '.jpeg') then + if (Ext = '.bmp') or (Ext = '.gif') or (Ext = '.jpg') or (Ext = '.jpeg') + then begin - Pict.LoadFromFile(Files[I]); - Clipboard.Assign(Pict); + pict.LoadFromFile(Files[I]); + Clipboard.Assign(pict); PasteFromClipboard; SendMessage(Handle, WM_PASTE, 0, 0); Result := Lines.Count; end else begin - MessageDlg('This format is not supported in this feature.', mtError, [mbOK], 0); + MessageDlg('This format is not supported in this feature.', mtError, + [mbOK], 0); end end; finally - Pict.Free; + pict.Free; end; end; function TRichEditWB.AddImageUsingClipboard(FilePath: string): Integer; var - Pict: TPicture; + pict: TPicture; begin - Pict := TPicture.Create; + pict := TPicture.Create; try inserted := True; - Pict.LoadFromFile(FilePath); - Clipboard.Assign(Pict); + pict.LoadFromFile(FilePath); + Clipboard.Assign(pict); PasteFromClipboard; Result := Lines.Count; finally - Pict.Free; + pict.Free; end; end; @@ -1256,38 +1294,38 @@ function TRichEditWB.AddImage(FilePath: string): Integer; ImageBMP := TBitmap.Create; ImageBMP.LoadFromFile(FilePath); Clipboard.Assign(ImageBMP); - // Clipboard.AsText:=ConvertBitmapToRTF(ImageBMP); + // Clipboard.AsText:=ConvertBitmapToRTF(ImageBMP); Result := Lines.Count; finally PasteFromClipboard; end; ImageBMP.Free; end + else if (Pos('.jp', FilePath) > 0) or (Pos('.JP', FilePath) > 0) then + begin + try + ImageJPG := TJPEGImage.Create; + ImageJPG.LoadFromFile(FilePath); + Clipboard.Assign(ImageJPG); + Result := Lines.Count; + finally + PasteFromClipboard; + end; + ImageJPG.Free; + end else - if (Pos('.jp', FilePath) > 0) or (Pos('.JP', FilePath) > 0) then - begin - try - ImageJPG := TJPEGImage.Create; - ImageJPG.LoadFromFile(FilePath); - Clipboard.Assign(ImageJPG); - Result := Lines.Count; - finally - PasteFromClipboard; - end; - ImageJPG.Free; - end - else - begin - MessageDlg('This format is not supported in this feature.', mtError, [mbOK], 0); - Result := 0; - end + begin + MessageDlg('This format is not supported in this feature.', mtError, + [mbOK], 0); + Result := 0; + end end; -function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte; - cb: Longint; var pcb: Longint): DWORD; stdcall; +function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte; cb: Longint; + var pcb: Longint): DWORD; stdcall; var theStream: TStream; - dataAvail: LongInt; + dataAvail: Longint; begin theStream := TStream(dwCookie); with theStream do @@ -1298,19 +1336,19 @@ function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte; begin pcb := Read(pbBuff^, dataAvail); if pcb <> dataAvail then - result := DWord(E_FAIL); + Result := DWORD(E_FAIL); end else begin pcb := Read(pbBuff^, cb); if pcb <> cb then - result := DWord(E_FAIL); + Result := DWORD(E_FAIL); end; end; end; -function EditStreamOutCallback(dwCookie: Longint; pbBuff: PByte; cb: - Longint; var pcb: Longint): DWORD; stdcall; +function EditStreamOutCallback(dwCookie: Longint; pbBuff: PByte; cb: Longint; + var pcb: Longint): DWORD; stdcall; var theStream: TStream; begin @@ -1331,23 +1369,23 @@ function TRichEditWB.GetRTFSelection(intoStream: TStream): string; begin dwCookie := Longint(intoStream); dwError := 0; - pfnCallback := EditStreamOutCallBack; + pfnCallback := EditStreamOutCallback; end; - Perform(EM_STREAMOUT, SF_RTF or SFF_SELECTION, longint(@editstream)); + Perform(EM_STREAMOUT, SF_RTF or SFF_SELECTION, Longint(@editstream)); Result := SelText; end; function TRichEditWB.AddRTFSelection(sourceStream: TStream): Integer; var - EditStream: TEditStream; + editstream: TEditStream; begin - with EditStream do + with editstream do begin dwCookie := Longint(sourceStream); dwError := 0; - pfnCallback := EditStreamInCallBack; + pfnCallback := EditStreamInCallback; end; - Perform(EM_STREAMIN, SF_RTF or SFF_SELECTION, longint(@EditStream)); + Perform(EM_STREAMIN, SF_RTF or SFF_SELECTION, Longint(@editstream)); Result := Lines.Count; end; @@ -1360,7 +1398,7 @@ function TRichEditWB.AddRtfText(str: string): Integer; begin aMemStream := TMemoryStream.Create; try - aMemStream.Write(str[1], length(str)); + aMemStream.Write(str[1], Length(str)); aMemStream.Position := 0; AddRTFSelection(aMemStream); Result := Lines.Count; @@ -1372,17 +1410,17 @@ function TRichEditWB.AddRtfText(str: string): Integer; procedure TRichEditWB.AppendRTF(str: string); var - start, length, eventmask: Integer; + start, Length, eventmask: Integer; begin eventmask := SendMessage(Handle, EM_SETEVENTMASK, 0, 0); SendMessage(Handle, WM_SETREDRAW, 0, 0); start := SelStart; - length := SelLength; + Length := SelLength; SelLength := 0; SelStart := System.Length(Text); AddRtfText(str); SelStart := start; - SelLength := length; + SelLength := Length; SendMessage(Handle, WM_SETREDRAW, 1, 0); InvalidateRect(Handle, nil, True); SendMessage(Handle, EM_SETEVENTMASK, 0, eventmask); @@ -1397,8 +1435,8 @@ function TRichEditWB.AddBitmapFromImagelist(const ASource: TCustomImageList; bmpImage := TBitmap.Create(); try ASource.GetBitmap(AImageIndex, bmpImage); - BmpImage.Width := ASource.Width + 1; - BmpImage.Height := ASource.Height + 1; + bmpImage.Width := ASource.Width + 1; + bmpImage.Height := ASource.Height + 1; TImageDataObject.InsertBitmap(Self, bmpImage); Result := Lines.Count; finally @@ -1409,26 +1447,26 @@ function TRichEditWB.AddBitmapFromImagelist(const ASource: TCustomImageList; procedure TRichEditWB.WMPaint(var Msg: TWMPaint); var DC: HDC; - // R, R1: TRect; + // R, R1: TRect; begin DC := GetDC(Handle); if Transparent = 1 then - SetBkMode(DC, Windows.TRANSPARENT) + SetBkMode(DC, Windows.Transparent) else SetBkMode(DC, Windows.OPAQUE); ReleaseDC(Handle, DC); - { if RichEditVersion >= 2 then + { if RichEditVersion >= 2 then inherited - else - begin + else + begin if GetUpdateRect(Handle, R, True) then begin - with ClientRect do - R1 := Rect(Right - 3, Top, Right, Bottom); - if IntersectRect(R, R, R1) then - InvalidateRect(Handle, @R1, True); + with ClientRect do + R1 := Rect(Right - 3, Top, Right, Bottom); + if IntersectRect(R, R, R1) then + InvalidateRect(Handle, @R1, True); end; - end;}inherited + end; } inherited end; procedure TRichEditWB.DoSetMaxLength(Value: Integer); @@ -1438,7 +1476,7 @@ procedure TRichEditWB.DoSetMaxLength(Value: Integer); SendMessage(Handle, EM_EXLIMITTEXT, 0, Value); end; -procedure TRichEditWB.SetHideCaret(const Value: Boolean); +procedure TRichEditWB.SetHideCaret(const Value: boolean); begin if FHideCaret <> Value then FHideCaret := Value; @@ -1465,11 +1503,11 @@ procedure TRichEditWB.SelectionChange; procedure TRichEditWB.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); - { case RichEditVersion of + { case RichEditVersion of 1: CreateSubClass(Params, RICHEDIT_CLASS10A); - else - CreateSubClass(Params, RICHEDIT_CLASS); - end; } + else + CreateSubClass(Params, RICHEDIT_CLASS); + end; } Params.Style := Params.Style or WS_CLIPCHILDREN; if FRichEditModule = 0 then begin @@ -1490,15 +1528,16 @@ procedure TRichEditWB.SetEditRect; var Loc: TRect; begin - SetRect(Loc, FLeftGap, FTopGap, (ClientWidth - 1) - FRightGap, (ClientHeight + 1) - FBottomGap); - SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc)); + SetRect(Loc, fLeftGap, FTopGap, (ClientWidth - 1) - FRightGap, + (ClientHeight + 1) - fBottomGap); + SendMessage(Handle, EM_SETRECTNP, 0, Longint(@Loc)); end; procedure TRichEditWB.setLeftGap(Value: Integer); begin - if (FLeftGap <> Value) and (Value > -1) then + if (fLeftGap <> Value) and (Value > -1) then begin - FLeftGap := Value; + fLeftGap := Value; ReCreateWnd; end; end; @@ -1523,9 +1562,9 @@ procedure TRichEditWB.setRightGap(Value: Integer); procedure TRichEditWB.setBottomGap(Value: Integer); begin - if (FBottomGap <> Value) and (Value > -1) then + if (fBottomGap <> Value) and (Value > -1) then begin - FBottomGap := Value; + fBottomGap := Value; ReCreateWnd; end; end; @@ -1554,23 +1593,23 @@ function TRichEditWB.AddText(const txt: string): Integer; function TRichEditWB.AddTextByCursor(str: string): Integer; var Str1: string; - i, ui: Integer; + I, ui: Integer; begin - ui := Length(Lines[CaretPos.y]); - str1 := Lines[CaretPos.y]; + ui := Length(Lines[CaretPos.Y]); + Str1 := Lines[CaretPos.Y]; if Pos('<$Cursor$>', str) > 0 then begin - i := Pos('<$Cursor$>', str); + I := Pos('<$Cursor$>', str); str := StringReplace(str, '<$Cursor$>', '', [rfReplaceAll, rfIgnoreCase]); - i := i - 1 + ui; + I := I - 1 + ui; end else - i := -30; - System.Insert(str, Str1, CaretPos.x + 1); - Lines[CaretPos.y] := str1; - if i <> -30 then + I := -30; + System.Insert(str, Str1, CaretPos.X + 1); + Lines[CaretPos.Y] := Str1; + if I <> -30 then begin - SelStart := Perform(EM_LINEINDEX, CaretPos.y, 0) + i; + SelStart := Perform(EM_LINEINDEX, CaretPos.Y, 0) + I; SetFocus; end; Result := Lines.Count; @@ -1591,9 +1630,9 @@ procedure TRichEditWB.SetOffSetsValues(SetTo: Integer); var Rect: TRect; begin - SendMessage(Handle, EM_GETRECT, 0, LongInt(@Rect)); + SendMessage(Handle, EM_GETRECT, 0, Longint(@Rect)); Rect.Left := SetTo; - SendMessage(Handle, EM_SETRECT, 0, LongInt(@Rect)); + SendMessage(Handle, EM_SETRECT, 0, Longint(@Rect)); Refresh; end; @@ -1618,46 +1657,48 @@ procedure TRichEditWB.GetMemStatus; begin memory.dwLength := SizeOf(memory); GlobalMemoryStatus(memory); - ShowMessage('Total memory: ' + IntToStr(memory.dwTotalPhys) + ' Bytes' - + #10 + #13 + 'Available memory: ' + IntToStr(memory.dwAvailPhys) + ' Bytes'); + ShowMessage('Total memory: ' + IntToStr(memory.dwTotalPhys) + ' Bytes' + #10 + + #13 + 'Available memory: ' + IntToStr(memory.dwAvailPhys) + ' Bytes'); end; -function TRichEditWB.IsSeparator(Car: Char): Boolean; +function TRichEditWB.IsSeparator(Car: Char): boolean; begin case Car of - '.', ';', ',', ':', '!', '"', '''', '^', '+', '-', '*', '/', '\', ' ', - '`', '[', ']', '(', ')', '{', '}', '?', '%', '=': Result := True; + '.', ';', ',', ':', '!', '"', '''', '^', '+', '-', '*', '/', '\', ' ', '`', + '[', ']', '(', ')', '{', '}', '?', '%', '=': + Result := True; else Result := False; end; end; -function TRichEditWB.GetNextWord(var s: string; var PrevWord: string): string; +function TRichEditWB.GetNextWord(var S: string; var PrevWord: string): string; begin Result := ''; PrevWord := ''; - if s = '' then + if S = '' then Exit; - while (s <> '') and IsSeparator(s[1]) do + while (S <> '') and IsSeparator(S[1]) do begin - PrevWord := PrevWord + s[1]; - Delete(s, 1, 1); + PrevWord := PrevWord + S[1]; + Delete(S, 1, 1); end; - while (s <> '') and not IsSeparator(s[1]) do + while (S <> '') and not IsSeparator(S[1]) do begin - Result := Result + s[1]; - Delete(s, 1, 1); + Result := Result + S[1]; + Delete(S, 1, 1); end; end; -function TRichEditWB.IsNumber(s: string): Boolean; +function TRichEditWB.IsNumber(S: string): boolean; var - i: Integer; + I: Integer; begin Result := False; - for i := 1 to Length(s) do - case s[i] of - '0'..'9': ; + for I := 1 to Length(S) do + case S[I] of + '0' .. '9': + ; else Exit; end; @@ -1669,11 +1710,11 @@ function TRichEditWB.GetVisibleLines: Integer; Result := Height div (Abs(Self.Font.Height) + 2); end; -procedure TRichEditWB.DoHighlightHtml; +procedure TRichEditWB.DoHighlightHTML; var ms: TMemoryStream; begin - if HighlightHTML then + if HighLightHTML then begin HTMLSyn := THighlightHTML.Create; try @@ -1698,7 +1739,7 @@ procedure TRichEditWB.DoHighlightXML; var ms: TMemoryStream; begin - if HighlightXML then + if HighLightXML then begin XMLSyn := THighlightXML.Create; try @@ -1736,10 +1777,11 @@ procedure TRichEditWB.CreateSnapShot(Pic: TBitmap); FillRect(ClipRect); end; Pic.Canvas.Brush.Style := bsClear; - TextBounary := Rect(0, 0, Width * Screen.PixelsPerInch, Height * Screen.PixelsPerInch); + TextBounary := Rect(0, 0, Width * Screen.PixelsPerInch, + Height * Screen.PixelsPerInch); with Range do begin - hdc := Pic.Canvas.Handle; + HDC := Pic.Canvas.Handle; hdcTarget := Pic.Canvas.Handle; rc := TextBounary; rcPage := TextBounary; @@ -1748,7 +1790,7 @@ procedure TRichEditWB.CreateSnapShot(Pic: TBitmap); end; SendMessage(Handle, EM_FORMATRANGE, 1, Longint(@Range)); SendMessage(Handle, EM_FORMATRANGE, 0, 0); - if not Assigned(fImage) then + if not Assigned(FImage) then begin psd := TSaveDialog.Create(Self); psd.FileName := 'EditorImage.bmp'; @@ -1756,8 +1798,8 @@ procedure TRichEditWB.CreateSnapShot(Pic: TBitmap); try if psd.Execute then if FileExists(psd.FileName) then - if MessageDlg(Format(sOverWrite, [psd.FileName]), mtConfirmation, mbYesNoCancel, 0) - <> idYes then + if MessageDlg(Format(sOverWrite, [psd.FileName]), mtConfirmation, + mbYesNoCancel, 0) <> idYes then Exit; Pic.SaveToFile(psd.FileName + '.bmp'); finally @@ -1810,7 +1852,7 @@ procedure TRichEditWB.UndoLast(Sender: TObject); Undo; end; -procedure TRichEditWB.SetHyperLink(Setlink: Boolean; wParam: Integer); +procedure TRichEditWB.SetHyperlink(Setlink: boolean; wParam: Integer); var cf: TCharFormat; begin @@ -1828,12 +1870,12 @@ procedure TRichEditWB.SetHyperLink(Setlink: Boolean; wParam: Integer); SendMessage(Handle, EM_SETCHARFORMAT, wParam, Integer(@cf)); end; -procedure TRichEditWB.SetSelectionHyperLink(Hyperlink: Boolean); +procedure TRichEditWB.SetSelectionHyperLink(Hyperlink: boolean); begin SetHyperlink(Hyperlink, SCF_SELECTION); end; -procedure TRichEditWB.SetWordHyperLink(Hyperlink: Boolean); +procedure TRichEditWB.SetWordHyperLink(Hyperlink: boolean); begin SetHyperlink(Hyperlink, SCF_WORD or SCF_SELECTION); end; @@ -1842,16 +1884,15 @@ procedure TRichEditWB.DoURLClick(const URL: string); var X: Olevariant; begin - if fAutoNavigate then + if FAutoNavigate then begin if Assigned(FOnURLClick) then OnURLClick(Self, URL) - else - if Assigned(FEmbeddedWB) then - begin - FEmbeddedWB.Navigate(Url, X, X, X, X); - FEmbeddedWB.SetFocusToDoc; - end; + else if Assigned(FEmbeddedWB) then + begin + FEmbeddedWB.Navigate(URL, X, X, X, X); + FEmbeddedWB.SetFocusToDoc; + end; end; end; @@ -1860,11 +1901,11 @@ procedure TRichEditWB.CNNotify(var Msg: TWMNotify); p: TENLink; sURL: string; begin - if fHighlightURL then + if FHighlightURL then begin if (Msg.NMHdr^.code = EN_LINK) then begin - p := TENLink(Pointer(Msg.NMHdr)^); + p := TENLink(pointer(Msg.NMHdr)^); if (p.Msg = WM_LBUTTONDOWN) then begin try @@ -1880,15 +1921,15 @@ procedure TRichEditWB.CNNotify(var Msg: TWMNotify); end; procedure TRichEditWB.CreateWnd; -{var - mask: Word;} +{ var + mask: Word; } begin inherited CreateWnd; Modified := FModified; - if fHighlightURL then + if FHighlightURL then SendMessage(Handle, EM_AUTOURLDETECT, 1, 0); - // mask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0); -// SendMessage(Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK); + // mask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0); + // SendMessage(Handle, EM_SETEVENTMASK, 0, mask or ENM_LINK); SendMessage(Handle, EM_SETBKGNDCOLOR, 0, ColorToRGB(Color)); DoSetMaxLength(MaxLength); @@ -1909,11 +1950,11 @@ procedure TRichEditWB.WndProc(var Msg: TMessage); end; begin - if FHideCaret and not (csDesigning in ComponentState) then + if FHideCaret and not(csDesigning in ComponentState) then begin case Msg.Msg of - WM_LBUTTONDOWN, WM_LBUTTONUP, WM_MOUSEMOVE, - WM_LBUTTONDBLCLK, WM_CHAR, WM_KEYUP: + WM_LBUTTONDOWN, WM_LBUTTONUP, WM_MOUSEMOVE, WM_LBUTTONDBLCLK, + WM_CHAR, WM_KEYUP: begin Msg.Result := 0; if Msg.Msg = WM_LBUTTONDOWN then @@ -1923,7 +1964,7 @@ procedure TRichEditWB.WndProc(var Msg: TMessage); end; WM_KEYDOWN: begin - case Msg.WParam of + case Msg.wParam of VK_DOWN: Scroll(WM_VSCROLL, SB_LINEDOWN); VK_UP: @@ -1957,20 +1998,20 @@ constructor TRichEditWB.Create(AOwner: TComponent); ControlStyle := ControlStyle + [csAcceptsControls]; end; CompCount := 0; - fAcceptDragComponnents := True; - fAcceptDragFiles := True; - fAutoNavigate := True; - FBottomGap := 0; - fFileName := sUntitled; - fHideCaret := False; - fHighlightURL := True; - fHTMLHighlight := True; + FAcceptDragComponnents := True; + FAcceptDragFiles := True; + FAutoNavigate := True; + fBottomGap := 0; + FFileName := sUntitled; + FHideCaret := False; + FHighlightURL := True; + FHTMLHighlight := True; fLeftGap := 0; - fMoreThen64KB := False; - fRightGap := 0; - fStream := TMemoryStream.Create; - fTopGap := 0; - fXMLHighlight := True; + FMoreThen64KB := False; + FRightGap := 0; + FStream := TMemoryStream.Create; + FTopGap := 0; + FXMLHighlight := True; ScrollBars := ssBoth; ShowHint := True; WordWrap := True; @@ -1982,7 +2023,7 @@ constructor TRichEditWB.Create(AOwner: TComponent); function TRichEditWB.GetPopupMenu: TPopupMenu; var - canCopy: Boolean; + canCopy: boolean; begin Result := inherited GetPopupMenu; canCopy := SelText <> ''; @@ -2003,17 +2044,21 @@ function TRichEditWB.GetPopupMenu: TPopupMenu; Add(NewItem('Select All', 0, False, True, SelAll, 5, 'MenuItem5')); Add(NewLine); Add(NewItem('Clear', 0, False, True, ClearAll, 6, 'MenuItem6')); - Add(NewItem('Clear Selection', 0, False, canCopy, ClearSel, 7, 'MenuItem7')); + Add(NewItem('Clear Selection', 0, False, canCopy, ClearSel, 7, + 'MenuItem7')); Add(NewLine); Add(NewItem('Find', 0, False, True, FindDialog, 8, 'MenuItem8')); Add(NewLine); - if fXMLHighlight then - Add(NewItem('HighLight XML', 0, False, True, DoXMLrc, 9, 'MenuItem9')); - if fHTMLHighlight then - Add(NewItem('HighLight HTML', 0, False, True, DoHTMLrc, 10, 'MenuItem10')); + if FXMLHighlight then + Add(NewItem('HighLight XML', 0, False, True, DoXMLrc, 9, + 'MenuItem9')); + if FHTMLHighlight then + Add(NewItem('HighLight HTML', 0, False, True, DoHTMLrc, 10, + 'MenuItem10')); Add(NewLine); Add(NewItem('Print', 0, False, True, Prnt, 12, 'MenuItem12')); - Add(NewItem('Print Selected Text', 0, False, canCopy, PrintSel, 13, 'MenuItem13')); + Add(NewItem('Print Selected Text', 0, False, canCopy, PrintSel, 13, + 'MenuItem13')); PostMessage(Handle, WM_NULL, 0, 0); end; Result := FPopupVerbMenu; @@ -2027,14 +2072,14 @@ procedure TRichEditWB.EMExSetSel(var Message: TMessage); XSel: ^TCharRange absolute ISel; begin inherited; - ISel := Message.LParam; + ISel := Message.LPARAM; FSelection := XSel^; end; procedure TRichEditWB.EMReplaceSel(var Message: TMessage); begin inherited; - FMax := FSelection.cpMax + length(PChar(Message.LParam)); + FMax := FSelection.cpMax + Length(PChar(Message.LPARAM)); end; function TRichEditWB.GetSelStart: Integer; @@ -2050,41 +2095,37 @@ function TRichEditWB.GetSelStart: Integer; procedure TRichEditWB.SetTextAlignment(al: TAlignment); begin - Paragraph.Alignment := al; + Paragraph.alignment := al; end; -procedure TRichEditWB.SetThemes(thm: TThemes); +procedure TRichEditWB.SetThemes(Thm: TThemes); begin Themes := Thm; if Thm = tBlack then begin - color := clBlack; + Color := clBlack; Font.Color := clWhite; end - else - if Thm = tAluminum then - begin - color := clSilver; - Font.Color := clWhite; - end - else - if Thm = tLight then - begin - color := clInfoBk; - Font.Color := clBlack; - end - else - if Thm = tXP then - begin - color := RGB(237, 242, 251); - Font.Color := clBlack; - end - else - if Thm = tDefault then - begin - color := clWindow; - Font.Color := clBlack; - end; + else if Thm = tAluminum then + begin + Color := clSilver; + Font.Color := clWhite; + end + else if Thm = tLight then + begin + Color := clInfoBk; + Font.Color := clBlack; + end + else if Thm = tXP then + begin + Color := RGB(237, 242, 251); + Font.Color := clBlack; + end + else if Thm = tDefault then + begin + Color := clWindow; + Font.Color := clBlack; + end; end; @@ -2092,13 +2133,13 @@ procedure TRichEditWB.Loaded; begin inherited Loaded; FMyCallback := TRichEditOleCallback.Create; - REOleSetCallback(Self, FMyCallBack); + REOleSetCallback(Self, FMyCallback); SetTextAlignment(TextAlignment); SetThemes(FThemes); - // if assigned(Fstatusbar) then OldStatusBarW := Fstatusbar.Panels[0].Width; + // if assigned(Fstatusbar) then OldStatusBarW := Fstatusbar.Panels[0].Width; UpdateInfo; DragAcceptFiles(Handle, True); - if fMoreThen64KB then + if FMoreThen64KB then SendMessage(Handle, EM_EXLIMITTEXT, 0, $7FFFFFF0); if ShowHint then SetModified(True); @@ -2109,7 +2150,7 @@ procedure TRichEditWB.Loaded; destructor TRichEditWB.Destroy; begin - // Fstatusbar.Panels[0].Width := OldStatusBarW; + // Fstatusbar.Panels[0].Width := OldStatusBarW; FMyCallback.Free; FStream.Free; inherited Destroy; @@ -2125,14 +2166,14 @@ procedure TRichEditWB.MouseMove(Shift: TShiftState; X, Y: Integer); inherited; end; -function TRichEditWB.GetModified: Boolean; +function TRichEditWB.GetModified: boolean; begin Result := FModified; if HandleAllocated then Result := SendMessage(Handle, EM_GETMODIFY, 0, 0) <> 0; end; -function TRichEditWB.GetCanUndo: Boolean; +function TRichEditWB.GetCanUndo: boolean; begin Result := False; if HandleAllocated then @@ -2147,7 +2188,7 @@ procedure TRichEditWB.SelectFont; try fd.Font.Assign(SelAttributes); - if Fd.Execute then + if fd.Execute then Font.Assign(fd.Font); SetFocus; finally @@ -2261,55 +2302,57 @@ procedure TRichEditWB.CheckNumLock; NumLockKey := 'NumLock: Off'; end; -procedure TRichEditWB.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); -{var - CurPos: TPoint; - Popup : TPopupMenu; } +procedure TRichEditWB.MouseDown(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); +{ var + CurPos: TPoint; + Popup : TPopupMenu; } begin UpdateInfo; LineIndex := Perform(EM_LINEFROMCHAR, SelStart, 0); - {if not Assigned(PopupMenu) then + { if not Assigned(PopupMenu) then begin - if button = mbRight then - begin - Popup := TPopupMenu.Create(self); - PopupMenu := Popup; - with popup do - begin - Items.Clear; - CleanupInstance; - GetCursorPos(CurPos); - Popup(CurPos.x, CurPos.y); - with Items do - begin - Add(NewItem('Undo',0, False, True, UndoLast, 0, 'MenuItem0')); - Add(NewLine); - Add(NewItem('Cut', 0, False, True, CutSel, 2, 'MenuItem2')); - Add(NewItem('Copy', 0, False, True, CopySel, 3, 'MenuItem3')); - Add(NewItem('Paste', 0, False, True, PasteSel, 4, 'MenuItem4')); - Add(NewItem('Select All', 0, False, True, SelAll, 5, 'MenuItem5')); - Add(NewLine); - Add(NewItem('Clear', 0, False, True, ClearAll, 6, 'MenuItem6')); - Add(NewItem('Clear Selection', 0, False, True, ClearSel, 7, 'MenuItem7')); - Add(NewLine); - Add(NewItem('Find', 0, False, True, FindDialog, 8, 'MenuItem8')); - Add(NewLine); - if fXMLHighlight then - Add(NewItem('HighLight XML', 0, False, True, DoXMLrc, 9, 'MenuItem9')); - if fHTMLHighlight then - Add(NewItem('HighLight HTML', 0, False, True, DoHTMLrc, 10, 'MenuItem10')); - Add(NewLine); - Add(NewItem('Print', 0, False, True, Prnt, 12, 'MenuItem12')); - Add(NewItem('Print Selected Text', 0, False, True, PrintSel, 13, 'MenuItem13')); - end; - end; - PostMessage(Handle, WM_NULL, 0, 0); - end; - end; } + if button = mbRight then + begin + Popup := TPopupMenu.Create(self); + PopupMenu := Popup; + with popup do + begin + Items.Clear; + CleanupInstance; + GetCursorPos(CurPos); + Popup(CurPos.x, CurPos.y); + with Items do + begin + Add(NewItem('Undo',0, False, True, UndoLast, 0, 'MenuItem0')); + Add(NewLine); + Add(NewItem('Cut', 0, False, True, CutSel, 2, 'MenuItem2')); + Add(NewItem('Copy', 0, False, True, CopySel, 3, 'MenuItem3')); + Add(NewItem('Paste', 0, False, True, PasteSel, 4, 'MenuItem4')); + Add(NewItem('Select All', 0, False, True, SelAll, 5, 'MenuItem5')); + Add(NewLine); + Add(NewItem('Clear', 0, False, True, ClearAll, 6, 'MenuItem6')); + Add(NewItem('Clear Selection', 0, False, True, ClearSel, 7, 'MenuItem7')); + Add(NewLine); + Add(NewItem('Find', 0, False, True, FindDialog, 8, 'MenuItem8')); + Add(NewLine); + if fXMLHighlight then + Add(NewItem('HighLight XML', 0, False, True, DoXMLrc, 9, 'MenuItem9')); + if fHTMLHighlight then + Add(NewItem('HighLight HTML', 0, False, True, DoHTMLrc, 10, 'MenuItem10')); + Add(NewLine); + Add(NewItem('Print', 0, False, True, Prnt, 12, 'MenuItem12')); + Add(NewItem('Print Selected Text', 0, False, True, PrintSel, 13, 'MenuItem13')); + end; + end; + PostMessage(Handle, WM_NULL, 0, 0); + end; + end; } inherited; end; -procedure TRichEditWB.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +procedure TRichEditWB.MouseUp(Button: TMouseButton; Shift: TShiftState; + X, Y: Integer); begin inherited; end; @@ -2331,8 +2374,8 @@ procedure TRichEditWB.KeyPress(var Key: Char); KEY_CTRL_S = 19; KEY_CTRL_U = 21; begin - if (Ord(Key) = KEY_CTRL_B) or (Ord(Key) = KEY_CTRL_I) or (Ord(Key) = KEY_CTRL_S) - or (Ord(Key) = KEY_CTRL_U) then + if (Ord(Key) = KEY_CTRL_B) or (Ord(Key) = KEY_CTRL_I) or + (Ord(Key) = KEY_CTRL_S) or (Ord(Key) = KEY_CTRL_U) then begin with SelAttributes do case Ord(Key) of @@ -2363,10 +2406,10 @@ procedure TRichEditWB.KeyPress(var Key: Char); KEY_CTRL_U: begin Key := #0; - if fsUnderline in Style then - Style := Style - [fsUnderline] + if fsUnderLine in Style then + Style := Style - [fsUnderLine] else - Style := Style + [fsUnderline]; + Style := Style + [fsUnderLine]; end; end; end; @@ -2374,23 +2417,21 @@ procedure TRichEditWB.KeyPress(var Key: Char); begin SelectAll; end - else - if (Ord(Key) = KEY_CTRL_F) then - begin - Find; - end - else - if (Ord(Key) = KEY_CTRL_P) then - begin - PrintAll; - end; + else if (Ord(Key) = KEY_CTRL_F) then + begin + Find; + end + else if (Ord(Key) = KEY_CTRL_P) then + begin + PrintAll; + end; end; function TRichEditWB.SelectLine(Index: Integer): boolean; var StartPos, endPos: Integer; begin - result := False; + Result := False; if Index < 0 then Exit; StartPos := Perform(EM_LINEINDEX, Index, 0); @@ -2400,7 +2441,7 @@ function TRichEditWB.SelectLine(Index: Integer): boolean; if endPos = -1 then endPos := StartPos + Perform(EM_LINELENGTH, StartPos, 0); Perform(EM_SETSEL, StartPos, endPos); - result := True; + Result := True; end; end; @@ -2408,11 +2449,12 @@ function TRichEditWB.GetSelectedText(var SelectedText: string): boolean; begin SelectedText := SelText; if SelectedText <> '' then - result := True + Result := True else begin - MessageDlg('Please select text before using this feature.', mtError, [mbOK], 0); - result := False; + MessageDlg('Please select text before using this feature.', mtError, + [mbOK], 0); + Result := False; end; end; @@ -2423,8 +2465,7 @@ procedure TRichEditWB.MailSelected; if GetSelectedText(em_body) then begin em_subject := 'Check it out please.'; - em_mail := 'mailto:?subject=' + - em_subject + '&body=' + em_body; + em_mail := 'mailto:?subject=' + em_subject + '&body=' + em_body; ShellExecute(Handle, 'open', PChar(em_mail), nil, nil, SW_SHOWNORMAL); end; end; @@ -2437,17 +2478,17 @@ procedure TRichEditWB.MailContext; if em_body <> '' then begin em_subject := 'Check it out please.'; - em_mail := 'mailto:?subject=' + - em_subject + '&body=' + em_body; + em_mail := 'mailto:?subject=' + em_subject + '&body=' + em_body; ShellExecute(Handle, 'open', PChar(em_mail), nil, nil, SW_SHOWNORMAL); end else - MessageDlg('Please enter text before using this feature.', mtError, [mbOK], 0); + MessageDlg('Please enter text before using this feature.', mtError, + [mbOK], 0); end; function TRichEditWB.GetLineCount: Integer; begin - GetLineCount := lines.Count; + GetLineCount := Lines.Count; end; function TRichEditWB.AddDateAndTime: Integer; @@ -2465,28 +2506,28 @@ function TRichEditWB.AddDateAndTime: Integer; procedure TRichEditWB.AlignText(alignment: TAlignment); begin - Paragraph.Alignment := alignment; + Paragraph.alignment := alignment; end; function TRichEditWB.ChangeToANSIChangeCase(const S: string): string; var - i: Integer; - Up: ANSIChar; + I: Integer; + Up: AnsiChar; begin Result := S; - for i := 1 to Length(Result) do + for I := 1 to Length(Result) do begin - Up := ANSIChar(ANSIUpperCase(Result[i])[1]); - if ANSIChar(Result[i]) = Up then - Result[i] := (ANSILowerCase(Result[i])[1]) + Up := AnsiChar(ANSIUpperCase(Result[I])[1]); + if AnsiChar(Result[I]) = Up then + Result[I] := (ANSILowerCase(Result[I])[1]) else - Result[i] := ANSIUpperCase(Result[i])[1]; + Result[I] := ANSIUpperCase(Result[I])[1]; end; end; -function TRichEditWB.AddFormatedText(const txt: string; Bold, Italic, Strikeout, - Underline: boolean; txtColor: TColor): Integer; +function TRichEditWB.AddFormatedText(const txt: string; + Bold, Italic, Strikeout, Underline: boolean; txtColor: TColor): Integer; begin with SelAttributes do begin @@ -2503,9 +2544,9 @@ function TRichEditWB.AddFormatedText(const txt: string; Bold, Italic, Strikeout, else Style := Style - [fsStrikeout]; if Underline then - Style := Style + [fsUnderline] + Style := Style + [fsUnderLine] else - Style := Style - [fsUnderline]; + Style := Style - [fsUnderLine]; Color := txtColor; end; SelText := (txt); @@ -2520,7 +2561,7 @@ function TRichEditWB.RemoveTextFormats: Integer; Style := Style - [fsBold]; Style := Style - [fsItalic]; Style := Style - [fsStrikeout]; - Style := Style - [fsUnderline]; + Style := Style - [fsUnderLine]; Color := clBlack; end; Result := Lines.Count; @@ -2537,7 +2578,7 @@ procedure TRichEditWB.SetLineSpacing(lineSpacing: Byte); pf2: ParaFormat2; begin FillChar(pf2, SizeOf(pf2), 0); - pf2.cbSize := SizeOf(PARAFORMAT2); + pf2.cbSize := SizeOf(ParaFormat2); pf2.dwMask := PFM_LINESPACING; pf2.bLineSpacingRule := lineSpacing; SendMessage(Handle, EM_SETPARAFORMAT, 0, Longint(@pf2)); @@ -2563,30 +2604,31 @@ procedure TRichEditWB.PrintSelectedText; begin printresX := GetDeviceCaps(Handle, LOGPIXELSX); printresY := GetDeviceCaps(Handle, LOGPIXELSY); - printarea := Rect(printresX, printresY * 3 div 2, Printer.PageWidth - - printresX, Printer.PageHeight - printresY * 3 div 2); + printarea := Rect(printresX, printresY * 3 div 2, + Printer.PageWidth - printresX, Printer.PageHeight - printresY * + 3 div 2); richedit_outputarea := Rect(printarea.Left * 1440 div printresX, - printarea.Top * 1440 div printresY, printarea.Right * 1440 div printresX, + printarea.Top * 1440 div printresY, + printarea.Right * 1440 div printresX, printarea.Bottom * 1440 div printresY); - fmtRange.hDC := Handle; + fmtRange.HDC := Handle; fmtRange.hdcTarget := Handle; fmtRange.rc := richedit_outputarea; fmtRange.rcPage := Rect(0, 0, Printer.PageWidth * 1440 div printresX, Printer.PageHeight * 1440 div printresY); - fmtRange.chrg.cpMin := selstart; - fmtRange.chrg.cpMax := selStart + sellength - 1; + fmtRange.chrg.cpMin := SelStart; + fmtRange.chrg.cpMax := SelStart + SelLength - 1; S := SelText; - while (fmtRange.chrg.cpMax > 0) and - (S[fmtRange.chrg.cpMax] <= ' ') do + while (fmtRange.chrg.cpMax > 0) and (S[fmtRange.chrg.cpMax] <= ' ') do Dec(fmtRange.chrg.cpMax); repeat nextChar := Perform(EM_FORMATRANGE, 1, Longint(@fmtRange)); - if nextchar < fmtRange.chrg.cpMax then + if nextChar < fmtRange.chrg.cpMax then begin - printer.newPage; + Printer.newPage; fmtRange.chrg.cpMin := nextChar; end; - until nextchar >= fmtRange.chrg.cpMax; + until nextChar >= fmtRange.chrg.cpMax; Perform(EM_FORMATRANGE, 0, 0); end; finally @@ -2596,20 +2638,20 @@ procedure TRichEditWB.PrintSelectedText; function TRichEditWB.SearchForTextAndSelect(SearchText: string): string; var - StartPos, Position, endpos: Integer; + StartPos, Position, endPos: Integer; begin StartPos := 0; - endpos := Length(Text); + endPos := Length(Text); Lines.beginUpdate; - while FindText(SearchText, StartPos, endpos, [stMatchCase]) <> -1 do + while FindText(SearchText, StartPos, endPos, [stMatchCase]) <> -1 do begin - endpos := Length(Text) - startpos; - Position := FindText(SearchText, StartPos, endpos, [stMatchCase]); + endPos := Length(Text) - StartPos; + Position := FindText(SearchText, StartPos, endPos, [stMatchCase]); Inc(StartPos, Length(SearchText)); SetFocus; SelStart := Position; SelLength := Length(SearchText); - result := SelText; + Result := SelText; end; Lines.endUpdate; end; @@ -2617,16 +2659,16 @@ function TRichEditWB.SearchForTextAndSelect(SearchText: string): string; procedure TRichEditWB.FindDialogFind(Sender: TObject); var S: string; - startpos: Integer; + StartPos: Integer; begin SelStart := 0; with TFindDialog(Sender) do begin if FSelPos = 0 then Options := Options - [frFindNext]; - if frfindNext in Options then + if frFindNext in Options then begin - StartPos := FSelPos + Length(Findtext); + StartPos := FSelPos + Length(FindText); S := Copy(Lines.Text, StartPos, MaxInt); end else @@ -2644,7 +2686,7 @@ procedure TRichEditWB.FindDialogFind(Sender: TObject); end else begin - if frfindNext in Options then + if frFindNext in Options then S := Concat('There are no further occurences of "', FindText, '".') else S := Concat('Could not find "', FindText, '".'); @@ -2663,12 +2705,13 @@ procedure TRichEditWB.Find; try f := TFindDialog.Create(Self); f.OnFind := FindDialogFind; - F.Execute; + f.Execute; finally end; end else - MessageDlg('You can not use this feature after inserting files.', mtError, [mbOK], 0); + MessageDlg('You can not use this feature after inserting files.', mtError, + [mbOK], 0); end; procedure TRichEditWB.FindDialog(Sender: TObject); @@ -2681,12 +2724,13 @@ procedure TRichEditWB.FindDialog(Sender: TObject); try f := TFindDialog.Create(Self); f.OnFind := FindDialogFind; - F.Execute; + f.Execute; finally end; end else - MessageDlg('You can not use this feature after inserting files.', mtError, [mbOK], 0); + MessageDlg('You can not use this feature after inserting files.', mtError, + [mbOK], 0); end; procedure TRichEditWB.ReplaceDialogReplace(Sender: TObject); @@ -2708,7 +2752,7 @@ procedure TRichEditWB.ReplaceDialogReplace(Sender: TObject); SelText := ReplaceText; end else - MessageDlg('Could not find "' + FindText + '".', mtError, [mbOk], 0); + MessageDlg('Could not find "' + FindText + '".', mtError, [mbOK], 0); end; end; @@ -2727,7 +2771,8 @@ procedure TRichEditWB.Replace; end; end else - MessageDlg('You can not use this feature after inserting files.', mtError, [mbOK], 0); + MessageDlg('You can not use this feature after inserting files.', mtError, + [mbOK], 0); end; procedure TRichEditWB.GoToPosition(LineNumber, CharNumber: Word); @@ -2751,30 +2796,31 @@ procedure TRichEditWB.PrintSel(Sender: TObject); begin printresX := GetDeviceCaps(Handle, LOGPIXELSX); printresY := GetDeviceCaps(Handle, LOGPIXELSY); - printarea := Rect(printresX, printresY * 3 div 2, Printer.PageWidth - - printresX, Printer.PageHeight - printresY * 3 div 2); + printarea := Rect(printresX, printresY * 3 div 2, + Printer.PageWidth - printresX, Printer.PageHeight - printresY * + 3 div 2); richedit_outputarea := Rect(printarea.Left * 1440 div printresX, - printarea.Top * 1440 div printresY, printarea.Right * 1440 div printresX, + printarea.Top * 1440 div printresY, + printarea.Right * 1440 div printresX, printarea.Bottom * 1440 div printresY); - fmtRange.hDC := Handle; + fmtRange.HDC := Handle; fmtRange.hdcTarget := Handle; fmtRange.rc := richedit_outputarea; fmtRange.rcPage := Rect(0, 0, Printer.PageWidth * 1440 div printresX, Printer.PageHeight * 1440 div printresY); - fmtRange.chrg.cpMin := selstart; - fmtRange.chrg.cpMax := selStart + sellength - 1; + fmtRange.chrg.cpMin := SelStart; + fmtRange.chrg.cpMax := SelStart + SelLength - 1; S := SelText; - while (fmtRange.chrg.cpMax > 0) and - (S[fmtRange.chrg.cpMax] <= ' ') do + while (fmtRange.chrg.cpMax > 0) and (S[fmtRange.chrg.cpMax] <= ' ') do Dec(fmtRange.chrg.cpMax); repeat nextChar := Perform(EM_FORMATRANGE, 1, Longint(@fmtRange)); - if nextchar < fmtRange.chrg.cpMax then + if nextChar < fmtRange.chrg.cpMax then begin - printer.newPage; + Printer.newPage; fmtRange.chrg.cpMin := nextChar; end; - until nextchar >= fmtRange.chrg.cpMax; + until nextChar >= fmtRange.chrg.cpMax; Perform(EM_FORMATRANGE, 0, 0); end; finally @@ -2791,15 +2837,15 @@ function TRichEditWB.SearchAndReplace(InSearch, InReplace: string): Integer; Screen.Cursor := crHourglass; begin X := 0; - Toend := length(Text); - X := FindText(inSearch, X, Toend, []); + Toend := Length(Text); + X := FindText(InSearch, X, Toend, []); while X <> -1 do begin SetFocus; SelStart := X; - SelLength := length(inSearch); + SelLength := Length(InSearch); SelText := InReplace; - X := FindText(inSearch, X + length(InReplace), Toend, []); + X := FindText(InSearch, X + Length(InReplace), Toend, []); end; end; Screen.Cursor := oldCursor; @@ -2818,7 +2864,7 @@ function TRichEditWB.GetRTFText: string; begin FStream.Clear; Lines.SaveToStream(FStream); - Result := PChar(FStream.Memory); + Result := PChar(FStream.memory); end; procedure TRichEditWB.PreviewInBrowser; @@ -2839,16 +2885,17 @@ procedure TRichEditWB.PreviewInBrowser; end; end else - MessageDlg('You must assign a TEmbeddedWB before using this feature.', mtError, [MbOk], 0); + MessageDlg('You must assign a TEmbeddedWB before using this feature.', + mtError, [mbOK], 0); end; function TRichEditWB.GetRTFTextToString: string; var - ss: TStringStream; + ss: TstringStream; EmptyStr: string; begin EmptyStr := ''; - ss := TStringStream.Create(EmptyStr); + ss := TstringStream.Create(EmptyStr); try PlainText := False; Lines.SaveToStream(ss); @@ -2883,7 +2930,8 @@ procedure TRichEditWB.LoadStreamFromBrowser; end; end else - MessageDlg('You must assign a TEmbeddedWB before using this feature.', mtError, [MbOk], 0); + MessageDlg('You must assign a TEmbeddedWB before using this feature.', + mtError, [mbOK], 0); end; procedure TRichEditWB.LoadHTMLFromBrowser; @@ -2895,14 +2943,15 @@ procedure TRichEditWB.LoadHTMLFromBrowser; while EmbeddedWB.ReadyState <> READYSTATE_COMPLETE do Forms.Application.ProcessMessages; if Assigned(EmbeddedWB.document) then - Lines.Add(EmbeddedWB.OleObject.Document.documentElement.innerHTML); - fFileName := EmbeddedWB.LocationName; + Lines.Add(EmbeddedWB.OleObject.document.documentElement.innerHTML); + FFileName := EmbeddedWB.LocationName; UpdateInfo; ScrollToTop; SelStart := Perform(EM_LINEINDEX, 1, 1); end else - MessageDlg('You must assign a TEmbeddedWB before using this feature.', mtError, [MbOk], 0); + MessageDlg('You must assign a TEmbeddedWB before using this feature.', + mtError, [mbOK], 0); end; procedure TRichEditWB.LoadTextFromBrowser; @@ -2914,14 +2963,15 @@ procedure TRichEditWB.LoadTextFromBrowser; while EmbeddedWB.ReadyState <> READYSTATE_COMPLETE do Forms.Application.ProcessMessages; if Assigned(EmbeddedWB.document) then - Lines.Add(EmbeddedWB.OleObject.Document.documentElement.innerText); - fFileName := EmbeddedWB.LocationName; + Lines.Add(EmbeddedWB.OleObject.document.documentElement.innerText); + FFileName := EmbeddedWB.LocationName; UpdateInfo; ScrollToTop; SelStart := Perform(EM_LINEINDEX, 1, 1); end else - MessageDlg('You should Assign A web Browser before using this feature!', mtError, [MbOk], 0); + MessageDlg('You should Assign A web Browser before using this feature!', + mtError, [mbOK], 0); end; procedure TRichEditWB.LoadStringsFromBrowser; @@ -2933,13 +2983,14 @@ procedure TRichEditWB.LoadStringsFromBrowser; while EmbeddedWB.ReadyState <> READYSTATE_COMPLETE do Forms.Application.ProcessMessages; EmbeddedWB.SaveToStrings(Lines); - fFileName := EmbeddedWB.LocationName; + FFileName := EmbeddedWB.LocationName; UpdateInfo; ScrollToTop; SelStart := Perform(EM_LINEINDEX, 1, 1); end else - MessageDlg('You should Assign A web Browser before using this feature!', mtError, [MbOk], 0); + MessageDlg('You should Assign A web Browser before using this feature!', + mtError, [mbOK], 0); end; procedure TRichEditWB.LoadAsCopyFromBrowser; @@ -2953,13 +3004,14 @@ procedure TRichEditWB.LoadAsCopyFromBrowser; EmbeddedWB.SelectAll; EmbeddedWB.Copy; PasteFromClipboard; - fFileName := EmbeddedWB.LocationName; + FFileName := EmbeddedWB.LocationName; UpdateInfo; ScrollToTop; SelStart := Perform(EM_LINEINDEX, 1, 1); end else - MessageDlg('You should Assign A web Browser before using this feature!', mtError, [MbOk], 0); + MessageDlg('You should Assign A web Browser before using this feature!', + mtError, [mbOK], 0); end; procedure TRichEditWB.ScrollToTop; @@ -3030,7 +3082,7 @@ function TRichEditWB.AddLineNumbering: Integer; fmt.wNumberingStart := 1; fmt.wNumberingStyle := $200; fmt.wNumberingTab := 1440 div 4; - Perform(EM_SETPARAFORMAT, 0, lParam(@fmt)); + Perform(EM_SETPARAFORMAT, 0, LPARAM(@fmt)); Result := Lines.Count; end; @@ -3050,8 +3102,8 @@ function TRichEditWB.AddBullets: Integer; wNumberingStyle := $200; wNumberingTab := 1440 div 4; end; - Perform(EM_SETPARAFORMAT, 0, lParam(@fmt)); - selStart := 0; + Perform(EM_SETPARAFORMAT, 0, LPARAM(@fmt)); + SelStart := 0; Result := Lines.Count; end; @@ -3071,19 +3123,19 @@ function TRichEditWB.AddRomanNumbering: Integer; wNumberingStyle := $200; wNumberingTab := 1440 div 4; end; - Perform(EM_SETPARAFORMAT, 0, lParam(@fmt)); - selStart := 0; + Perform(EM_SETPARAFORMAT, 0, LPARAM(@fmt)); + SelStart := 0; Result := Lines.Count; end; -function TRichEditWB.AddCheckBox(cbCaption, cbName: string; reLeft, cbLeft, - cbTop: Integer; Chk: Boolean): Integer; +function TRichEditWB.AddCheckBox(cbCaption, cbName: string; + reLeft, cbLeft, cbTop: Integer; Chk: boolean): Integer; var cb: TCheckBox; begin if AcceptDragComponnents then begin - Self.Left := RELeft; + Self.Left := reLeft; cb := TCheckBox.Create(Self); with cb do begin @@ -3093,7 +3145,7 @@ function TRichEditWB.AddCheckBox(cbCaption, cbName: string; reLeft, cbLeft, Top := cbTop; Parent := Self; Checked := Chk; - inc(CompCount); + Inc(CompCount); Result := CompCount; end; end @@ -3101,13 +3153,14 @@ function TRichEditWB.AddCheckBox(cbCaption, cbName: string; reLeft, cbLeft, Result := 0; end; -function TRichEditWB.AddEditBox(eText, eName: string; reLeft, eLeft, eTop: Integer): Integer; +function TRichEditWB.AddEditBox(eText, eName: string; + reLeft, eLeft, eTop: Integer): Integer; var E: TEdit; begin if AcceptDragComponnents then begin - Self.Left := RELeft; + Self.Left := reLeft; E := TEdit.Create(Self); with E do begin @@ -3116,7 +3169,7 @@ function TRichEditWB.AddEditBox(eText, eName: string; reLeft, eLeft, eTop: Integ Left := eLeft; Top := eTop; Parent := Self; - inc(CompCount); + Inc(CompCount); Result := CompCount; end; end @@ -3124,8 +3177,8 @@ function TRichEditWB.AddEditBox(eText, eName: string; reLeft, eLeft, eTop: Integ Result := 0; end; -function TRichEditWB.AddRadioButton(rbCaption, rbName: string; reLeft, rbLeft, - rbTop: Integer; Chk: boolean): Integer; +function TRichEditWB.AddRadioButton(rbCaption, rbName: string; + reLeft, rbLeft, rbTop: Integer; Chk: boolean): Integer; var RB: TRadioButton; begin @@ -3141,7 +3194,7 @@ function TRichEditWB.AddRadioButton(rbCaption, rbName: string; reLeft, rbLeft, Top := rbTop; Parent := Self; Checked := Chk; - inc(CompCount); + Inc(CompCount); Result := CompCount; end; end @@ -3149,8 +3202,8 @@ function TRichEditWB.AddRadioButton(rbCaption, rbName: string; reLeft, rbLeft, Result := 0; end; -function TRichEditWB.AddButton(bCaption, bName: string; reLeft, bLeft, bTop: - Integer): Integer; +function TRichEditWB.AddButton(bCaption, bName: string; + reLeft, bLeft, bTop: Integer): Integer; var B: TButton; begin @@ -3165,7 +3218,7 @@ function TRichEditWB.AddButton(bCaption, bName: string; reLeft, bLeft, bTop: Left := bLeft; Top := bTop; Parent := Self; - inc(CompCount); + Inc(CompCount); Result := CompCount; end; end @@ -3173,14 +3226,14 @@ function TRichEditWB.AddButton(bCaption, bName: string; reLeft, bLeft, bTop: Result := 0; end; -procedure TRichEditWB.SetModified(Value: Boolean); +procedure TRichEditWB.SetModified(Value: boolean); begin inherited Modified; UpdateInfo; - // if Assigned(FStatusbar) then + // if Assigned(FStatusbar) then begin - //FStatusbar.Panels[0].Width := 2000; - // FStatusbar.Panels[0].Text := Hint; + // FStatusbar.Panels[0].Width := 2000; + // FStatusbar.Panels[0].Text := Hint; end; end; @@ -3201,13 +3254,11 @@ procedure TRichEditWB.UpdateInfo; sMod := 'Modified' else sMod := ''; - Hint := 'File Name: ' + fFileName + '. | ' + - #10 + #13 + 'Position: ' + Format(sColRowInfo, [CharPos.Y, CharPos.X]) + '. | ' + - #10 + #13 + sMod + '. | ' + - #10 + #13 + CapsLockKey + '. | ' + - #10 + #13 + NumLockKey + '. | ' + - #10 + #13 + InsertKey + '. | ' + - #10 + #13 + 'Total Lines Count: ' + IntToStr(GetLineCount) + '. |'; + Hint := 'File Name: ' + FFileName + '. | ' + #10 + #13 + 'Position: ' + + Format(sColRowInfo, [CharPos.Y, CharPos.X]) + '. | ' + #10 + #13 + sMod + + '. | ' + #10 + #13 + CapsLockKey + '. | ' + #10 + #13 + NumLockKey + '. | ' + + #10 + #13 + InsertKey + '. | ' + #10 + #13 + 'Total Lines Count: ' + + IntToStr(GetLineCount) + '. |'; CursorPositionX := CharPos.X; CursorPositionY := CharPos.Y; end; @@ -3248,7 +3299,7 @@ procedure TRichEditWB.Open; begin ReadOnly := ofReadOnly in OD.Options; PerformFileOpen(OD.FileName); - Setfilename(OD.FileName); + SetFileName(OD.FileName); UpdateInfo; end; finally @@ -3278,7 +3329,7 @@ procedure TRichEditWB.SaveToStream(S: TStream); procedure TRichEditWB.Save; var - i: Integer; + I: Integer; begin if FFileName = sUntitled then begin @@ -3289,11 +3340,13 @@ procedure TRichEditWB.Save; begin if FileExists(Trim(FFileName + '.html')) then begin - i := MessageDlg(Format(sOverWrite, [Trim(FFileName + '.html')]), mtConfirmation, - mbYesNoCancel, 0); - if i = mrCancel then Exit; - if i = mrNo then SaveAs; - if i = mrYes then + I := MessageDlg(Format(sOverWrite, [Trim(FFileName + '.html')]), + mtConfirmation, mbYesNoCancel, 0); + if I = mrCancel then + Exit; + if I = mrNo then + SaveAs; + if I = mrYes then begin Lines.SaveToFile(Trim(FFileName + '.html')); Modified := False; @@ -3313,14 +3366,15 @@ procedure TRichEditWB.SaveAs; begin sd := TSaveDialog.Create(Self); try - SD.FileName := (Trim(FFileName + '.html')); - if SD.Execute then + sd.FileName := (Trim(FFileName + '.html')); + if sd.Execute then begin - if FileExists(Trim(SD.FileName + '.html')) then - if MessageDlg(Format(sOverWrite, [(Trim(SD.FileName + '.html'))]), mtConfirmation, mbYesNoCancel, 0) - <> idYes then Exit; - Lines.SaveToFile(SD.FileName + '.html'); - SetFileName(SD.FileName); + if FileExists(Trim(sd.FileName + '.html')) then + if MessageDlg(Format(sOverWrite, [(Trim(sd.FileName + '.html'))]), + mtConfirmation, mbYesNoCancel, 0) <> idYes then + Exit; + Lines.SaveToFile(sd.FileName + '.html'); + SetFileName(sd.FileName); Modified := False; SetModified(False); end; @@ -3331,7 +3385,7 @@ procedure TRichEditWB.SaveAs; procedure TRichEditWB.SetFileName(const FileName: string); begin - fFileName := FileName; + FFileName := FileName; end; procedure TRichEditWB.CheckFileSave; @@ -3340,18 +3394,21 @@ procedure TRichEditWB.CheckFileSave; begin if not Modified then Exit; - SaveResp := MessageDlg(Format(sSaveChanges, [FFileName]), - mtConfirmation, mbYesNoCancel, 0); + SaveResp := MessageDlg(Format(sSaveChanges, [FFileName]), mtConfirmation, + mbYesNoCancel, 0); case SaveResp of - idYes: Save; - idNo: {Nothing}; - idCancel: Abort; + idYes: + Save; + idNo: { Nothing } + ; + idCancel: + Abort; end; end; procedure TRichEditWB.WMDropFiles(var Msg: TWMDropFiles); var - CFileName: array[0..MAX_PATH] of Char; + CFileName: array [0 .. MAX_PATH] of Char; begin if AcceptDragFiles then begin @@ -3371,6 +3428,8 @@ procedure TRichEditWB.WMDropFiles(var Msg: TWMDropFiles); initialization finalization - if FRichEditModule <> 0 then - FreeLibrary(FRichEditModule); + +if FRichEditModule <> 0 then + FreeLibrary(FRichEditModule); + end. diff --git a/Source/SHDocVw_EWB.pas b/Source/SHDocVw_EWB.pas index 42b138d..f1abc89 100644 --- a/Source/SHDocVw_EWB.pas +++ b/Source/SHDocVw_EWB.pas @@ -63,7 +63,7 @@ interface {$I EWB.inc} uses - EwbAcc, Windows, ActiveX, Classes{$IFDEF USE_OleCtrlsFix}, OleCtrlsFix{$ENDIF}, OleCtrls, OleServer, StdVCL{$IFDEF DELPHI6_UP}, Variants{$ENDIF}; + EwbAcc, Windows, ActiveX, Classes{$IFDEF USE_OleCtrlsFix}, OleCtrlsFix{$ENDIF}, OleCtrls, OleServer, System.Win.StdVCL{$IFDEF DELPHI6_UP}, Variants{$ENDIF}; // *********************************************************************// // GUIDS declared in the TypeLibrary. Following prefixes are used: @@ -1552,7 +1552,7 @@ CoCScriptErrorList = class implementation -uses ComObj; +uses System.Win.ComObj; var VarEmptyParam: OleVariant; diff --git a/Source/SecurityManager.pas b/Source/SecurityManager.pas index 619e3a4..26f87e2 100644 --- a/Source/SecurityManager.pas +++ b/Source/SecurityManager.pas @@ -46,7 +46,7 @@ interface {$I EWB.inc} uses - Activex, UrlMon, Windows, SysUtils, Classes, IEConst; + Activex, UrlMon, Windows, SysUtils, Classes, EWB.IEConst; const DefaultActions: array[0..24] of DWORD = ( diff --git a/Source/SendMail_For_Ewb.pas b/Source/SendMail_For_Ewb.pas index 4ef2e2a..6437d4d 100644 --- a/Source/SendMail_For_Ewb.pas +++ b/Source/SendMail_For_Ewb.pas @@ -99,7 +99,7 @@ implementation {$IFDEF UNICODE} AnsiStrings, {$ENDIF UNICODE} - Windows, SysUtils, Registry, Forms; + Windows, SysUtils, System.Win.Registry, Forms; function MAPIErrorDescription(intErrorCode: Integer): string; begin @@ -212,21 +212,21 @@ function SendEMailByMAPI(SenderName, SenderAddress, Subject, Body: AnsiString; Result := MapiResolveName(0, 0, PAnsiChar(strRecipient), MAPI_DIALOG, 0, lpRecip); - StrCopy(PAnsiChar(new(TlpszRecipName)), lpRecip^.lpszName); + {$ifdef DELPHIXE3_UP}AnsiStrings.{$endif}StrCopy(PAnsiChar(new(TlpszRecipName)), lpRecip^.lpszName); if Result = SUCCESS_SUCCESS then begin - strRecipient := StrPas(lpRecip^.lpszName); + strRecipient := {$ifdef DELPHIXE3_UP}AnsiStrings.{$endif}StrPas(lpRecip^.lpszName); with lpRecipArray^[i] do begin if lpRecip^.lpszAddress = nil then begin - lpszAddress := StrCopy(new(TlpszRecipName)^, + lpszAddress := {$ifdef DELPHIXE3_UP}AnsiStrings.{$endif}StrCopy(new(TlpszRecipName)^, lpRecip^.lpszName); end else begin - lpszAddress := StrCopy(new(TlpszRecipName)^, + lpszAddress := {$ifdef DELPHIXE3_UP}AnsiStrings.{$endif}StrCopy(new(TlpszRecipName)^, lpRecip^.lpszAddress); end; ulEIDSize := lpRecip^.ulEIDSize; @@ -310,22 +310,26 @@ function SendEMailByMAPI(SenderName, SenderAddress, Subject, Body: AnsiString; lpAttachArray := TlpAttachArray(StrAlloc(nFileCount * SizeOf(TMapiFileDesc))); {$ENDIF UNICODE} - FillChar(lpAttachArray^, StrBufSize(PAnsiChar(lpAttachArray)), 0); + FillChar(lpAttachArray^, {$ifdef DELPHIXE3_UP}AnsiStrings.{$endif}StrBufSize(PAnsiChar(lpAttachArray)), 0); for i := 0 to nFileCount - 1 do begin lpAttachArray^[i].nPosition := Cardinal(-1); //Cardinal($FFFFFFFF); //ULONG(-1); - lpAttachArray^[i].lpszPathName := StrPCopy(new(TlpszPathname)^, + lpAttachArray^[i].lpszPathName := + {$ifdef DELPHIXE3_UP}AnsiStrings.{$endif} + StrPCopy(new(TlpszPathname)^, AnsiString(Attachments[i])); if i < AttachmentNames.Count then begin lpAttachArray^[i].lpszFileName := + {$ifdef DELPHIXE3_UP}AnsiStrings.{$endif} StrPCopy(new(TlpszFileName)^, AnsiString(AttachmentNames[i])) end else begin lpAttachArray^[i].lpszFileName := + {$ifdef DELPHIXE3_UP}AnsiStrings.{$endif} StrPCopy(new(TlpszFileName)^, AnsiString(ExtractFileName(Attachments[i]))); end; @@ -345,7 +349,11 @@ function SendEMailByMAPI(SenderName, SenderAddress, Subject, Body: AnsiString; lpRecipArray := TlpRecipArray(StrAlloc(Recipients.Count * SizeOf(TMapiRecipDesc))); {$ENDIF UNICODE} - FillChar(lpRecipArray^, StrBufSize(PAnsiChar(lpRecipArray)), 0); + + + FillChar(lpRecipArray^, {$ifdef DELPHIXE3_UP}AnsiStrings.{$endif} + StrBufSize(PAnsiChar(lpRecipArray)), 0); + for i := 0 to Recipients.Count - 1 do begin s := AnsiString(Recipients[i]); @@ -366,9 +374,13 @@ function SendEMailByMAPI(SenderName, SenderAddress, Subject, Body: AnsiString; CheckRecipient(s) else begin - lpRecipArray^[i].lpszName := StrCopy(new(TlpszRecipName)^, + lpRecipArray^[i].lpszName := + {$ifdef DELPHIXE3_UP}AnsiStrings.{$endif} + StrCopy(new(TlpszRecipName)^, PAnsiChar(s)); - lpRecipArray^[i].lpszAddress := StrCopy(new(TlpszRecipName)^, + lpRecipArray^[i].lpszAddress := + {$ifdef DELPHIXE3_UP}AnsiStrings.{$endif} + StrCopy(new(TlpszRecipName)^, PAnsiChar(s)); end; end; @@ -387,7 +399,7 @@ function SendEMailByMAPI(SenderName, SenderAddress, Subject, Body: AnsiString; Dispose(lpAttachArray^[i].lpszPathname); Dispose(lpAttachArray^[i].lpszFileName); end; - StrDispose(PAnsiChar(lpAttachArray)); + {$ifdef DELPHIXE3_UP}AnsiStrings.{$endif}StrDispose(PAnsiChar(lpAttachArray)); end; if Assigned(Recipients) and (Recipients.Count > 0) then @@ -400,7 +412,7 @@ function SendEMailByMAPI(SenderName, SenderAddress, Subject, Body: AnsiString; if Assigned(lpRecipArray^[i].lpszAddress) then Dispose(lpRecipArray^[i].lpszAddress); end; - StrDispose(PAnsiChar(lpRecipArray)); + {$ifdef DELPHIXE3_UP}AnsiStrings.{$endif}StrDispose(PAnsiChar(lpRecipArray)); end; if intMAPISession <> 0 then diff --git a/Source/UI_Less.pas b/Source/UI_Less.pas index f6074eb..b674d42 100644 --- a/Source/UI_Less.pas +++ b/Source/UI_Less.pas @@ -87,7 +87,7 @@ TUILess = class(TComponent, IUnknown, IDispatch, IPropertyNotifySink, IOleClie implementation uses - IEConst; + EWB.IEConst; var Doc: IhtmlDocument2; From babc3650e7fed477492916ce3f4c8b6ce7c43e98 Mon Sep 17 00:00:00 2001 From: Tristan Marlow Date: Wed, 17 Feb 2016 12:21:59 +0800 Subject: [PATCH 02/15] Removal of conflicting package names(eg IEConst is defined in vlcie) --- .gitignore | 7 + Source/EwbReg.pas | 2 +- Source/IEConst.pas | 1094 --------------- Source/LibXmlComps.pas | 110 -- Source/LibXmlParser.pas | 2961 --------------------------------------- 5 files changed, 8 insertions(+), 4166 deletions(-) create mode 100644 .gitignore delete mode 100644 Source/IEConst.pas delete mode 100644 Source/LibXmlComps.pas delete mode 100644 Source/LibXmlParser.pas diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..4f36e6a --- /dev/null +++ b/.gitignore @@ -0,0 +1,7 @@ +/Packages/*.identcache +/Packages/*.res +/Packages/*.stat +/Packages/*.~dsk +/Packages/*.dproj +/Packages/*.local +/Packages/*.dsk diff --git a/Source/EwbReg.pas b/Source/EwbReg.pas index 9335d70..956bb76 100644 --- a/Source/EwbReg.pas +++ b/Source/EwbReg.pas @@ -45,7 +45,7 @@ interface EwbEditors, AppWebUpdater, IEParser, ExportFavorites, FavoritesTree, IETravelLog, FavMenu, FavoritesListView, FavoritesPopup, HistoryMenu, HistoryListView, - ImportFavorites, LibXmlComps, LibXmlParser, LinksBar, RichEditBrowser, + ImportFavorites, EwbLibXmlComps, EwbLibXmlParser, LinksBar, RichEditBrowser, SecurityManager, SendMail_For_Ewb, UrlHistory, Edithost, EditDesigner, IEAddress, IEDownload, IEMultiDownload, EwbCore, EmbeddedWB, EwbControlComponent, IECache, Browse4Folder, diff --git a/Source/IEConst.pas b/Source/IEConst.pas deleted file mode 100644 index 5128773..0000000 --- a/Source/IEConst.pas +++ /dev/null @@ -1,1094 +0,0 @@ -//************************************************************** -// * -// IE-Const * -// For Delphi * -// * -// Contributions: * -// Per Linds Larsen * -// Eran Bodankin (bsalsa) bsalsa@gmail.com * -// Thomas Stutz (smot) * -// * -// Updated versions: * -// http://www.bsalsa.com * -//************************************************************** - -{*******************************************************************************} -{LICENSE: -THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, -EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED -WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. -YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE -AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE -AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE -OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED -OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, -INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR -OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, -AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. BSALSA PRODUCTIONS SPECIFICALLY -DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. - -You may use, change or modify the component under 4 conditions: -1. In your website, add a link to "http://www.bsalsa.com" -2. In your application, add credits to "Embedded Web Browser" -3. Mail me (bsalsa@gmail.com) any code change in the unit - for the benefit of the other users. -4. Please, consider donation in our web site! -{*******************************************************************************} - -unit IEConst; - -interface - -{$I EWB.inc} - - -// The reason for this file is that some constants are -// missing in previous delphi versions. - -const - ACO_NONE = 0; - ACO_AUTOSUGGEST = $1; - ACO_AUTOAPPEND = $2; - ACO_SEARCH = $4; - ACO_FILTERPREFIXES = $8; - ACO_USETAB = $10; - ACO_UPDOWNKEYDROPSLIST = $20; - ACO_RTLREADING = $40; - ACLO_NONE = 0; {don't enumerate anything} - ACLO_CURRENTDIR = 1; {enumerate current directory} - ACLO_MYCOMPUTER = 2; {enumerate MyComputer} - ACLO_DESKTOP = 4; {enumerate Desktop Folder} - ACLO_FAVORITES = 8; {enumerate Favorites Folder} - ACLO_FILESYSONLY = 16; {enumerate only the file system} - BINDSTATUS_FINDINGRESOURCE = 1; - BINDSTATUS_CONNECTING = 2; - BINDSTATUS_REDIRECTING = 3; - BINDSTATUS_BEGINDOWNLOADDATA = 4; - BINDSTATUS_DOWNLOADINGDATA = 5; - BINDSTATUS_ENDDOWNLOADDATA = 6; - BINDSTATUS_BEGINDOWNLOADCOMPONENTS = 7; - BINDSTATUS_INSTALLINGCOMPONENTS = 8; - BINDSTATUS_ENDDOWNLOADCOMPONENTS = 9; - BINDSTATUS_USINGCACHEDCOPY = 10; - BINDSTATUS_SENDINGREQUEST = 11; - BINDSTATUS_CLASSIDAVAILABLE = 12; - BINDSTATUS_MIMETYPEAVAILABLE = 13; - BINDSTATUS_CACHEFILENAMEAVAILABLE = 14; - BINDSTATUS_BEGINSYNCOPERATION = 15; - BINDSTATUS_ENDSYNCOPERATION = 16; - BINDSTATUS_BEGINUPLOADDATA = 17; - BINDSTATUS_UPLOADINGDATA = 18; - BINDSTATUS_ENDUPLOADINGDATA = 19; - BINDSTATUS_PROTOCOLCLASSID = 20; - BINDSTATUS_ENCODING = 21; - BINDSTATUS_VERFIEDMIMETYPEAVAILABLE = 22; - BINDSTATUS_CLASSINSTALLLOCATION = 23; - BINDSTATUS_DECODING = 24; - BINDSTATUS_LOADINGMIMEHANDLER = 25; - BINDSTATUS_CONTENTDISPOSITIONATTACH = 26; - BINDSTATUS_FILTERREPORTMIMETYPE = 27; - BINDSTATUS_CLSIDCANINSTANTIATE = 28; - BINDSTATUS_IUNKNOWNAVAILABLE = 29; - BINDSTATUS_DIRECTBIND = 30; - BINDSTATUS_RAWMIMETYPE = 31; - BINDSTATUS_PROXYDETECTING = 32; - BINDSTATUS_ACCEPTRANGES = 33; - BINDSTATUS_COOKIE_SENT = 34; - BINDSTATUS_COMPACT_POLICY_RECEIVED = 35; - BINDSTATUS_COOKIE_SUPPRESSED = 36; - BINDSTATUS_COOKIE_STATE_UNKNOWN = 37; - BINDSTATUS_COOKIE_STATE_ACCEPT = 38; - BINDSTATUS_COOKIE_STATE_REJECT = 39; - BINDSTATUS_COOKIE_STATE_PROMPT = 40; - BINDSTATUS_COOKIE_STATE_LEASH = 41; - BINDSTATUS_COOKIE_STATE_DOWNGRADE = 42; - BINDSTATUS_POLICY_HREF = 43; - BINDSTATUS_P3P_HEADER = 44; - BINDSTATUS_SESSION_COOKIE_RECEIVED = 45; - BINDSTATUS_PERSISTENT_COOKIE_RECEIVED = 46; - BINDSTATUS_SESSION_COOKIES_ALLOWED = 47; - BINDSTATUS_CACHECONTROL = 48; - BINDSTATUS_CONTENTDISPOSITIONFILENAME = 49; - BINDSTATUS_MIMETEXTPLAINMISMATCH = 50; - BINDSTATUS_PUBLISHERAVAILABLE = 51; - BINDSTATUS_DISPLAYNAMEAVAILABLE = 52; - BINDSTATUS_SSLUX_NAVBLOCKED = 53; - BINDSTATUS_SERVER_MIMETYPEAVAILABLE = 54; - BINDSTATUS_SNIFFED_CLASSIDAVAILABLE = 55; - BINDSTATUS_64BIT_PROGRESS = 56; - VER_NUM = ' 14.70.0'; - _MaskedChars: string = 'ACFNP'; - ADDRESS_NOT_VALID = 2147221020; //** - ASS_MESS = 'Please assign a WebBrowser before using this feature.'; - CACHEGROUP_ATTRIBUTE_BASIC = $00000001; - CACHEGROUP_ATTRIBUTE_FLAG = $00000002; - CACHEGROUP_ATTRIBUTE_GET_ALL = $FFFFFFFF; - CACHEGROUP_ATTRIBUTE_GROUPNAME = $00000010; - CACHEGROUP_ATTRIBUTE_QUOTA = $00000008; - CACHEGROUP_ATTRIBUTE_STORAGE = $00000020; - CACHEGROUP_ATTRIBUTE_TYPE = $00000004; - CACHEGROUP_FLAG_FLUSHURL_ONDELETE = $00000002; - CACHEGROUP_FLAG_GIDONLY = $00000004; - CACHEGROUP_FLAG_NONPURGEABLE = $00000001; - CACHEGROUP_SEARCH_ALL = $00000000; - CACHEGROUP_SEARCH_BYURL = $00000001; - CACHEGROUP_TYPE_INVALID = $00000001; - CACHEGROUP_READWRITE_MASK = CACHEGROUP_ATTRIBUTE_TYPE or - CACHEGROUP_ATTRIBUTE_QUOTA or CACHEGROUP_ATTRIBUTE_GROUPNAME or - CACHEGROUP_ATTRIBUTE_STORAGE; - CAddMenuExtensionsCommandID = 53; - CContextMenuID = 24641; - CGetMimeSubMenuCommandID = 27; - CIP_NEED_REBOOT_UI_PERMISSION = 9; - comctl32 = 'comctl32.dll'; - CONTEXT_MENU_ANCHOR = 5; - CONTEXT_MENU_CONTROL = 2; - CONTEXT_MENU_DEBUG = 9; - CONTEXT_MENU_DEFAULT = 0; - CONTEXT_MENU_HSCROLL = 11; - CONTEXT_MENU_IMAGE = 1; - CONTEXT_MENU_IMGART = 8; - CONTEXT_MENU_IMGDYNSRC = 7; - CONTEXT_MENU_TABLE = 3; - CONTEXT_MENU_TEXTSELECT = 4; - CONTEXT_MENU_UNKNOWN = 6; - CONTEXT_MENU_VSCROLL = 10; - CP_SYMBOL = 42; - CP_THREAD_ACP = 3; - DISPID_AMBIENT_DLCONTROL = (-5512); - DISPID_AMBIENT_USERAGENT = (-5513); - DOCHOSTUIDBLCLK_DEFAULT = 0; - DOCHOSTUIDBLCLK_SHOWCODE = 2; - DOCHOSTUIDBLCLK_SHOWPROPERTIES = 1; - DOCHOSTUIFLAG_ACTIVATE_CLIENTHIT_ONLY = $0200; - DOCHOSTUIFLAG_CODEPAGELINKEDFONTS = $0800; - DOCHOSTUIFLAG_DIALOG = $0001; - DOCHOSTUIFLAG_DISABLE_HELP_MENU = $0002; - DOCHOSTUIFLAG_DISABLE_OFFSCREEN = $0040; - DOCHOSTUIFLAG_DISABLE_SCRIPT_INACTIVE = $0010; - DOCHOSTUIFLAG_DIV_BLOCKDEFAULT = $0100; - DOCHOSTUIFLAG_ENABLE_FORMS_AUTOCOMPLETE = $4000; - DOCHOSTUIFLAG_ENABLE_INPLACE_NAVIGATION = $10000; - DOCHOSTUIFLAG_FLAT_SCROLLBAR = $0080; - DOCHOSTUIFLAG_IME_ENABLE_RECONVERSION = $20000; - DOCHOSTUIFLAG_NO3DBORDER = $0004; - DOCHOSTUIFLAG_OPENNEWWIN = $0020; - DOCHOSTUIFLAG_OVERRIDEBEHAVIORFACTORY = $0400; - DOCHOSTUIFLAG_SCROLL_NO = $0008; - DOCHOSTUIFLAG_URL_ENCODING_DISABLE_UTF8 = $1000; - DOCHOSTUIFLAG_URL_ENCODING_ENABLE_UTF8 = $2000; - DOCHOSTUITYPE_AUTHOR = 1; - DOCHOSTUITYPE_BROWSE = 0; - ERROR_INTERNET_FORTEZZA_LOGIN_NEEDED = 12054; - INTERNET_ERROR_BASE = 12000; - ERROR_INTERNET_OUT_OF_HANDLES = INTERNET_ERROR_BASE + 1; - ERROR_INTERNET_TIMEOUT = INTERNET_ERROR_BASE + 2; - ERROR_INTERNET_EXTENDED_ERROR = INTERNET_ERROR_BASE + 3; - ERROR_INTERNET_INTERNAL_ERROR = INTERNET_ERROR_BASE + 4; - ERROR_INTERNET_INVALID_URL = INTERNET_ERROR_BASE + 5; - ERROR_INTERNET_UNRECOGNIZED_SCHEME = INTERNET_ERROR_BASE + 6; - ERROR_INTERNET_NAME_NOT_RESOLVED = INTERNET_ERROR_BASE + 7; - ERROR_INTERNET_PROTOCOL_NOT_FOUND = INTERNET_ERROR_BASE + 8; - ERROR_INTERNET_INVALID_OPTION = INTERNET_ERROR_BASE + 9; - ERROR_INTERNET_BAD_OPTION_LENGTH = INTERNET_ERROR_BASE + 10; - ERROR_INTERNET_OPTION_NOT_SETTABLE = INTERNET_ERROR_BASE + 11; - ERROR_INTERNET_SHUTDOWN = INTERNET_ERROR_BASE + 12; - ERROR_INTERNET_INCORRECT_USER_NAME = INTERNET_ERROR_BASE + 13; - ERROR_INTERNET_INCORRECT_PASSWORD = INTERNET_ERROR_BASE + 14; - ERROR_INTERNET_LOGIN_FAILURE = INTERNET_ERROR_BASE + 15; - ERROR_INTERNET_INVALID_OPERATION = INTERNET_ERROR_BASE + 16; - ERROR_INTERNET_OPERATION_CANCELLED = INTERNET_ERROR_BASE + 17; - ERROR_INTERNET_INCORRECT_HANDLE_TYPE = INTERNET_ERROR_BASE + 18; - ERROR_INTERNET_INCORRECT_HANDLE_STATE = INTERNET_ERROR_BASE + 19; - ERROR_INTERNET_NOT_PROXY_REQUEST = INTERNET_ERROR_BASE + 20; - ERROR_INTERNET_REGISTRY_VALUE_NOT_FOUND = INTERNET_ERROR_BASE + 21; - ERROR_INTERNET_BAD_REGISTRY_PARAMETER = INTERNET_ERROR_BASE + 22; - ERROR_INTERNET_NO_DIRECT_ACCESS = INTERNET_ERROR_BASE + 23; - ERROR_INTERNET_NO_CONTEXT = INTERNET_ERROR_BASE + 24; - ERROR_INTERNET_NO_CALLBACK = INTERNET_ERROR_BASE + 25; - ERROR_INTERNET_REQUEST_PENDING = INTERNET_ERROR_BASE + 26; - ERROR_INTERNET_INCORRECT_FORMAT = INTERNET_ERROR_BASE + 27; - ERROR_INTERNET_ITEM_NOT_FOUND = INTERNET_ERROR_BASE + 28; - ERROR_INTERNET_CANNOT_CONNECT = INTERNET_ERROR_BASE + 29; - ERROR_INTERNET_CONNECTION_ABORTED = INTERNET_ERROR_BASE + 30; - ERROR_INTERNET_CONNECTION_RESET = INTERNET_ERROR_BASE + 31; - ERROR_INTERNET_FORCE_RETRY = INTERNET_ERROR_BASE + 32; - ERROR_INTERNET_INVALID_PROXY_REQUEST = INTERNET_ERROR_BASE + 33; - ERROR_INTERNET_HANDLE_EXISTS = INTERNET_ERROR_BASE + 36; - ERROR_INTERNET_SEC_CERT_DATE_INVALID = INTERNET_ERROR_BASE + 37; - ERROR_INTERNET_SEC_CERT_CN_INVALID = INTERNET_ERROR_BASE + 38; - ERROR_INTERNET_HTTP_TO_HTTPS_ON_REDIR = INTERNET_ERROR_BASE + 39; - ERROR_INTERNET_HTTPS_TO_HTTP_ON_REDIR = INTERNET_ERROR_BASE + 40; - ERROR_INTERNET_MIXED_SECURITY = INTERNET_ERROR_BASE + 41; - ERROR_INTERNET_CHG_POST_IS_NON_SECURE = INTERNET_ERROR_BASE + 42; - ERROR_INTERNET_POST_IS_NON_SECURE = INTERNET_ERROR_BASE + 43; - ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED = INTERNET_ERROR_BASE + 44; - ERROR_INTERNET_INVALID_CA = INTERNET_ERROR_BASE + 45; - ERROR_INTERNET_CLIENT_AUTH_NOT_SETUP = INTERNET_ERROR_BASE + 46; - ERROR_INTERNET_ASYNC_THREAD_FAILED = INTERNET_ERROR_BASE + 47; - ERROR_INTERNET_REDIRECT_SCHEME_CHANGE = INTERNET_ERROR_BASE + 48; - ERROR_INTERNET_DIALOG_PENDING = INTERNET_ERROR_BASE + 49; - ERROR_INTERNET_RETRY_DIALOG = INTERNET_ERROR_BASE + 50; - ERROR_INTERNET_HTTPS_HTTP_SUBMIT_REDIR = INTERNET_ERROR_BASE + 52; - ERROR_INTERNET_INSERT_CDROM = INTERNET_ERROR_BASE + 53; - E_PENDING = $8000000A; - IED_INFO = ' IEDownload http://bsalsa.com/'; - EWB_INFO = ' EmbeddedWB http://bsalsa.com/'; - EXPLORE_COMMAND = 2; - FEATURE_FROM_PROCESS = $00000002; - FEATURE_FROM_REGISTRY = $00000004; - FEATURE_FROM_THREAD = $00000001; - FEATURE_FROM_THREAD_INTERNET = $00000040; - FEATURE_FROM_THREAD_INTRANET = $00000010; - FEATURE_FROM_THREAD_LOCALMACHINE = $00000008; - FEATURE_FROM_THREAD_RESTRICTED = $00000080; - FEATURE_FROM_THREAD_TRUSTED = $00000020; - FIND_COMMAND = 3; - Free_Index = 73; - GROUP_OWNER_STORAGE_SIZE = 4; - GROUPNAME_MAX_LENGTH = 120; - hhctrl = 'hhctrl.ocx'; - HoursPerDay = 24; - HTMLID_FIND = 1; - HTMLID_OPTIONS = 3; - HTMLID_VIEWSOURCE = 2; - HTTP_QUERY_FLAG_COALESCE = $10000000; - HTTP_QUERY_FLAG_NUMBER = $20000000; - HTTP_QUERY_FLAG_REQUEST_HEADERS = $80000000; - HTTP_QUERY_FLAG_SYSTEMTIME = $40000000; - HTTP_QUERY_MODIFIER_FLAGS_MASK = (HTTP_QUERY_FLAG_REQUEST_HEADERS or - HTTP_QUERY_FLAG_SYSTEMTIME or HTTP_QUERY_FLAG_NUMBER or - HTTP_QUERY_FLAG_COALESCE); - ID_EDITMODE = 32801; - ID_IE_CONTEXTMENU_ADDFAV = 2261; - ID_IE_CONTEXTMENU_NEWWINDOW = 2137; - ID_IE_CONTEXTMENU_REFRESH = 6042; - ID_IE_F5_REFRESH = 6041; // added by smot - ID_IE_FILE_ADDLOCAL = 377; - ID_IE_FILE_ADDTRUST = 376; - ID_IE_FILE_IMPORTEXPORT = 374; - ID_IE_FILE_NEWCALL = 395; - ID_IE_FILE_NEWMAIL = 279; - ID_IE_FILE_NEWPEOPLE = 390; - ID_IE_FILE_NEWPUBLISHINFO = 387; - ID_IE_FILE_NEWWINDOW = 275; - ID_IE_FILE_PAGESETUP = 259; - ID_IE_FILE_PRINT = 260; - ID_IE_FILE_PRINTPREVIEW = 277; - ID_IE_FILE_SENDDESKTOPSHORTCUT = 284; - ID_IE_FILE_SENDLINK = 283; - ID_IE_FILE_SENDPAGE = 282; - ID_IE_HELP_BESTPAGE = 346; - ID_IE_HELP_ENHANCEDSECURITY = 375; - ID_IE_HELP_FAQ = 343; - ID_IE_HELP_FEEDBACK = 345; - ID_IE_HELP_FREESTUFF = 341; - ID_IE_HELP_HELPINDEX = 337; - ID_IE_HELP_MSHOME = 348; - ID_IE_HELP_NETSCAPEUSER = 351; - ID_IE_HELP_ONLINESUPPORT = 344; - ID_IE_HELP_PRODUCTUPDATE = 342; - ID_IE_HELP_SEARCHWEB = 347; - ID_IE_HELP_STARTPAGE = 350; - ID_IE_HELP_VERSIONINFO = 336; - ID_IE_HELP_VISITINTERNET = 349; - ID_IE_HELP_WEBTUTORIAL = 338; - IDM_1D = 2170; - IDM_ADDFAVORITES = 2261; - IDM_ADDRESS = 2189; - IDM_ADDTOFAVOURITES = 2261; - IDM_ALIGNBOTTOM = 1; - IDM_ALIGNHORIZONTALCENTERS = 2; - IDM_ALIGNLEFT = 3; - IDM_ALIGNRIGHT = 4; - IDM_ALIGNTOGRID = 5; - IDM_ALIGNTOP = 6; - IDM_ALIGNVERTICALCENTERS = 7; - IDM_APPLYHEADING1 = 2255; - IDM_APPLYHEADING2 = 2256; - IDM_APPLYHEADING3 = 2257; - IDM_APPLYNORMAL = 2254; - IDM_ARRANGEBOTTOM = 8; - IDM_ARRANGERIGHT = 9; - IDM_AUTODETECT = 2329; - IDM_BACK = 2282; - IDM_BACKCOLOR = 51; - IDM_BASELINEFONT1 = 2141; - IDM_BASELINEFONT3 = 2143; - IDM_BASELINEFONT4 = 2144; - IDM_BASELINEFONT5 = 2145; - IDM_BLINK = 2190; - IDM_BLOCKFMT = 2234; - IDM_BOLD = 52; - IDM_BOOKMARK = 2123; - IDM_BORDERCOLOR = 53; - IDM_BREAKATNEXT = 2311; - IDM_BRINGFORWARD = 10; - IDM_BRINGTOFRONT = 11; - IDM_BROWSEMODE = 2126; - IDM_BUTTON = 2167; - IDM_CANCEL = 89; - IDM_CAPTIONINSERT = 2203; - IDM_CELLINSERT = 2202; - IDM_CELLMERGE = 2204; - IDM_CELLPROPERTIES = 2211; - IDM_CELLSELECT = 2206; - IDM_CELLSPLIT = 2205; - IDM_CENTERALIGNPARA = 2250; - IDM_CENTERHORIZONTALLY = 12; - IDM_CENTERVERTICALLY = 13; - IDM_CHANGECASE = 2246; - IDM_CHANGEFONT = 2240; - IDM_CHANGEFONTSIZE = 2241; - IDM_CHECKBOX = 2163; - IDM_CHISELED = 64; - IDM_CLEARSELECTION = 2007; - IDM_CODE = 14; - IDM_COLUMNINSERT = 2213; - IDM_COLUMNSELECT = 2208; - IDM_COMMENT = 2173; - IDM_COMPOSESETTINGS = 2318; - IDM_CONTEXTMENU = 2280; - IDM_CONVERTOBJECT = 82; - IDM_COPY = 15; - IDM_COPYBACKGROUND = 2265; - IDM_COPYCONTENT = 2291; - IDM_COPYFORMAT = 2237; - IDM_COPYSHORTCUT = 2262; - IDM_CREATELINK = 2290; - IDM_CREATESHORTCUT = 2266; - IDM_CUSTOMCONTROL = 83; - IDM_CUSTOMIZEITEM = 84; - IDM_CUT = 16; - IDM_DECFONTSIZE = 2243; - IDM_DECFONTSIZE1PT = 2245; - IDM_DELETE = 17; - IDM_DELETEWORD = 92; - IDM_DIV = 2191; - IDM_DOCPROPERTIES = 2260; - IDM_DROPDOWNBOX = 2165; - IDM_DYNSRCPLAY = 2271; - IDM_DYNSRCSTOP = 2272; - IDM_EDITMODE = 2127; - IDM_EDITSOURCE = 2122; - IDM_ENABLE_INTERACTION = 2302; - IDM_ENCODING = 2292; - IDM_ETCHED = 65; - IDM_FILE = 2172; - IDM_FIND = 67; - IDM_FLAT = 54; - IDM_FOLLOW_ANCHOR = 2008; - IDM_FOLLOWLINKC = 2136; - IDM_FOLLOWLINKN = 2137; - IDM_FONT = 90; - IDM_FONTNAME = 18; - IDM_FONTSIZE = 19; - IDM_FORECOLOR = 55; - IDM_FORM = 2181; - IDM_FORMATMARK = 2132; - IDM_FORWARD = 2283; - IDM_GETBLOCKFMTS = 2233; - IDM_GETBYTESDOWNLOADED = 2331; - IDM_GETZOOM = 68; - IDM_GOBACKWARD = 2282; - IDM_GOFORWARD = 2283; - IDM_GOTO = 2239; - IDM_GROUP = 20; - IDM_HELP_ABOUT = 2221; - IDM_HELP_CONTENT = 2220; - IDM_HELP_README = 2222; - IDM_HORIZONTALLINE = 2150; - IDM_HORIZSPACECONCATENATE = 21; - IDM_HORIZSPACEDECREASE = 22; - IDM_HORIZSPACEINCREASE = 23; - IDM_HORIZSPACEMAKEEQUAL = 24; - IDM_HTMLCONTAIN = 2159; - IDM_HTMLEDITMODE = 2316; - IDM_HTMLSOURCE = 2157; - IDM_HYPERLINK = 2124; - IDM_IFRAME = 2158; - IDM_IMAGE = 2168; - IDM_IMAGEMAP = 2171; - IDM_IMGARTPLAY = 2274; - IDM_IMGARTREWIND = 2276; - IDM_IMGARTSTOP = 2275; - IDM_IMPORT = 86; - IDM_INCFONTSIZE = 2242; - IDM_INCFONTSIZE1PT = 2244; - IDM_INDENT = 2186; - IDM_INSERTOBJECT = 25; - IDM_INSFIELDSET = 2119; - IDM_INSINPUTBUTTON = 2115; - IDM_INSINPUTHIDDEN = 2312; - IDM_INSINPUTIMAGE = 2114; - IDM_INSINPUTPASSWORD = 2313; - IDM_INSINPUTRESET = 2116; - IDM_INSINPUTSUBMIT = 2117; - IDM_INSINPUTUPLOAD = 2118; - IDM_ITALIC = 56; - IDM_JAVAAPPLET = 2175; - IDM_JUSTIFYCENTER = 57; - IDM_JUSTIFYFULL = 50; - IDM_JUSTIFYGENERAL = 58; - IDM_JUSTIFYLEFT = 59; - IDM_JUSTIFYRIGHT = 60; - IDM_LANGUAGE = 2292; - IDM_LAUNCHDEBUGGER = 2310; - IDM_LEFTALIGNPARA = 2251; - IDM_LINEBREAKBOTH = 2154; - IDM_LINEBREAKLEFT = 2152; - IDM_LINEBREAKNORMAL = 2151; - IDM_LINEBREAKRIGHT = 2153; - IDM_LIST = 2183; - IDM_LISTBOX = 2166; - IDM_MARQUEE = 2182; - IDM_MENUEXT_COUNT = 3733; - IDM_MENUEXT_FIRST__ = 3700; - IDM_MENUEXT_LAST__ = 3732; - IDM_MIMECSET__FIRST__ = 3609; - IDM_MIMECSET__LAST__ = 3640; - IDM_MOVE = 88; - IDM_MULTILEVELREDO = 30; - IDM_MULTILEVELUNDO = 44; - IDM_NEW = 2001; - IDM_NEWPAGE = 87; - IDM_NOACTIVATEDESIGNTIMECONTROLS = 2333; - IDM_NOACTIVATEJAVAAPPLETS = 2334; - IDM_NOACTIVATENORMALOLECONTROLS = 2332; - IDM_NONBREAK = 2155; - IDM_OBJECT = 2169; - IDM_OBJECTVERBLIST0 = 72; - IDM_OBJECTVERBLIST1 = 73; - IDM_OBJECTVERBLIST2 = 74; - IDM_OBJECTVERBLIST3 = 75; - IDM_OBJECTVERBLIST4 = 76; - IDM_OBJECTVERBLIST5 = 77; - IDM_OBJECTVERBLIST6 = 78; - IDM_OBJECTVERBLIST7 = 79; - IDM_OBJECTVERBLIST8 = 80; - IDM_OBJECTVERBLIST9 = 81; - IDM_OPEN = 2000; - IDM_OPENINNEWWINDOW = 2137; - IDM_OPENLINK = 2136; - IDM_OPTIONS = 2135; - IDM_ORDERLIST = 2184; - IDM_OUTDENT = 2187; - IDM_OVERWRITE = 2314; - IDM_PAGE = 2267; - IDM_PAGEBREAK = 2177; - IDM_PAGEINFO = 2231; - IDM_PAGESETUP = 2004; - IDM_PARAGRAPH = 2180; - IDM_PARSECOMPLETE = 2315; - IDM_PASTE = 26; - IDM_PASTEFORMAT = 2238; - IDM_PASTEINSERT = 2120; - IDM_PASTESPECIAL = 2006; - IDM_PERSISTSTREAMSYNC = 2341; - IDM_PLUGIN = 2176; - IDM_PREFORMATTED = 2188; - IDM_PRESTOP = 2284; - IDM_PRINT = 27; - IDM_PRINTPREVIEW = 2003; - IDM_PRINTQUERYJOBSPENDING = 2277; - IDM_PRINTTARGET = 2273; - IDM_PROPERTIES = 28; - IDM_RADIOBUTTON = 2164; - IDM_RAISED = 61; - IDM_RCINSERT = 2201; - IDM_REDO = 29; - IDM_REFRESH = 2300; - IDM_REGISTRYREFRESH = 2317; - IDM_REMOVEFORMAT = 2230; - IDM_REMOVEPARAFORMAT = 2253; - IDM_RENAME = 85; - IDM_REPLACE = 2121; - IDM_RIGHTALIGNPARA = 2252; - IDM_ROWINSERT = 2212; - IDM_ROWSELECT = 2207; - IDM_SAVE = 70; - IDM_SAVEAS = 71; - IDM_SAVEBACKGROUND = 2263; - IDM_SAVECOPYAS = 2002; - IDM_SAVEPICTURE = 2270; - IDM_SAVETARGET = 2268; - IDM_SCRIPT = 2174; - IDM_SCRIPTDEBUGGER = 2330; - IDM_SELECTALL = 31; - IDM_SENDBACKWARD = 32; - IDM_SENDTOBACK = 33; - IDM_SETASBACKGROUND = 2264; - IDM_SETASDESKTOPITEM = 2278; - IDM_SETDIRTY = 2342; - IDM_SETWALLPAPER = 2264; - IDM_SHADOWED = 66; - IDM_SHOWALIGNEDSITETAGS = 2321; - IDM_SHOWALLTAGS = 2320; - IDM_SHOWAREATAGS = 2325; - IDM_SHOWCOMMENTTAGS = 2324; - IDM_SHOWGRID = 69; - IDM_SHOWHIDE_CODE = 2235; - IDM_SHOWMISCTAGS = 2327; - IDM_SHOWPICTURE = 2269; - IDM_SHOWSCRIPTTAGS = 2322; - IDM_SHOWSPECIALCHAR = 2249; - IDM_SHOWSTYLETAGS = 2323; - IDM_SHOWTABLE = 34; - IDM_SHOWUNKNOWNTAGS = 2326; - IDM_SHOWWBRTAGS = 2340; - IDM_SHOWZEROBORDERATDESIGNTIME = 2328; - IDM_SIZETOCONTROL = 35; - IDM_SIZETOCONTROLHEIGHT = 36; - IDM_SIZETOCONTROLWIDTH = 37; - IDM_SIZETOFIT = 38; - IDM_SIZETOGRID = 39; - IDM_SNAPTOGRID = 40; - IDM_SPECIALCHAR = 2156; - IDM_SPELL = 2005; - IDM_STATUSBAR = 2131; - IDM_STOP = 2138; - IDM_STOPDOWNLOAD = 2301; - IDM_STRIKETHROUGH = 91; - IDM_SUBSCRIPT = 2247; - IDM_SUNKEN = 62; - IDM_SUPERSCRIPT = 2248; - IDM_TABLE = 2236; - IDM_TABLEINSERT = 2200; - IDM_TABLEPROPERTIES = 2210; - IDM_TABLESELECT = 2209; - IDM_TABORDER = 41; - IDM_TELETYPE = 2232; - IDM_TEXTAREA = 2162; - IDM_TEXTBOX = 2161; - IDM_TEXTONLY = 2133; - IDM_TOOLBARS = 2130; - IDM_TOOLBOX = 42; - IDM_TRIED_CONSTRAIN = 12; //[in,VT_BOOL] - IDM_TRIED_DELETECELLS = 21; - IDM_TRIED_DELETECOLS = 17; - IDM_TRIED_DELETEROWS = 16; - IDM_TRIED_INSERTCELL = 20; - IDM_TRIED_INSERTCOL = 15; - IDM_TRIED_INSERTROW = 14; - IDM_TRIED_INSERTTABLE = 22; //[in, VT_ARRAY] - IDM_TRIED_IS_1D_ELEMENT = 0; //[out,VT_BOOL] - IDM_TRIED_IS_2D_ELEMENT = 1; //[out,VT_BOOL] - IDM_TRIED_LAST_CID = IDM_TRIED_INSERTTABLE; //WARNING WARNING WARNING!!! Don't forget to modify IDM_TRIED_LAST_CID - IDM_TRIED_LOCK_ELEMENT = 5; - IDM_TRIED_MAKE_ABSOLUTE = 4; - IDM_TRIED_MERGECELLS = 18; - IDM_TRIED_NUDGE_ELEMENT = 2; //[in,VT_BYREF VARIANT.byref=LPPOINT] - IDM_TRIED_SEND_BACKWARD = 8; - IDM_TRIED_SEND_BEHIND_1D = 10; - IDM_TRIED_SEND_FORWARD = 9; - IDM_TRIED_SEND_FRONT_1D = 11; - IDM_TRIED_SEND_TO_BACK = 6; - IDM_TRIED_SEND_TO_FRONT = 7; - IDM_TRIED_SET_2D_DROP_MODE = 13; //[in,VT_BOOL] - IDM_TRIED_SET_ALIGNMENT = 3; //[in,VT_BYREF VARIANT.byref=LPPOINT] - IDM_TRIED_SPLITCELL = 19; - IDM_UNBOOKMARK = 2128; - IDM_UNDERLINE = 63; - IDM_UNDO = 43; - IDM_UNGROUP = 45; - IDM_UNKNOWN = 0; - IDM_UNLINK = 2125; - IDM_UNORDERLIST = 2185; - IDM_VERTSPACECONCATENATE = 46; - IDM_VERTSPACEDECREASE = 47; - IDM_VERTSPACEINCREASE = 48; - IDM_VERTSPACEMAKEEQUAL = 49; - IDM_VIEWSOURCE = 2139; - IDM_ZOOMPERCENT = 50; - IDM_ZOOMPOPUP = 2140; - IE_PPREVIEWCLASS = 'Internet Explorer_TridentDlgFrame'; - InchToMetric = 25.4; - INET_E_AUTHENTICATION_REQUIRED = -2146697207; - INET_E_CANNOT_CONNECT = -2146697212; - INET_E_CANNOT_INSTANTIATE_OBJECT = -2146697200; - INET_E_CANNOT_LOAD_DATA = -2146697201; - INET_E_CANNOT_LOCK_REQUEST = -2146697194; - INET_E_CANNOT_REPLACE_SFP_FILE = -2146697448; - INET_E_CODE_DOWNLOAD_DECLINED = -2146697960; - INET_E_CONNECTION_TIMEOUT = -2146697205; //** - INET_E_DATA_NOT_AVAILABLE = -2146697209; - INET_E_DOWNLOAD_FAILURE = -2146697208; - INET_E_INVALID_REQUEST = -2146697204; - INET_E_INVALID_URL = -2146697214; - INET_E_NO_SESSION = -2146697213; - INET_E_NO_VALID_MEDIA = -2146697206; - INET_E_OBJECT_NOT_FOUND = -2146697210; - INET_E_REDIRECT_FAILED = -2146697196; - INET_E_REDIRECT_TO_DIR = -2146697195; - INET_E_RESOURCE_NOT_FOUND = -2146697211; //** - INET_E_RESULT_DISPATCHED = -2146697704; - INET_E_SECURITY_PROBLEM = -2146697202; //** - INET_E_TERMINATED_BIND = -2146697192; - INET_E_UNKNOWN_PROTOCOL = -2146697203; - INET_E_USE_EXTEND_BINDING = -2146697193; - INTERNET_OPTION_PER_CONNECTION_OPTION = 75; - INTERNET_OPTION_REFRESH = 37; - INTERNET_OPTION_SETTINGS_CHANGED = 39; - INTERNET_PER_CONN_AUTOCONFIG_URL = 4; - INTERNET_PER_CONN_AUTODISCOVERY_FLAGS = 5; - INTERNET_PER_CONN_FLAGS = 1; - INTERNET_PER_CONN_PROXY_BYPASS = 3; - INTERNET_PER_CONN_PROXY_SERVER = 2; - INTERNET_SCHEME_PARTIAL = -2; - INTERNET_SCHEME_UNKNOWN = -1; - INTERNET_SCHEME_DEFAULT = 0; - INTERNET_SCHEME_FTP = 1; - INTERNET_SCHEME_GOPHER = 2; - INTERNET_SCHEME_HTTP = 3; - INTERNET_SCHEME_HTTPS = 4; - INTERNET_SCHEME_FILE = 5; - INTERNET_SCHEME_NEWS = 6; - INTERNET_SCHEME_MAILTO = 7; - INTERNET_SCHEME_SOCKS = 8; - INTERNET_SCHEME_JAVASCRIPT = 9; - INTERNET_SCHEME_VBSCRIPT = 10; - INTERNET_SCHEME_RES = 11; - INTERNET_SCHEME_FIRST = INTERNET_SCHEME_FTP; - INTERNET_SCHEME_LAST = INTERNET_SCHEME_MAILTO; - INTERNET_SCHEME_ABOUT = 24; - INTERNET_SCHEME_COOKIE = 25; - INTERNET_SCHEME_CUSTOM_FIRST = INTERNET_SCHEME_ABOUT; - INTERNET_SCHEME_CUSTOM_LAST = INTERNET_SCHEME_COOKIE; - INTERNET_STATE_CONNECTED = $1; - INTERNET_STATE_DISCONNECTED_BY_USER = $10; - INSTALL_SCOPE_INVALID = 0; - INSTALL_SCOPE_MACHINE = 1; - INSTALL_SCOPE_USER = 2; - ISDigit = ['0'..'9', '-', '+']; - ISO_FORCE_DISCONNECTED = $1; - IURL_INVOKECOMMAND_FL_ALLOW_UI = $0001; - IURL_INVOKECOMMAND_FL_DDEWAIT = $0004; // pass DDEWAIT to ShellExec - IURL_INVOKECOMMAND_FL_USE_DEFAULT_VERB = $0002; // Ignore pcszVerb - IURL_SETURL_FL_GUESS_PROTOCOL = $0001; // Guess protocol if missing - IURL_SETURL_FL_USE_DEFAULT_PROTOCOL = $0002; // Use default protocol if missing - MIMEASSOCDLG_FL_REGISTER_ASSOC = $0001; - MinsPerHour = 60; - MOUSE_XBUTTONNEXT = $20000; - MOUSE_XBUTTONPREV = $10000; - MSecsPerSec = 1000; - navAllowAutosearch = $00000010; - navBrowserBar = $00000020; - navNoHistory = $00000002; - navNoReadFromCache = $00000004; - navNoWriteToCache = $00000008; - navOpenInNewWindow = $00000001; - NO_COMMAND = 0; - PathDelim = {$IFDEF MSWINDOWS} '\'; {$ELSE} '/'; {$ENDIF} - PROXY_TYPE_AUTO_DETECT = $00000008; - PROXY_TYPE_AUTO_PROXY_URL = $00000004; - PROXY_TYPE_DIRECT = $00000001; - PROXY_TYPE_PROXY = $00000002; - QUERY_EXPIRATION_DATE = 1; - QUERY_TIME_OF_LAST_CHANGE = 2; - QUERY_CONTENT_ENCODING = 3; - QUERY_CONTENT_TYPE = 4; - QUERY_REFRESH = 5; - QUERY_RECOMBINE = 6; - QUERY_CAN_NAVIGATE = 7; - QUERY_USES_NETWORK = 8; - QUERY_IS_CACHED = 9; - QUERY_IS_INSTALLEDENTRY = 10; - QUERY_IS_CACHED_OR_MAPPED = 11; - QUERY_USES_CACHE = 12; - QUERY_IS_SECURE = 13; - QUERY_IS_SAFE = 14; - QUERY_USES_HISTORYFOLDER = 15; - QUICK_LAUNCH_ROOT = 'Software\MicroSoft\Windows\CurrentVersion\GrpConv'; - READYSTATE_COMPLETE = $00000004; - READYSTATE_INTERACTIVE = $00000003; - READYSTATE_LOADED = $00000002; - READYSTATE_LOADING = $00000001; - READYSTATE_UNINITIALIZED = $00000000; - RegMail = 'Software\Microsoft\Windows\CurrentVersion\UnreadMail\'; - SecsPerMin = 60; - SHACF_AUTOAPPEND_FORCE_OFF = $80000000; // Ignore the registry default and force the feature off. (Also know as AutoComplete) - SHACF_AUTOAPPEND_FORCE_ON = $40000000; // Ignore the registry default and force the feature on. (Also know as AutoComplete) - SHACF_AUTOSUGGEST_FORCE_OFF = $20000000; // Ignore the registry default and force the feature off. - SHACF_AUTOSUGGEST_FORCE_ON = $10000000; // Ignore the registry default and force the feature on. - SHACF_DEFAULT = $00000000; // Currently (SHACF_FILESYSTEM | SHACF_URLALL) - SHACF_FILESYSTEM = $00000001; // This includes the File System as well as the rest of the shell (Desktop\My Computer\Control Panel\) - SHACF_URLHISTORY = $00000002; // URLs in the User's History - SHACF_URLMRU = $00000004; // URLs in the User's Recently Used list. - SHACF_USETAB = $00000008; - SHACF_URLALL = (SHACF_URLHISTORY + SHACF_URLMRU); - SHELL_FOLDERS_ROOT = 'Software\MicroSoft\Windows\CurrentVersion\Explorer'; - Shell32 = 'shell32.dll'; - SHFreeShared_Index = 523; - SHLockShared_Index = 521; - SHUnlockShared_Index = 522; - SITE_ADDRESS = 'http://bsalsa.com/'; - STATURL_QUERYFLAG_ISCACHED = $00010000; - STATURL_QUERYFLAG_NOTITLE = $00040000; - STATURL_QUERYFLAG_NOURL = $00020000; - STATURL_QUERYFLAG_TOPLEVEL = $00080000; - STATURLFLAG_ISCACHED = $00000001; - STATURLFLAG_ISTOPLEVEL = $00000002; - TLEF_ABSOLUTE = $00000031; - TLEF_INCLUDE_UNINVOKEABLE = $00000040; - TLEF_RELATIVE_BACK = $00000010; - TLEF_RELATIVE_FORE = $00000020; - TLEF_RELATIVE_INCLUDE_CURRENT = $00000001; - TRANSLATEURL_FL_GUESS_PROTOCOL = $0001; // Guess protocol if missing - TRANSLATEURL_FL_USE_DEFAULT_PROTOCOL = $0002; // Use default protocol if missing - UNKNOWN_RESPOND = 262632; - URLACTION_CLIENT_CERT_PROMPT = $00001A04; - URLACTION_COOKIES = $00001A02; - URLACTION_COOKIES_SESSION = $00001A03; - URLACTION_CROSS_DOMAIN_DATA = $00001406; - URLACTION_HTML_SUBFRAME_NAVIGATE = $00001607; - URLACTION_HTML_USERDATA_SAVE = $00001606; - URLACTION_SCRIPT_PASTE = $00001407; - URLASSOCDLG_FL_REGISTER_ASSOC = $0002; - URLASSOCDLG_FL_USE_DEFAULT_NAME = $0001; - urldll = 'url.dll'; - UrlMonLib = 'URLMON.DLL'; - URL_MK_LEGACY = 0; - URL_MK_UNIFORM = 1; - URL_MK_NO_CANONICALIZE = 2; - URLPOLICY_ACTIVEX_CHECK_LIST = $00010000; - URLTEMPLATE_MEDLOW = $10500; - USER_AGENT_IE6 = 'User-agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)'; - USER_AGENT_IE7 = 'User-agent: Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1)'; - USER_AGENT_PATH = '\Software\Microsoft\Windows\CurrentVersion\Internet Settings\User Agent\Post Platform'; - VER_GREATER_EQUAL = 3; - VER_MAJORVERSION = $0000002; - VER_MINORVERSION = $0000001; - VER_SERVICEPACKMAJOR = $0000020; - VER_SERVICEPACKMINOR = $0000010; - VIEW_COMMAND = 1; - WEB_SITE = 'Help & Support: http://www.bsalsa.com/'; - WM_USER = $0400; - WM_USER_STARTWALKING = WM_USER + 1; - WM_XBUTTONDBLCLK = $020D; - WM_XBUTTONDOWN = $020B; - WM_XBUTTONUP = $020C; - -const - MinsPerDay = HoursPerDay * MinsPerHour; - SecsPerDay = MinsPerDay * SecsPerMin; - MSecsPerDay = SecsPerDay * MSecsPerSec; - -const - INTERNET_CONNECTION_MODEM = 1; -{$EXTERNALSYM INTERNET_CONNECTION_MODEM} - INTERNET_CONNECTION_LAN = 2; -{$EXTERNALSYM INTERNET_CONNECTION_LAN} - INTERNET_CONNECTION_PROXY = 4; -{$EXTERNALSYM INTERNET_CONNECTION_PROXY} - INTERNET_CONNECTION_MODEM_BUSY = 8; -{$EXTERNALSYM INTERNET_CONNECTION_MODEM_BUSY} - INTERNET_RAS_INSTALLED = 16; -{$EXTERNALSYM INTERNET_RAS_INSTALLED} - INTERNET_CONNECTION_OFFLINE = 32; -{$EXTERNALSYM INTERNET_CONNECTION_OFFLINE} - INTERNET_CONNECTION_CONFIGURED = 64; -{$EXTERNALSYM INTERNET_CONNECTION_CONFIGURED} - -{$EXTERNALSYM MAX_SIZE_SECURITY_ID} - MAX_SIZE_SECURITY_ID = 512; -{$EXTERNALSYM PUAF_DEFAULT} - PUAF_DEFAULT = $00000000; -{$EXTERNALSYM PUAF_NOUI} - PUAF_NOUI = $00000001; -{$EXTERNALSYM PUAF_ISFILE} - PUAF_ISFILE = $00000002; -{$EXTERNALSYM PUAF_WARN_IF_DENIED} - PUAF_WARN_IF_DENIED = $00000004; -{$EXTERNALSYM PUAF_FORCEUI_FOREGROUND} - PUAF_FORCEUI_FOREGROUND = $00000008; -{$EXTERNALSYM PUAF_CHECK_TIFS} - PUAF_CHECK_TIFS = $00000010; -{$EXTERNALSYM SZM_CREATE} - SZM_CREATE = $00000000; -{$EXTERNALSYM SZM_DELETE} - SZM_DELETE = $00000001; -{$EXTERNALSYM URLACTION_MIN} - URLACTION_MIN = $00001000; -{$EXTERNALSYM URLACTION_DOWNLOAD_MIN} - URLACTION_DOWNLOAD_MIN = $00001000; -{$EXTERNALSYM URLACTION_DOWNLOAD_SIGNED_ACTIVEX} - URLACTION_DOWNLOAD_SIGNED_ACTIVEX = $00001001; -{$EXTERNALSYM URLACTION_DOWNLOAD_UNSIGNED_ACTIVEX} - URLACTION_DOWNLOAD_UNSIGNED_ACTIVEX = $00001004; -{$EXTERNALSYM URLACTION_DOWNLOAD_CURR_MAX} - URLACTION_DOWNLOAD_CURR_MAX = $00001004; -{$EXTERNALSYM URLACTION_DOWNLOAD_MAX} - URLACTION_DOWNLOAD_MAX = $000011FF; -{$EXTERNALSYM URLACTION_ACTIVEX_MIN} - URLACTION_ACTIVEX_MIN = $00001200; -{$EXTERNALSYM URLACTION_ACTIVEX_RUN} - URLACTION_ACTIVEX_RUN = $00001200; -{$EXTERNALSYM URLACTION_ACTIVEX_OVERRIDE_OBJECT_SAFETY} - URLACTION_ACTIVEX_OVERRIDE_OBJECT_SAFETY = $00001201; -{$EXTERNALSYM URLACTION_ACTIVEX_OVERRIDE_DATA_SAFETY} - URLACTION_ACTIVEX_OVERRIDE_DATA_SAFETY = $00001202; -{$EXTERNALSYM URLACTION_ACTIVEX_OVERRIDE_SCRIPT_SAFETY} - URLACTION_ACTIVEX_OVERRIDE_SCRIPT_SAFETY = $00001203; -{$EXTERNALSYM URLACTION_SCRIPT_OVERRIDE_SAFETY} - URLACTION_SCRIPT_OVERRIDE_SAFETY = $00001401; // -{$EXTERNALSYM URLACTION_ACTIVEX_CONFIRM_NOOBJECTSAFETY} - URLACTION_ACTIVEX_CONFIRM_NOOBJECTSAFETY = $00001204; -{$EXTERNALSYM URLACTION_ACTIVEX_TREATASUNTRUSTED} - URLACTION_ACTIVEX_TREATASUNTRUSTED = $00001205; -{$EXTERNALSYM URLACTION_ACTIVEX_CURR_MAX} - URLACTION_ACTIVEX_CURR_MAX = $00001205; -{$EXTERNALSYM URLACTION_ACTIVEX_MAX} - URLACTION_ACTIVEX_MAX = $000013FF; -{$EXTERNALSYM URLACTION_SCRIPT_MIN} - URLACTION_SCRIPT_MIN = $00001400; -{$EXTERNALSYM URLACTION_SCRIPT_RUN} - URLACTION_SCRIPT_RUN = $00001400; -{$EXTERNALSYM URLACTION_SCRIPT_JAVA_USE} - URLACTION_SCRIPT_JAVA_USE = $00001402; -{$EXTERNALSYM URLACTION_SCRIPT_SAFE_ACTIVEX} - URLACTION_SCRIPT_SAFE_ACTIVEX = $00001405; -{$EXTERNALSYM URLACTION_SCRIPT_CURR_MAX} - URLACTION_SCRIPT_CURR_MAX = $00001405; -{$EXTERNALSYM URLACTION_SCRIPT_MAX} - URLACTION_SCRIPT_MAX = $000015FF; -{$EXTERNALSYM URLACTION_HTML_MIN} - URLACTION_HTML_MIN = $00001600; -{$EXTERNALSYM URLACTION_HTML_SUBMIT_FORMS} - URLACTION_HTML_SUBMIT_FORMS = $00001601; // aggregate next two -{$EXTERNALSYM URLACTION_HTML_SUBMIT_FORMS_FROM} - URLACTION_HTML_SUBMIT_FORMS_FROM = $00001602; // -{$EXTERNALSYM URLACTION_HTML_SUBMIT_FORMS_TO} - URLACTION_HTML_SUBMIT_FORMS_TO = $00001603; // -{$EXTERNALSYM URLACTION_HTML_FONT_DOWNLOAD} - URLACTION_HTML_FONT_DOWNLOAD = $00001604; -{$EXTERNALSYM URLACTION_HTML_JAVA_RUN} - URLACTION_HTML_JAVA_RUN = $00001605; // derive from Java custom policy; -{$EXTERNALSYM URLACTION_HTML_CURR_MAX} - URLACTION_HTML_CURR_MAX = $00001605; -{$EXTERNALSYM URLACTION_HTML_MAX} - URLACTION_HTML_MAX = $000017FF; -{$EXTERNALSYM URLACTION_SHELL_MIN} - URLACTION_SHELL_MIN = $00001800; -{$EXTERNALSYM URLACTION_SHELL_INSTALL_DTITEMS} - URLACTION_SHELL_INSTALL_DTITEMS = $00001800; -{$EXTERNALSYM URLACTION_SHELL_MOVE_OR_COPY} - URLACTION_SHELL_MOVE_OR_COPY = $00001802; -{$EXTERNALSYM URLACTION_SHELL_FILE_DOWNLOAD} - URLACTION_SHELL_FILE_DOWNLOAD = $00001803; -{$EXTERNALSYM URLACTION_SHELL_VERB} - URLACTION_SHELL_VERB = $00001804; -{$EXTERNALSYM URLACTION_SHELL_WEBVIEW_VERB} - URLACTION_SHELL_WEBVIEW_VERB = $00001805; -{$EXTERNALSYM URLACTION_SHELL_CURR_MAX} - URLACTION_SHELL_CURR_MAX = $00001805; -{$EXTERNALSYM URLACTION_SHELL_MAX} - URLACTION_SHELL_MAX = $000019FF; -{$EXTERNALSYM URLACTION_NETWORK_MIN} - URLACTION_NETWORK_MIN = $00001A00; -{$EXTERNALSYM URLACTION_CREDENTIALS_USE} - URLACTION_CREDENTIALS_USE = $00001A00; -{$EXTERNALSYM URLPOLICY_CREDENTIALS_SILENT_LOGON_OK} - URLPOLICY_CREDENTIALS_SILENT_LOGON_OK = $00000000; -{$EXTERNALSYM URLPOLICY_CREDENTIALS_MUST_PROMPT_USER} - URLPOLICY_CREDENTIALS_MUST_PROMPT_USER = $00010000; -{$EXTERNALSYM URLPOLICY_CREDENTIALS_CONDITIONAL_PROMPT} - URLPOLICY_CREDENTIALS_CONDITIONAL_PROMPT = $00020000; -{$EXTERNALSYM URLPOLICY_CREDENTIALS_ANONYMOUS_ONLY} - URLPOLICY_CREDENTIALS_ANONYMOUS_ONLY = $00030000; -{$EXTERNALSYM URLACTION_AUTHENTICATE_CLIENT} - URLACTION_AUTHENTICATE_CLIENT = $00001A01; -{$EXTERNALSYM URLPOLICY_AUTHENTICATE_CLEARTEXT_OK} - URLPOLICY_AUTHENTICATE_CLEARTEXT_OK = $00000000; -{$EXTERNALSYM URLPOLICY_AUTHENTICATE_CHALLENGE_RESPONSE} - URLPOLICY_AUTHENTICATE_CHALLENGE_RESPONSE = $00010000; -{$EXTERNALSYM URLPOLICY_AUTHENTICATE_MUTUAL_ONLY} - URLPOLICY_AUTHENTICATE_MUTUAL_ONLY = $00030000; -{$EXTERNALSYM URLACTION_NETWORK_CURR_MAX} - URLACTION_NETWORK_CURR_MAX = $00001A01; -{$EXTERNALSYM URLACTION_NETWORK_MAX} - URLACTION_NETWORK_MAX = $00001BFF; -{$EXTERNALSYM URLACTION_JAVA_MIN} - URLACTION_JAVA_MIN = $00001C00; -{$EXTERNALSYM URLACTION_JAVA_PERMISSIONS} - URLACTION_JAVA_PERMISSIONS = $00001C00; -{$EXTERNALSYM URLPOLICY_JAVA_PROHIBIT} - URLPOLICY_JAVA_PROHIBIT = $00000000; -{$EXTERNALSYM URLPOLICY_JAVA_HIGH} - URLPOLICY_JAVA_HIGH = $00010000; -{$EXTERNALSYM URLPOLICY_JAVA_MEDIUM} - URLPOLICY_JAVA_MEDIUM = $00020000; -{$EXTERNALSYM URLPOLICY_JAVA_LOW} - URLPOLICY_JAVA_LOW = $00030000; -{$EXTERNALSYM URLPOLICY_JAVA_CUSTOM} - URLPOLICY_JAVA_CUSTOM = $00800000; -{$EXTERNALSYM URLACTION_JAVA_CURR_MAX} - URLACTION_JAVA_CURR_MAX = $00001C00; -{$EXTERNALSYM URLACTION_JAVA_MAX} - URLACTION_JAVA_MAX = $00001CFF; -{$EXTERNALSYM URLACTION_INFODELIVERY_MIN} - URLACTION_INFODELIVERY_MIN = $00001D00; -{$EXTERNALSYM URLACTION_INFODELIVERY_NO_ADDING_CHANNELS} - URLACTION_INFODELIVERY_NO_ADDING_CHANNELS = $00001D00; -{$EXTERNALSYM URLACTION_INFODELIVERY_NO_EDITING_CHANNELS} - URLACTION_INFODELIVERY_NO_EDITING_CHANNELS = $00001D01; -{$EXTERNALSYM URLACTION_INFODELIVERY_NO_REMOVING_CHANNELS} - URLACTION_INFODELIVERY_NO_REMOVING_CHANNELS = $00001D02; -{$EXTERNALSYM URLACTION_INFODELIVERY_NO_ADDING_SUBSCRIPTIONS} - URLACTION_INFODELIVERY_NO_ADDING_SUBSCRIPTIONS = $00001D03; -{$EXTERNALSYM URLACTION_INFODELIVERY_NO_EDITING_SUBSCRIPTIONS} - URLACTION_INFODELIVERY_NO_EDITING_SUBSCRIPTIONS = $00001D04; -{$EXTERNALSYM URLACTION_INFODELIVERY_NO_REMOVING_SUBSCRIPTIONS} - URLACTION_INFODELIVERY_NO_REMOVING_SUBSCRIPTIONS = $00001D05; -{$EXTERNALSYM URLACTION_INFODELIVERY_NO_CHANNEL_LOGGING} - URLACTION_INFODELIVERY_NO_CHANNEL_LOGGING = $00001D06; -{$EXTERNALSYM URLACTION_INFODELIVERY_CURR_MAX} - URLACTION_INFODELIVERY_CURR_MAX = $00001D06; -{$EXTERNALSYM URLACTION_INFODELIVERY_MAX} - URLACTION_INFODELIVERY_MAX = $00001DFF; -{$EXTERNALSYM URLACTION_CHANNEL_SOFTDIST_MIN} - URLACTION_CHANNEL_SOFTDIST_MIN = $00001E00; -{$EXTERNALSYM URLACTION_CHANNEL_SOFTDIST_PERMISSIONS} - URLACTION_CHANNEL_SOFTDIST_PERMISSIONS = $00001E05; -{$EXTERNALSYM URLPOLICY_CHANNEL_SOFTDIST_PROHIBIT} - URLPOLICY_CHANNEL_SOFTDIST_PROHIBIT = $00010000; -{$EXTERNALSYM URLPOLICY_CHANNEL_SOFTDIST_PRECACHE} - URLPOLICY_CHANNEL_SOFTDIST_PRECACHE = $00020000; -{$EXTERNALSYM URLPOLICY_CHANNEL_SOFTDIST_AUTOINSTALL} - URLPOLICY_CHANNEL_SOFTDIST_AUTOINSTALL = $00030000; -{$EXTERNALSYM URLACTION_CHANNEL_SOFTDIST_MAX} - URLACTION_CHANNEL_SOFTDIST_MAX = $00001EFF; -{$EXTERNALSYM URLPOLICY_ALLOW} - URLPOLICY_ALLOW = $00; -{$EXTERNALSYM URLPOLICY_QUERY} - URLPOLICY_QUERY = $01; -{$EXTERNALSYM URLPOLICY_DISALLOW} - URLPOLICY_DISALLOW = $03; -{$EXTERNALSYM URLPOLICY_NOTIFY_ON_ALLOW} - URLPOLICY_NOTIFY_ON_ALLOW = $10; -{$EXTERNALSYM URLPOLICY_NOTIFY_ON_DISALLOW} - URLPOLICY_NOTIFY_ON_DISALLOW = $20; -{$EXTERNALSYM URLPOLICY_LOG_ON_ALLOW} - URLPOLICY_LOG_ON_ALLOW = $40; -{$EXTERNALSYM URLPOLICY_LOG_ON_DISALLOW} - URLPOLICY_LOG_ON_DISALLOW = $80; -{$EXTERNALSYM URLPOLICY_MASK_PERMISSIONS} - URLPOLICY_MASK_PERMISSIONS = $0F; -{$EXTERNALSYM URLZONE_PREDEFINED_MIN} - URLZONE_PREDEFINED_MIN = 0; -{$EXTERNALSYM URLZONE_LOCAL_MACHINE} - URLZONE_LOCAL_MACHINE = 0; -{$EXTERNALSYM URLZONE_INTRANET} - URLZONE_INTRANET = URLZONE_LOCAL_MACHINE + 1; -{$EXTERNALSYM URLZONE_TRUSTED} - URLZONE_TRUSTED = URLZONE_INTRANET + 1; -{$EXTERNALSYM URLZONE_INTERNET} - URLZONE_INTERNET = URLZONE_TRUSTED + 1; -{$EXTERNALSYM URLZONE_UNTRUSTED} - URLZONE_UNTRUSTED = URLZONE_INTERNET + 1; -{$EXTERNALSYM URLZONE_PREDEFINED_MAX} - URLZONE_PREDEFINED_MAX = 999; -{$EXTERNALSYM URLZONE_USER_MIN} - URLZONE_USER_MIN = 1000; -{$EXTERNALSYM URLZONE_USER_MAX} - URLZONE_USER_MAX = 10000; -{$EXTERNALSYM URLTEMPLATE_CUSTOM} - URLTEMPLATE_CUSTOM = $00000000; -{$EXTERNALSYM URLTEMPLATE_PREDEFINED_MIN} - URLTEMPLATE_PREDEFINED_MIN = $00010000; -{$EXTERNALSYM URLTEMPLATE_LOW} - URLTEMPLATE_LOW = $00010000; -{$EXTERNALSYM URLTEMPLATE_MEDIUM} - URLTEMPLATE_MEDIUM = $00011000; -{$EXTERNALSYM URLTEMPLATE_HIGH} - URLTEMPLATE_HIGH = $00012000; -{$EXTERNALSYM URLTEMPLATE_PREDEFINED_MAX} - URLTEMPLATE_PREDEFINED_MAX = $00020000; -{$EXTERNALSYM MAX_ZONE_PATH} - MAX_ZONE_PATH = 260; -{$EXTERNALSYM MAX_ZONE_DESCRIPTION} - MAX_ZONE_DESCRIPTION = 200; -{$EXTERNALSYM ZAFLAGS_CUSTOM_EDIT} - ZAFLAGS_CUSTOM_EDIT = $00000001; -{$EXTERNALSYM ZAFLAGS_ADD_SITES} - ZAFLAGS_ADD_SITES = $00000002; -{$EXTERNALSYM ZAFLAGS_REQUIRE_VERIFICATION} - ZAFLAGS_REQUIRE_VERIFICATION = $00000004; -{$EXTERNALSYM ZAFLAGS_INCLUDE_PROXY_OVERRIDE} - ZAFLAGS_INCLUDE_PROXY_OVERRIDE = $00000008; -{$EXTERNALSYM ZAFLAGS_INCLUDE_INTRANET_SITES} - ZAFLAGS_INCLUDE_INTRANET_SITES = $00000010; -{$EXTERNALSYM ZAFLAGS_NO_UI} - ZAFLAGS_NO_UI = $00000020; -{$EXTERNALSYM ZAFLAGS_SUPPORTS_VERIFICATION} - ZAFLAGS_SUPPORTS_VERIFICATION = $00000040; -{$EXTERNALSYM ZAFLAGS_UNC_AS_INTRANET} - ZAFLAGS_UNC_AS_INTRANET = $00000080; -{$EXTERNALSYM URLZONEREG_DEFAULT} - URLZONEREG_DEFAULT = 0; -{$EXTERNALSYM URLZONEREG_HKLM} - URLZONEREG_HKLM = URLZONEREG_DEFAULT + 1; -{$EXTERNALSYM URLZONEREG_HKCU} - URLZONEREG_HKCU = URLZONEREG_HKLM + 1; - -const - IID_IWebBrowserEventsService: TGUID = '{87CC5D04-EAFA-4833-9820-8F986530CC00}'; - IID_ITravelLogEntry: TGUID = '{7EBFDD87-AD18-11d3-A4C5-00C04F72D6B8}'; - IID_IEnumTravelLogEntry: TGUID = '{7EBFDD85-AD18-11d3-A4C5-00C04F72D6B8}'; - IID_ITravelLogStg: TGUID = '{7EBFDD80-AD18-11d3-A4C5-00C04F72D6B8}'; - IID_IInputObjectSite: TGUID = (D1: $F1DB8392; D2: $7331; D3: $11D0; D4: ($8C, - $99, $00, $A0, $C9, $2D, $BF, $E8)); - IID_IQueryInfo: TGUID = (D1: $00021500; D2: $0000; D3: $0000; D4: ($C0, $00, - $00, $00, $00, $00, $00, $46)); - IID_IUniformResourceLocatorA: TGUID = (D1: $FBF23B80; D2: $E3F0; D3: $101B; - D4: ($84, $88, $00, $AA, $00, $3E, $56, $F8)); - IID_IUniformResourceLocatorW: TGUID = (D1: $CABB0DA0; D2: $DA57; D3: $11CF; - D4: ($99, $74, $00, $20, $AF, $D7, $97, $62)); - IID_IUrlHistoryNotify: TGUID = (D1: $BC40BEC1; D2: $C493; D3: $11D0; D4: ($83, - $1B, $00, $C0, $4F, $D5, $AE, $38)); - IID_IUrlHistoryStg: TGUID = (D1: $3C374A41; D2: $BAE4; D3: $11CF; D4: ($BF, - $7D, $00, $AA, $00, $69, $46, $EE)); - IID_IUrlHistoryStg2: TGUID = (D1: $AFA0DC11; D2: $C313; D3: $831A; D4: ($83, - $1A, $00, $C0, $4F, $D5, $AE, $38)); - SID_IHTMLOMWindowServices = '{3050F5FC-98B5-11CF-BB82-00AA00BDCE0B}'; - CLSID_InternetShortCut: TGUID = (d1: $FBF23B40; D2: $E3F0; D3: $101B; D4: - ($84, $88, $00, $AA, $00, $3E, $56, $F8)); - CGID_DocHostCommandHandler: TGUID = (D1: $F38BC242; D2: $B950; D3: $11D1; D4: - ($89, $18, $00, $C0, $4F, $C2, $C8, $36)); - CLSID_CUrlHistory: TGUID = '{3C374A40-BAE4-11CF-BF7D-00AA006946EE}'; - CLSID_ShellUIHelper: TGUID = '{64AB4BB7-111E-11D1-8F79-00C04FC2FBE1}'; - CLSID_WebBrowser: TGUID = '{ED016940-BD5B-11cf-BA4E-00C04FD70816}'; - CGID_MSHTML: TGUID = '{DE4BA900-59CA-11CF-9592-444553540000}'; - IID_IoleCommandTarget: TGUID = '{B722BCCB-4E68-101B-A2BC-00AA00404770}'; - GUID_TriEditCommandGroup: TGUID = '{2582F1C0-084E-11d1-9A0E-006097C9B344}'; - IID_IACList: TGUID = '{77A130B0-94FD-11D0-A544-00C04FD7d062}'; - IID_IACList2: TGUID = '{470141a0-5186-11d2-bbb6-0060977b464c}'; - IID_ICustomDoc: TGUID = '{3050f3f0-98b5-11cf-bb82-00aa00bdce0b}'; - IID_IDocHostShowUI: TGUID = '{c4d244b0-d43e-11cf-893b-00aa00bdce1a}'; - IID_IDocHostUIHandler: TGUID = '{bd3f23c0-d43e-11cf-893b-00aa00bdce1a}'; - IID_IDocHostUIHandler2: TGUID = '{3050f6d0-98b5-11cf-bb82-00aa00bdce0b}'; - IID_IDownloadManager: TGUID = (D1: $988934A4; D2: $064B; D3: $11D3; D4: ($BB, - $80, $0, $10, $4B, $35, $E7, $F9)); - IID_IEnumStatUrl: TGUID = (D1: $3C374A42; D2: $BAE4; D3: $11CF; D4: ($BF, $7D, - $00, $AA, $00, $69, $46, $EE)); - IID_IHTMLOMWindowServices: TGUID = '{3050F5FC-98B5-11CF-BB82-00AA00BDCE0B}'; - IID_IHlinkFrame: TGUID = '{79eac9c5-baf9-11ce-8c82-00aa004ba90b}'; - IID_INewWindowManager: TGUID = '{D2BC4C84-3F72-4a52-A604-7BCBF3982CBB}'; - IID_IProtectFocus: TGUID = '{D81F90A3-8156-44F7-AD28-5ABB87003274}'; - SID_STravelLogCursor: TGUID = '{7EBFDD80-AD18-11d3-A4C5-00C04F72D6B8}'; - SID_IEnumStatUrl = '{3C374A42-BAE4-11CF-BF7D-00AA006946EE}'; - SID_IURLHistoryNotify = '{BC40BEC1-C493-11d0-831B-00C04FD5AE38}'; - SID_IUrlHistoryStg = '{3C374A41-BAE4-11CF-BF7D-00AA006946EE}'; - SID_IUrlHistoryStg2 = '{AFA0DC11-C313-11d0-831A-00C04FD5AE38}'; - SID_SDownloadManager = '{988934A4-064B-11D3-BB80-00104B35E7F9}'; - SID_IUniformResourceLocatorA = '{FBF23B80-E3F0-101B-8488-00AA003E56F8}'; - SID_IUniformResourceLocatorW = '{CABB0DA0-DA57-11CF-9974-0020AFD79762}'; -{$IFDEF UNICODE} - SID_IUniformResourceLocator = SID_IUniformResourceLocatorW; -{$ELSE} - SID_IUniformResourceLocator = SID_IUniformResourceLocatorA; -{$ENDIF} - IID_IUniformResourceLocator: TGUID = SID_IUniformResourceLocator; - -implementation - -end. diff --git a/Source/LibXmlComps.pas b/Source/LibXmlComps.pas deleted file mode 100644 index 5f19841..0000000 --- a/Source/LibXmlComps.pas +++ /dev/null @@ -1,110 +0,0 @@ -(** -=============================================================================================== -Name : LibXmlComps -=============================================================================================== -Project : All Projects processing XML documents -=============================================================================================== -Subject : XML parser for Delphi's VCL toolbar -=============================================================================================== -Dipl.-Ing. (FH) Stefan Heymann, Softwaresysteme, Tbingen, Germany -=============================================================================================== -Date Author Changes ------------------------------------------------------------------------------------------------ -$Id: LibXmlComps.pas,v 1.2 2006/11/15 21:01:42 sergev Exp $ -2000-03-31 HeySt 1.0.0 Start -2000-07-27 HeySt 1.0.1 Added "TAttr" declaration - Moved GetNormalize/SetNormalize to PROTECTED section -2001-02-03 HeySt Changed prototype for the TExternalEvent callback function type - so that C++Builder users should get it compiled better. - -2001-02-28 HeySt 1.0.2 Introduced the "StopParser" property. When you set this property to - TRUE in one of the Parser Events, parsing is stopped and the Execute - method returns. - Introduced Version numbers -2001-07-10 HeySt 1.0.3 Fixed a bug in TScannerXmlParser.DtdElementFound so that the - OnAttList event is correctly fired -2001-07-11 HeySt 1.1.0 Derived from the new TCustomXmlScanner class from LibXmlParser -*) - -unit LibXmlComps; - -interface - -uses - Classes, - LibXmlParser; - -type - TXmlScanner = class(TCustomXmlScanner) - public - property XmlParser; - property StopParser; - published - property Filename; - property Normalize; - property OnXmlProlog; - property OnComment; - property OnPI; - property OnDtdRead; - property OnStartTag; - property OnEmptyTag; - property OnEndTag; - property OnContent; - property OnCData; - property OnElement; - property OnAttList; - property OnEntity; - property OnNotation; - property OnDtdError; - property OnLoadExternal; - property OnTranslateEncoding; - end; - - // The "Easy" XML Scanner leaves out events and properties which you are unlikely to use - // for "normal" XML files. - // CDATA sections trigger "OnContent" events - TEasyXmlScanner = class(TCustomXmlScanner) - protected - procedure WhenCData(Content: string); override; - public - property XmlParser; - property StopParser; - published - property Filename; - property Normalize; - property OnComment; - property OnPI; - property OnStartTag; - property OnEmptyTag; - property OnEndTag; - property OnContent; - property OnLoadExternal; - property OnTranslateEncoding; - end; - -(* -=============================================================================================== -IMPLEMENTATION -=============================================================================================== -*) - -implementation - -(* -=============================================================================================== -TEasyXmlScanner -=============================================================================================== -*) - -procedure TEasyXmlScanner.WhenCData(Content: string); -begin - inherited WhenContent(Content); -end; - -(* -=============================================================================================== -INITIALIZATION -=============================================================================================== -*) - -end. diff --git a/Source/LibXmlParser.pas b/Source/LibXmlParser.pas deleted file mode 100644 index 27c0b8e..0000000 --- a/Source/LibXmlParser.pas +++ /dev/null @@ -1,2961 +0,0 @@ -(** -=============================================================================================== -Name : LibXmlParser -=============================================================================================== -Project : All Projects -=============================================================================================== -Subject : Progressive XML Parser for all types of XML Files -=============================================================================================== -Author : Stefan Heymann - Eschenweg 3 - 72076 Tbingen - GERMANY - -E-Mail: stefan@destructor.de -URL: www.destructor.de -=============================================================================================== -Source, Legals ("Licence") --------------------------- -The official site to get this parser is http://www.destructor.de/ - -Usage and Distribution of this Source Code is ruled by the -"Destructor.de Source code Licence" (DSL) which comes with this file or -can be downloaded at http://www.destructor.de/ - -IN SHORT: Usage and distribution of this source code is free. - You use it completely on your own risk. - -Postcardware ------------- -If you like this code, please send a postcard of your city to my above address. -=============================================================================================== -!!! All parts of this code which are not finished or not conforming exactly to - the XmlSpec are marked with three exclamation marks - --!- Parts where the parser may be able to detect errors in the document's syntax are - marked with the dash-exlamation mark-dash sequence. -=============================================================================================== -Terminology: ------------- -- Start: Start of a buffer part -- Final: End (last character) of a buffer part -- DTD: Document Type Definition -- DTDc: Document Type Declaration -- XMLSpec: The current W3C XML Recommendation (version 1.0 as of 1998-02-10), Chapter No. -- Cur*: Fields concerning the "Current" part passed back by the "Scan" method -=============================================================================================== -Scanning the XML document -------------------------- -- Create TXmlParser Instance MyXml := TXmlParser.Create; -- Load XML Document MyXml.LoadFromFile (Filename); -- Start Scanning MyXml.StartScan; -- Scan Loop WHILE MyXml.Scan DO -- Test for Part Type CASE MyXml.CurPartType OF -- Handle Parts ... : ;;; -- Handle Parts ... : ;;; -- Handle Parts ... : ;;; - END; -- Destroy MyXml.Free; -=============================================================================================== -Loading the XML document ------------------------- -You can load the XML document from a file with the "LoadFromFile" method. -It is beyond the scope of this parser to perform HTTP or FTP accesses. If you want your -application to handle such requests (URLs), you can load the XML via HTTP or FTP or whatever -protocol and hand over the data buffer using the "LoadFromBuffer" or "SetBuffer" method. -"LoadFromBuffer" loads the internal buffer of TXmlParser with the given null-terminated -string, thereby creating a copy of that buffer. -"SetBuffer" just takes the pointer to another buffer, which means that the given -buffer pointer must be valid while the document is accessed via TXmlParser. -=============================================================================================== -Encodings: ----------- -This XML parser kind of "understands" the following encodings: -- UTF-8 -- ISO-8859-1 -- Windows-1252 - -Any flavor of multi-byte characters (and this includes UTF-16) is not supported. Sorry. - -Every string which has to be passed to the application passes the virtual method -"TranslateEncoding" which translates the string from the current encoding (stored in -"CurEncoding") into the encoding the application wishes to receive. -The "TranslateEncoding" method that is built into TXmlParser assumes that the application -wants to receive Windows ANSI (Windows-1252, about the same as ISO-8859-1) and is able -to convert UTF-8 and ISO-8859-1 encodings. -For other source and target encodings, you will have to override "TranslateEncoding". -=============================================================================================== -Buffer Handling ---------------- -- The document must be loaded completely into a piece of RAM -- All character positions are referenced by PAnsiChar pointers -- The TXmlParser instance can either "own" the buffer itself (then, FBufferSize is > 0) - or reference the buffer of another instance or object (then, FBuffersize is 0 and - FBuffer is not NIL) -- The Property DocBuffer passes back a pointer to the first byte of the document. If there - is no document stored (FBuffer is NIL), the DocBuffer returns a pointer to a NULL character. -=============================================================================================== -Whitespace Handling -------------------- -The TXmlParser property "PackSpaces" determines how Whitespace is returned in Text Content: -While PackSpaces is true, all leading and trailing whitespace characters are trimmed of, all -Whitespace is converted to Space #x20 characters and contiguous Whitespace characters are -compressed to one. -If the "Scan" method reports a ptContent part, the application can get the original text -with all whitespace characters by extracting the characters from "CurStart" to "CurFinal". -If the application detects an xml:space attribute, it can set "PackSpaces" accordingly or -use CurStart/CurFinal. -Please note that TXmlParser does _not_ normalize Line Breaks to single LineFeed characters -as the XmlSpec requires (XmlSpec 2.11). -The xml:space attribute is not handled by TXmlParser. This is on behalf of the application. -=============================================================================================== -Non-XML-Conforming ------------------- -TXmlParser does not conform 100 % exactly to the XmlSpec: -- UTF-16 is not supported (XmlSpec 2.2) - (Workaround: Convert UTF-16 to UTF-8 and hand the buffer over to TXmlParser) -- As the parser only works with single byte strings, all Unicode characters > 255 - can currently not be handled correctly. -- Line breaks are not normalized to single Linefeed #x0A characters (XmlSpec 2.11) - (Workaround: The Application can access the text contents on its own [CurStart, CurFinal], - thereby applying every normalization it wishes to) -- The attribute value normalization does not work exactly as defined in the - Second Edition of the XML 1.0 specification. -- See also the code parts marked with three consecutive exclamation marks. These are - parts which are not finished in the current code release. - -This list may be incomplete, so it may grow if I get to know any other points. -As work on the parser proceeds, this list may also shrink. -=============================================================================================== -Things Todo ------------ -- Introduce a new event/callback which is called when there is an unresolvable - entity or character reference -- Support Unicode -- Use Streams instead of reading the whole XML into memory -=============================================================================================== -Change History, Version numbers -------------------------------- -The Date is given in ISO Year-Month-Day (YYYY-MM-DD) order. -Versions are counted from 1.0.0 beginning with the version from 2000-03-16. -Unreleased versions don't get a version number. - -Date Author Version Changes ------------------------------------------------------------------------------------------------ -2000-03-16 HeySt 1.0.0 Start -2000-03-28 HeySt 1.0.1 Initial Publishing of TXmlParser on the destructor.de Web Site -2000-03-30 HeySt 1.0.2 TXmlParser.AnalyzeCData: Call "TranslateEncoding" for CurContent -2000-03-31 HeySt 1.0.3 Deleted the StrPosE function (was not needed anyway) -2000-04-04 HeySt 1.0.4 TDtdElementRec modified: Start/Final for all Elements; - Should be backwards compatible. - AnalyzeDtdc: Set CurPartType to ptDtdc -2000-04-23 HeySt 1.0.5 New class TObjectList. Eliminated reference to the Delphi 5 - "Contnrs" unit so LibXmlParser is Delphi 4 compatible. -2000-07-03 HeySt 1.0.6 TNvpNode: Added Constructor -2000-07-11 HeySt 1.0.7 Removed "Windows" from USES clause - Added three-exclamation-mark comments for Utf8ToAnsi/AnsiToUtf8 - Added three-exclamation-mark comments for CHR function calls -2000-07-23 HeySt 1.0.8 TXmlParser.Clear: CurAttr.Clear; EntityStack.Clear; - (This was not a bug; just defensive programming) -2000-07-29 HeySt 1.0.9 TNvpList: Added methods: Node(Index), Value(Index), Name(Index); -2000-10-07 HeySt Introduced Conditional Defines - Uses Contnrs unit and its TObjectList class again for - Delphi 5 and newer versions -2001-01-30 HeySt Introduced Version Numbering - Made LoadFromFile and LoadFromBuffer BOOLEAN functions - Introduced FileMode parameter for LoadFromFile - BugFix: TAttrList.Analyze: Must add CWhitespace to ExtractName call - Comments worked over -2001-02-28 HeySt 1.0.10 Completely worked over and tested the UTF-8 functions - Fixed a bug in TXmlParser.Scan which caused it to start over when it - was called after the end of scanning, resulting in an endless loop - TEntityStack is now a TObjectList instead of TList -2001-07-03 HeySt 1.0.11 Updated Compiler Version IFDEFs for Kylix -2001-07-11 HeySt 1.0.12 New TCustomXmlScanner component (taken over from LibXmlComps.pas) -2001-07-14 HeySt 1.0.13 Bugfix TCustomXmlScanner.FOnTranslateEncoding -2001-10-22 HeySt Don't clear CurName anymore when the parser finds a CDATA section. -2001-12-03 HeySt 1.0.14 TObjectList.Clear: Make call to INHERITED method (fixes a memory leak) -2001-12-05 HeySt 1.0.15 TObjectList.Clear: removed call to INHERITED method - TObjectList.Destroy: Inserted SetCapacity call. - Reduces need for frequent re-allocation of pointer buffer - Dedicated to my father, Theodor Heymann -2002-06-26 HeySt 1.0.16 TXmlParser.Scan: Fixed a bug with PIs whose name is beginning - with 'xml'. Thanks to Uwe Kamm for submitting this bug. - The CurEncoding property is now always in uppercase letters (the XML - spec wants it to be treated case independently so when it's uppercase - comparisons are faster) -2002-03-04 HeySt 1.0.17 Included an IFDEF for Delphi 7 (VER150) and Kylix - There is a new symbol HAS_CONTNRS_UNIT which is used now to - distinguish between IDEs which come with the Contnrs unit and - those that don't. -2009-05-17 bsalsa 1.0.18 Added D2009 support. - -*) - -// --- Delphi/Kylix Version Numbers -// As this is no code, this does not blow up your object or executable code at all - (*$IFDEF LINUX *) - (*$DEFINE K1_OR_NEWER *) - (*$ENDIF *) - - (*$IFDEF MSWINDOWS *) - (*$DEFINE D1_OR_NEWER *) - (*$IFNDEF VER80 *) - (*$DEFINE D2_OR_NEWER *) - (*$IFNDEF VER90 *) - (*$DEFINE D3_OR_NEWER *) - (*$IFNDEF VER100 *) - (*$DEFINE D4_OR_NEWER *) - (*$IFNDEF VER120 *) - (*$DEFINE D5_OR_NEWER *) - (*$IFNDEF VER130 *) - (*$IFNDEF VER140 *) - (*$IFNDEF VER150 *) - { If the compiler gets stuck here, - you are using a compiler version unknown to this code. - You will probably have to change this code accordingly. - At first, try to comment out these lines and see what will happen.} - (*$ENDIF *) - (*$ENDIF *) - (*$ENDIF *) - (*$ENDIF *) - (*$ENDIF *) - (*$ENDIF *) - (*$ENDIF *) - (*$ENDIF *) - - (*$IFDEF D5_OR_NEWER *) - (*$DEFINE HAS_CONTNRS_UNIT *) - (*$ENDIF *) - - (*$IFDEF K1_OR_NEWER *) - (*$DEFINE HAS_CONTNRS_UNIT *) - (*$ENDIF *) - -unit LibXmlParser; - -{$I EWB.inc} - -interface - -uses - SysUtils, Classes, - (*$IFDEF HAS_CONTNRS_UNIT *)// The Contnrs Unit was introduced in Delphi 5 - Contnrs, - (*$ENDIF*) - Math; - -const - CVersion = '1.0.18'; // This variable will be updated for every release - // (I hope, I won't forget to do it everytime ...) - -type - TPartType = // --- Document Part Types - (ptNone, // Nothing - ptXmlProlog, // XML Prolog XmlSpec 2.8 / 4.3.1 - ptComment, // Comment XmlSpec 2.5 - ptPI, // Processing Instruction XmlSpec 2.6 - ptDtdc, // Document Type Declaration XmlSpec 2.8 - ptStartTag, // Start Tag XmlSpec 3.1 - ptEmptyTag, // Empty-Element Tag XmlSpec 3.1 - ptEndTag, // End Tag XmlSpec 3.1 - ptContent, // Text Content between Tags - ptCData); // CDATA Section XmlSpec 2.7 - - TDtdElemType = // --- DTD Elements - (deElement, // !ELEMENT declaration - deAttList, // !ATTLIST declaration - deEntity, // !ENTITY declaration - deNotation, // !NOTATION declaration - dePI, // PI in DTD - deComment, // Comment in DTD - deError); // Error found in the DTD - -type - TAttrList = class; - TEntityStack = class; - TNvpList = class; - TElemDef = class; - TElemList = class; - TEntityDef = class; - TNotationDef = class; - - TDtdElementRec = record // --- This Record is returned by the DTD parser callback function - Start, Final: PAnsiChar; // Start/End of the Element's Declaration - case ElementType: TDtdElemType of // Type of the Element - deElement, // - deAttList: (ElemDef: TElemDef); // - deEntity: (EntityDef: TEntityDef); // - deNotation: (NotationDef: TNotationDef); // - dePI: (Target: PAnsiChar; // - Content: PAnsiChar; - AttrList: TAttrList); - deError: (Pos: PAnsiChar); // Error - // deComment : ((No additional fields here)); // - end; - - TXmlParser = class // --- Internal Properties and Methods - protected - FBuffer: PAnsiChar; // NIL if there is no buffer available - FBufferSize: INTEGER; // 0 if the buffer is not owned by the Document instance - FSource: string; // Name of Source of document. Filename for Documents loaded with LoadFromFile - - FXmlVersion: string; // XML version from Document header. Default is '1.0' - FEncoding: string; // Encoding from Document header. Default is 'UTF-8' - FStandalone: BOOLEAN; // Standalone declaration from Document header. Default is 'yes' - FRootName: string; // Name of the Root Element (= DTD name) - FDtdcFinal: PAnsiChar; // Pointer to the '>' character terminating the DTD declaration - - FNormalize: BOOLEAN; // If true: Pack Whitespace and don't return empty contents - EntityStack: TEntityStack; // Entity Stack for Parameter and General Entities - FCurEncoding: string; // Current Encoding during parsing (always uppercase) - - procedure AnalyzeProlog; // Analyze XML Prolog or Text Declaration - procedure AnalyzeComment(Start: PAnsiChar; var Final: PAnsiChar); // Analyze Comments - procedure AnalyzePI(Start: PAnsiChar; var Final: PAnsiChar); // Analyze Processing Instructions (PI) - procedure AnalyzeDtdc; // Analyze Document Type Declaration - procedure AnalyzeDtdElements(Start: PAnsiChar; var Final: PAnsiChar); // Analyze DTD declarations - procedure AnalyzeTag; // Analyze Start/End/Empty-Element Tags - procedure AnalyzeCData; // Analyze CDATA Sections - procedure AnalyzeText(var IsDone: BOOLEAN); // Analyze Text Content between Tags - procedure AnalyzeElementDecl(Start: PAnsiChar; var Final: PAnsiChar); - procedure AnalyzeAttListDecl(Start: PAnsiChar; var Final: PAnsiChar); - procedure AnalyzeEntityDecl(Start: PAnsiChar; var Final: PAnsiChar); - procedure AnalyzeNotationDecl(Start: PAnsiChar; var Final: PAnsiChar); - - procedure PushPE(var Start: PAnsiChar); - procedure ReplaceCharacterEntities(var Str: string); - procedure ReplaceParameterEntities(var Str: string); - procedure ReplaceGeneralEntities(var Str: string); - - function GetDocBuffer: PAnsiChar; // Returns FBuffer or a pointer to a NUL char if Buffer is empty - - public // --- Document Properties - property XmlVersion: string read FXmlVersion; // XML version from the Document Prolog - property Encoding: string read FEncoding; // Document Encoding from Prolog - property Standalone: BOOLEAN read FStandalone; // Standalone Declaration from Prolog - property RootName: string read FRootName; // Name of the Root Element - property Normalize: BOOLEAN read FNormalize write FNormalize; // True if Content is to be normalized - property Source: string read FSource; // Name of Document Source (Filename) - property DocBuffer: PAnsiChar read GetDocBuffer; // Returns document buffer - public // --- DTD Objects - Elements: TElemList; // Elements: List of TElemDef (contains Attribute Definitions) - Entities: TNvpList; // General Entities: List of TEntityDef - ParEntities: TNvpList; // Parameter Entities: List of TEntityDef - Notations: TNvpList; // Notations: List of TNotationDef - public - constructor Create; - destructor Destroy; override; - - // --- Document Handling - function LoadFromFile(Filename: string; - FileMode: INTEGER = fmOpenRead or fmShareDenyNone): BOOLEAN; - // Loads Document from given file - function LoadFromBuffer(Buffer: PAnsiChar): BOOLEAN; // Loads Document from another buffer - procedure SetBuffer(Buffer: PAnsiChar); // References another buffer - procedure Clear; // Clear Document - - public - // --- Scanning through the document - CurPartType: TPartType; // Current Type - CurName: string; // Current Name - CurContent: string; // Current Normalized Content - CurStart: PAnsiChar; // Current First character - CurFinal: PAnsiChar; // Current Last character - CurAttr: TAttrList; // Current Attribute List - property CurEncoding: string read FCurEncoding; // Current Encoding - procedure StartScan; - function Scan: BOOLEAN; - - // --- Events / Callbacks - function LoadExternalEntity(SystemId, PublicId, - Notation: string): TXmlParser; virtual; - function TranslateEncoding(const Source: string): string; virtual; - procedure DtdElementFound(DtdElementRec: TDtdElementRec); virtual; - end; - - TValueType = // --- Attribute Value Type - (vtNormal, // Normal specified Attribute - vtImplied, // #IMPLIED attribute value - vtFixed, // #FIXED attribute value - vtDefault); // Attribute value from default value in !ATTLIST declaration - - TAttrDefault = // --- Attribute Default Type - (adDefault, // Normal default value - adRequired, // #REQUIRED attribute - adImplied, // #IMPLIED attribute - adFixed); // #FIXED attribute - - TAttrType = // --- Type of attribute - (atUnknown, // Unknown type - atCData, // Character data only - atID, // ID - atIdRef, // ID Reference - atIdRefs, // Several ID References, separated by Whitespace - atEntity, // Name of an unparsed Entity - atEntities, // Several unparsed Entity names, separated by Whitespace - atNmToken, // Name Token - atNmTokens, // Several Name Tokens, separated by Whitespace - atNotation, // A selection of Notation names (Unparsed Entity) - atEnumeration); // Enumeration - - TElemType = // --- Element content type - (etEmpty, // Element is always empty - etAny, // Element can have any mixture of PCDATA and any elements - etChildren, // Element must contain only elements - etMixed); // Mixed PCDATA and elements - - (*$IFDEF HAS_CONTNRS_UNIT *) - TObjectList = Contnrs.TObjectList; // Re-Export this identifier - (*$ELSE *) - TObjectList = class(TList) - destructor Destroy; override; - procedure Delete(Index: INTEGER); - procedure Clear; override; - end; - (*$ENDIF *) - - TNvpNode = class // Name-Value Pair Node - Name: string; - Value: string; - constructor Create(TheName: string = ''; TheValue: string = ''); - end; - - TNvpList = class(TObjectList) // Name-Value Pair List - procedure Add(Node: TNvpNode); - function Node(Name: string): TNvpNode; overload; - function Node(Index: INTEGER): TNvpNode; overload; - function Value(Name: string): string; overload; - function Value(Index: INTEGER): string; overload; - function Name(Index: INTEGER): string; - end; - - TAttr = class(TNvpNode) // Attribute of a Start-Tag or Empty-Element-Tag - ValueType: TValueType; - AttrType: TAttrType; - end; - - TAttrList = class(TNvpList) // List of Attributes - procedure Analyze(Start: PAnsiChar; var Final: PAnsiChar); - end; - - TEntityStack = class(TObjectList) // Stack where current position is stored before parsing entities - protected - Owner: TXmlParser; - public - constructor Create(TheOwner: TXmlParser); - procedure Push(LastPos: PAnsiChar); overload; - procedure Push(Instance: TObject; LastPos: PAnsiChar); overload; - function Pop: PAnsiChar; // Returns next char or NIL if EOF is reached. Frees Instance. - end; - - TAttrDef = class(TNvpNode) // Represents a '; - - // --- Name Constants for the above enumeration types - CPartType_Name: array[TPartType] of string = - ('', 'XML Prolog', 'Comment', 'PI', - 'DTD Declaration', 'Start Tag', 'Empty Tag', 'End Tag', - 'Text', 'CDATA'); - CValueType_Name: array[TValueType] of string = ('Normal', 'Implied', 'Fixed', 'Default'); - CAttrDefault_Name: array[TAttrDefault] of string = ('Default', 'Required', 'Implied', 'Fixed'); - CElemType_Name: array[TElemType] of string = ('Empty', 'Any', 'Childs only', 'Mixed'); - CAttrType_Name: array[TAttrType] of string = ('Unknown', 'CDATA', - 'ID', 'IDREF', 'IDREFS', - 'ENTITY', 'ENTITIES', - 'NMTOKEN', 'NMTOKENS', - 'Notation', 'Enumeration'); - -function ConvertWs(Source: string; PackWs: BOOLEAN): string; // Convert WS to spaces #x20 -procedure SetStringSF(var S: string; BufferStart, BufferFinal: PAnsiChar); // SetString by Start/Final of buffer -function StrSFPas(Start, Finish: PAnsiChar): string; // Convert buffer part to Pascal string -function TrimWs(Source: string): string; // Trim Whitespace - -function AnsiToUtf8(Source: ANSISTRING): string; // Convert Win-1252 to UTF-8 -function Utf8ToAnsi(Source: string; UnknownChar: AnsiChar = ''): ANSISTRING; // Convert UTF-8 to Win-1252 - -(* -=============================================================================================== -TCustomXmlScanner event based component wrapper for TXmlParser -=============================================================================================== -*) - -type - TCustomXmlScanner = class; - TXmlPrologEvent = procedure(Sender: TObject; XmlVersion, Encoding: string; Standalone: BOOLEAN) of object; - TCommentEvent = procedure(Sender: TObject; Comment: string) of object; - TPIEvent = procedure(Sender: TObject; Target, Content: string; Attributes: TAttrList) of object; - TDtdEvent = procedure(Sender: TObject; RootElementName: string) of object; - TStartTagEvent = procedure(Sender: TObject; TagName: string; Attributes: TAttrList) of object; - TEndTagEvent = procedure(Sender: TObject; TagName: string) of object; - TContentEvent = procedure(Sender: TObject; Content: string) of object; - TElementEvent = procedure(Sender: TObject; ElemDef: TElemDef) of object; - TEntityEvent = procedure(Sender: TObject; EntityDef: TEntityDef) of object; - TNotationEvent = procedure(Sender: TObject; NotationDef: TNotationDef) of object; - TErrorEvent = procedure(Sender: TObject; ErrorPos: PAnsiChar) of object; - TExternalEvent = procedure(Sender: TObject; SystemId, PublicId, NotationId: string; - var Result: TXmlParser) of object; - TEncodingEvent = function(Sender: TObject; CurrentEncoding, Source: string): string of object; - - TCustomXmlScanner = class(TComponent) - protected - FXmlParser: TXmlParser; - FOnXmlProlog: TXmlPrologEvent; - FOnComment: TCommentEvent; - FOnPI: TPIEvent; - FOnDtdRead: TDtdEvent; - FOnStartTag: TStartTagEvent; - FOnEmptyTag: TStartTagEvent; - FOnEndTag: TEndTagEvent; - FOnContent: TContentEvent; - FOnCData: TContentEvent; - FOnElement: TElementEvent; - FOnAttList: TElementEvent; - FOnEntity: TEntityEvent; - FOnNotation: TNotationEvent; - FOnDtdError: TErrorEvent; - FOnLoadExternal: TExternalEvent; - FOnTranslateEncoding: TEncodingEvent; - FStopParser: BOOLEAN; - function GetNormalize: BOOLEAN; - procedure SetNormalize(Value: BOOLEAN); - - procedure WhenXmlProlog(XmlVersion, Encoding: string; Standalone: BOOLEAN); virtual; - procedure WhenComment(Comment: string); virtual; - procedure WhenPI(Target, Content: string; Attributes: TAttrList); virtual; - procedure WhenDtdRead(RootElementName: string); virtual; - procedure WhenStartTag(TagName: string; Attributes: TAttrList); virtual; - procedure WhenEmptyTag(TagName: string; Attributes: TAttrList); virtual; - procedure WhenEndTag(TagName: string); virtual; - procedure WhenContent(Content: string); virtual; - procedure WhenCData(Content: string); virtual; - procedure WhenElement(ElemDef: TElemDef); virtual; - procedure WhenAttList(ElemDef: TElemDef); virtual; - procedure WhenEntity(EntityDef: TEntityDef); virtual; - procedure WhenNotation(NotationDef: TNotationDef); virtual; - procedure WhenDtdError(ErrorPos: PAnsiChar); virtual; - - public - constructor Create(AOwner: TComponent); override; - destructor Destroy; override; - - procedure LoadFromFile(Filename: TFilename); // Load XML Document from file - procedure LoadFromBuffer(Buffer: PAnsiChar); // Load XML Document from buffer - procedure SetBuffer(Buffer: PAnsiChar); // Refer to Buffer - function GetFilename: TFilename; - - procedure Execute; // Perform scanning - - protected - property XmlParser: TXmlParser read FXmlParser; - property StopParser: BOOLEAN read FStopParser write FStopParser; - property Filename: TFilename read GetFilename write LoadFromFile; - property Normalize: BOOLEAN read GetNormalize write SetNormalize; - property OnXmlProlog: TXmlPrologEvent read FOnXmlProlog write FOnXmlProlog; - property OnComment: TCommentEvent read FOnComment write FOnComment; - property OnPI: TPIEvent read FOnPI write FOnPI; - property OnDtdRead: TDtdEvent read FOnDtdRead write FOnDtdRead; - property OnStartTag: TStartTagEvent read FOnStartTag write FOnStartTag; - property OnEmptyTag: TStartTagEvent read FOnEmptyTag write FOnEmptyTag; - property OnEndTag: TEndTagEvent read FOnEndTag write FOnEndTag; - property OnContent: TContentEvent read FOnContent write FOnContent; - property OnCData: TContentEvent read FOnCData write FOnCData; - property OnElement: TElementEvent read FOnElement write FOnElement; - property OnAttList: TElementEvent read FOnAttList write FOnAttList; - property OnEntity: TEntityEvent read FOnEntity write FOnEntity; - property OnNotation: TNotationEvent read FOnNotation write FOnNotation; - property OnDtdError: TErrorEvent read FOnDtdError write FOnDtdError; - property OnLoadExternal: TExternalEvent read FOnLoadExternal write FOnLoadExternal; - property OnTranslateEncoding: TEncodingEvent read FOnTranslateEncoding write FOnTranslateEncoding; - end; - -(* -=============================================================================================== -IMPLEMENTATION -=============================================================================================== -*) - -implementation - -{$IFNDEF DELPHI12_UP} -function CharInSet(C: Char; const CharSet: TSysCharSet): Boolean; -begin - Result := C in CharSet; -end; -{$ENDIF} - -(* -=============================================================================================== -Unicode and UTF-8 stuff -=============================================================================================== -*) - -const - // --- Character Translation Table for Unicode <-> Win-1252 - WIN1252_UNICODE: array[$00..$FF] of WORD = ( - $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, - $000A, $000B, $000C, $000D, $000E, $000F, $0010, $0011, $0012, $0013, - $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, - $001E, $001F, $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, - $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F, $0030, $0031, - $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, - $003C, $003D, $003E, $003F, $0040, $0041, $0042, $0043, $0044, $0045, - $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F, - $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, - $005A, $005B, $005C, $005D, $005E, $005F, $0060, $0061, $0062, $0063, - $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, - $006E, $006F, $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, - $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F, - - $20AC, $0081, $201A, $0192, $201E, $2026, $2020, $2021, $02C6, $2030, - $0160, $2039, $0152, $008D, $017D, $008F, $0090, $2018, $2019, $201C, - $201D, $2022, $2013, $2014, $02DC, $2122, $0161, $203A, $0153, $009D, - $017E, $0178, $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7, - $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF, $00B0, $00B1, - $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, $00B8, $00B9, $00BA, $00BB, - $00BC, $00BD, $00BE, $00BF, $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, - $00C6, $00C7, $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF, - $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7, $00D8, $00D9, - $00DA, $00DB, $00DC, $00DD, $00DE, $00DF, $00E0, $00E1, $00E2, $00E3, - $00E4, $00E5, $00E6, $00E7, $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, - $00EE, $00EF, $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7, - $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF); - -(* UTF-8 (somewhat simplified) - ----- - Character Range Byte sequence - --------------- -------------------------- (x=Bits from original character) - $0000..$007F 0xxxxxxx - $0080..$07FF 110xxxxx 10xxxxxx - $8000..$FFFF 1110xxxx 10xxxxxx 10xxxxxx - - Example - -------- - Transforming the Unicode character U+00E4 LATIN SMALL LETTER A WITH DIAERESIS (""): - - ISO-8859-1, Decimal 228 - Win1252, Hex $E4 - ANSI Bin 1110 0100 - abcd efgh - - UTF-8 Binary 1100xxab 10cdefgh - Binary 11000011 10100100 - Hex $C3 $A4 - Decimal 195 164 - ANSI *) - - -function StringToPAnsiChar(inString: string): PAnsiChar; -var - AnsString: AnsiString; - InternalError: Boolean; -begin - InternalError := False; - Result := ''; - try - if inString <> EmptyStr then - begin - AnsString := AnsiString(inString); - Result := PAnsiChar(PAnsiString(AnsString)); - end; - except - InternalError := True; - end; - if InternalError or (string(Result) <> inString) then - begin - raise Exception.Create('Conversion from string to PAnsiChar failed!'); - end; -end; - -function AnsiToUtf8(Source: ANSISTRING): string; - (* Converts the given Windows ANSI (Win1252) String to UTF-8. *) -var - I: INTEGER; // Loop counter - U: WORD; // Current Unicode value - Len: INTEGER; // Current real length of "Result" string -begin - SetLength(Result, Length(Source) * 3); // Worst case - Len := 0; - for I := 1 to Length(Source) do - begin - U := WIN1252_UNICODE[ORD(Source[I])]; - case U of - $0000..$007F: - begin - INC(Len); - Result[Len] := CHR(U); - end; - $0080..$07FF: - begin - INC(Len); - Result[Len] := CHR($C0 or (U shr 6)); - INC(Len); - Result[Len] := CHR($80 or (U and $3F)); - end; - $0800..$FFFF: - begin - INC(Len); - Result[Len] := CHR($E0 or (U shr 12)); - INC(Len); - Result[Len] := CHR($80 or ((U shr 6) and $3F)); - INC(Len); - Result[Len] := CHR($80 or (U and $3F)); - end; - end; - end; - SetLength(Result, Len); -end; - -function Utf8ToAnsi(Source: string; UnknownChar: AnsiChar = ''): ANSISTRING; - (* Converts the given UTF-8 String to Windows ANSI (Win-1252). - If a character can not be converted, the "UnknownChar" is inserted. *) -var - SourceLen: INTEGER; // Length of Source string - I, K: INTEGER; - A: BYTE; // Current ANSI character value - U: WORD; - Ch: AnsiChar; // Dest char - Len: INTEGER; // Current real length of "Result" string -begin - SourceLen := Length(Source); - SetLength(Result, SourceLen); // Enough room to live - Len := 0; - I := 1; - while I <= SourceLen do - begin - A := ORD(Source[I]); - if A < $80 then - begin // Range $0000..$007F - INC(Len); - Result[Len] := AnsiChar(Source[I]); - INC(I); - end - else - begin // Determine U, Inc I - if (A and $E0 = $C0) and (I < SourceLen) then - begin // Range $0080..$07FF - U := (WORD(A and $1F) shl 6) or (ORD(Source[I + 1]) and $3F); - INC(I, 2); - end - else - if (A and $F0 = $E0) and (I < SourceLen - 1) then - begin // Range $0800..$FFFF - U := (WORD(A and $0F) shl 12) or - (WORD(ORD(Source[I + 1]) and $3F) shl 6) or - (ORD(Source[I + 2]) and $3F); - INC(I, 3); - end - else - begin // Unknown/unsupported - INC(I); - for K := 7 downto 0 do - if A and (1 shl K) = 0 then - begin - INC(I, (A shr (K + 1)) - 1); - BREAK; - end; - U := WIN1252_UNICODE[ORD(UnknownChar)]; - end; - Ch := UnknownChar; // Retrieve ANSI char - for A := $00 to $FF do - if WIN1252_UNICODE[A] = U then - begin - Ch := AnsiChar(CHR(A)); - BREAK; - end; - INC(Len); - Result[Len] := AnsiChar(Ch); - end; - end; - SetLength(Result, Len); -end; - -(* -=============================================================================================== -"Special" Helper Functions - -Don't ask me why. But including these functions makes the parser *DRAMATICALLY* faster -on my K6-233 machine. You can test it yourself just by commenting them out. -They do exactly the same as the Assembler routines defined in SysUtils. -(This is where you can see how great the Delphi compiler really is. The compiled code is -faster than hand-coded assembler!) -=============================================================================================== ---> Just move this line below the StrScan function --> *) - -function StrPos(const Str, SearchStr: PAnsiChar): PAnsiChar; - // Same functionality as SysUtils.StrPos -var - First: AnsiChar; - Len: INTEGER; -begin - First := AnsiChar(SearchStr^); - Len := StrLen(SearchStr); - Result := Str; - repeat - if AnsiChar(Result^) = First then - if StrLComp(Result, SearchStr, Len) = 0 then - BREAK; - if Result^ = #0 then - begin - Result := nil; - BREAK; - end; - INC(Result); - until FALSE; -end; - -function StrScan(const Start: PAnsiChar; const Ch: AnsiChar): PAnsiChar; - // Same functionality as SysUtils.StrScan -begin - Result := Start; - while AnsiChar(Result^) <> Ch do - begin - if Result^ = #0 then - begin - Result := nil; - EXIT; - end; - INC(Result); - end; -end; - -(* -=============================================================================================== -Helper Functions -=============================================================================================== -*) - -function DelChars(Source: string; CharsToDelete: TCharset): string; - // Delete all "CharsToDelete" from the string -var - I: INTEGER; -begin - Result := Source; - for I := Length(Result) downto 1 do - if CharInSet(Result[I], CharsToDelete) then - Delete(Result, I, 1); -end; - -function TrimWs(Source: string): string; - // Trimms off Whitespace characters from both ends of the string -var - I: INTEGER; -begin - // --- Trim Left - I := 1; - while (I <= Length(Source)) and (CharInSet(Source[I], CWhitespace)) do - INC(I); - Result := Copy(Source, I, MaxInt); - - // --- Trim Right - I := Length(Result); - while (I > 1) and (CharInSet(Result[I], CWhitespace)) do - DEC(I); - Delete(Result, I + 1, Length(Result) - I); -end; - -function ConvertWs(Source: string; PackWs: BOOLEAN): string; - // Converts all Whitespace characters to the Space #x20 character - // If "PackWs" is true, contiguous Whitespace characters are packed to one -var - I: INTEGER; -begin - Result := Source; - for I := Length(Result) downto 1 do - if (CharInSet(Result[I], CWhitespace)) then - if PackWs and (I > 1) and (CharInSet(Result[I - 1], CWhitespace)) - then - Delete(Result, I, 1) - else - Result[I] := #32; -end; - -procedure SetStringSF(var S: string; BufferStart, BufferFinal: PAnsiChar); -begin - SetString(S, BufferStart, BufferFinal - BufferStart + 1); -end; - -function StrLPas(Start: PAnsiChar; Len: INTEGER): string; -begin - SetString(Result, Start, Len); -end; - -function StrSFPas(Start, Finish: PAnsiChar): string; -begin - SetString(Result, Start, Finish - Start + 1); -end; - -function StrScanE(const Source: PAnsiChar; const CharToScanFor: AnsiChar): PAnsiChar; - // If "CharToScanFor" is not found, StrScanE returns the last char of the - // buffer instead of NIL -begin - Result := StrScan(Source, CharToScanFor); - if Result = nil then - Result := StrEnd(Source) - 1; -end; - -procedure ExtractName(Start: PAnsiChar; Terminators: TCharset; var Final: PAnsiChar); - (* Extracts the complete Name beginning at "Start". - It is assumed that the name is contained in Markup, so the '>' character is - always a Termination. - Start: IN Pointer to first char of name. Is always considered to be valid - Terminators: IN Characters which terminate the name - Final: OUT Pointer to last char of name *) -begin - Final := Start + 1; - Include(Terminators, #0); - Include(Terminators, '>'); - while not (CharInSet(Final^, Terminators)) do - INC(Final); - DEC(Final); -end; - -procedure ExtractQuote(Start: PAnsiChar; var Content: string; var Final: PAnsiChar); - (* Extract a string which is contained in single or double Quotes. - Start: IN Pointer to opening quote - Content: OUT The quoted string - Final: OUT Pointer to closing quote *) -begin - Final := StrScan(Start + 1, AnsiChar(Start^)); - if Final = nil then - begin - Final := StrEnd(Start + 1) - 1; - SetString(Content, Start + 1, Final - Start); - end - else - SetString(Content, Start + 1, Final - 1 - Start); -end; - -(* -=============================================================================================== -TEntityStackNode -This Node is pushed to the "Entity Stack" whenever the parser parses entity replacement text. -The "Instance" field holds the Instance pointer of an External Entity buffer. When it is -popped, the Instance is freed. -The "Encoding" field holds the name of the Encoding. External Parsed Entities may have -another encoding as the document entity (XmlSpec 4.3.3). So when there is an " 0 then - begin - ESN := TEntityStackNode(Items[Count - 1]); - Result := ESN.LastPos; - if ESN.Instance <> nil then - ESN.Instance.Free; - if ESN.Encoding <> '' then - Owner.FCurEncoding := ESN.Encoding; // Restore current Encoding - Delete(Count - 1); - end - else - Result := nil; -end; - -(* -=============================================================================================== -TExternalID ------------ -XmlSpec 4.2.2: ExternalID ::= 'SYSTEM' S SystemLiteral | - 'PUBLIC' S PubidLiteral S SystemLiteral -XmlSpec 4.7: PublicID ::= 'PUBLIC' S PubidLiteral -SystemLiteral and PubidLiteral are quoted -=============================================================================================== -*) - -type - TExternalID = class - PublicId: string; - SystemId: string; - Final: PAnsiChar; - constructor Create(Start: PAnsiChar); - end; - -constructor TExternalID.Create(Start: PAnsiChar); -begin - inherited Create; - Final := Start; - if StrLComp(Start, 'SYSTEM', 6) = 0 then - begin - while not (CharInSet(Final^, (CQuoteChar + [#0, '>', '[']))) do - INC(Final); - if not (CharInSet(Final^, CQuoteChar)) then - EXIT; - ExtractQuote(Final, SystemID, Final); - end - else - if StrLComp(Start, 'PUBLIC', 6) = 0 then - begin - while not (CharInSet(Final^, (CQuoteChar + [#0, '>', '[']))) do - INC(Final); - if not (CharInSet(Final^, CQuoteChar)) then - EXIT; - ExtractQuote(Final, PublicID, Final); - INC(Final); - while not (CharInSet(Final^, (CQuoteChar + [#0, '>', '[']))) do - INC(Final); - if not (CharInSet(Final^, CQuoteChar)) then - EXIT; - ExtractQuote(Final, SystemID, Final); - end; -end; - -(* -=============================================================================================== -TXmlParser -=============================================================================================== -*) - -constructor TXmlParser.Create; -begin - inherited Create; - FBuffer := nil; - FBufferSize := 0; - Elements := TElemList.Create; - Entities := TNvpList.Create; - ParEntities := TNvpList.Create; - Notations := TNvpList.Create; - CurAttr := TAttrList.Create; - EntityStack := TEntityStack.Create(Self); - Clear; -end; - -destructor TXmlParser.Destroy; -begin - Clear; - Elements.Free; - Entities.Free; - ParEntities.Free; - Notations.Free; - CurAttr.Free; - EntityStack.Free; - inherited Destroy; -end; - -procedure TXmlParser.Clear; - // Free Buffer and clear all object attributes -begin - if (FBufferSize > 0) and (FBuffer <> nil) then - FreeMem(FBuffer); - FBuffer := nil; - FBufferSize := 0; - FSource := ''; - FXmlVersion := ''; - FEncoding := ''; - FStandalone := FALSE; - FRootName := ''; - FDtdcFinal := nil; - FNormalize := TRUE; - Elements.Clear; - Entities.Clear; - ParEntities.Clear; - Notations.Clear; - CurAttr.Clear; - EntityStack.Clear; -end; - -function TXmlParser.LoadFromFile(Filename: string; FileMode: INTEGER = fmOpenRead or fmShareDenyNone): BOOLEAN; - // Loads Document from given file - // Returns TRUE if successful -var - f: file; - ReadIn: INTEGER; - OldFileMode: INTEGER; -begin - Result := FALSE; - Clear; - - // --- Open File - OldFileMode := SYSTEM.FileMode; - try - SYSTEM.FileMode := FileMode; - try - AssignFile(f, Filename); - Reset(f, 1); - except - EXIT; - end; - - try - // --- Allocate Memory - try - FBufferSize := Filesize(f) + 1; - GetMem(FBuffer, FBufferSize); - except - Clear; - EXIT; - end; - - // --- Read File - try - BlockRead(f, FBuffer^, FBufferSize, ReadIn); - (FBuffer + ReadIn)^ := #0; // NULL termination - except - Clear; - EXIT; - end; - finally - CloseFile(f); - end; - - FSource := Filename; - Result := TRUE; - - finally - SYSTEM.FileMode := OldFileMode; - end; -end; - -function TXmlParser.LoadFromBuffer(Buffer: PAnsiChar): BOOLEAN; - // Loads Document from another buffer - // Returns TRUE if successful - // The "Source" property becomes '' if successful -begin - Result := FALSE; - Clear; - FBufferSize := StrLen(Buffer) + 1; - try - GetMem(FBuffer, FBufferSize); - except - Clear; - EXIT; - end; - StrCopy(FBuffer, Buffer); - FSource := ''; - Result := TRUE; -end; - -procedure TXmlParser.SetBuffer(Buffer: PAnsiChar); // References another buffer -begin - Clear; - FBuffer := Buffer; - FBufferSize := 0; - FSource := ''; -end; - -//----------------------------------------------------------------------------------------------- -// Scanning through the document -//----------------------------------------------------------------------------------------------- - -procedure TXmlParser.StartScan; -begin - CurPartType := ptNone; - CurName := ''; - CurContent := ''; - CurStart := nil; - CurFinal := nil; - CurAttr.Clear; - EntityStack.Clear; -end; - -function TXmlParser.Scan: BOOLEAN; - // Scans the next Part - // Returns TRUE if a part could be found, FALSE if there is no part any more - // - // "IsDone" can be set to FALSE by AnalyzeText in order to go to the next part - // if there is no Content due to normalization -var - IsDone: BOOLEAN; -begin - repeat - IsDone := TRUE; - - // --- Start of next Part - if CurStart = nil - then - CurStart := DocBuffer - else - CurStart := CurFinal + 1; - CurFinal := CurStart; - // --- End of Document of Pop off a new part from the Entity stack? - if CurStart^ = #0 then - CurStart := EntityStack.Pop; - - // --- No Document or End Of Document: Terminate Scan - if (CurStart = nil) or (CurStart^ = #0) then - begin - CurStart := StrEnd(DocBuffer); - CurFinal := CurStart - 1; - EntityStack.Clear; - Result := FALSE; - EXIT; - end; - - if (StrLComp(CurStart, ''); - if CurFinal <> nil - then - INC(CurFinal) - else - CurFinal := StrEnd(CurStart) - 1; - FCurEncoding := AnsiUpperCase(CurAttr.Value('encoding')); - if FCurEncoding = '' then - FCurEncoding := 'UTF-8'; // Default XML Encoding is UTF-8 - CurPartType := ptXmlProlog; - CurName := ''; - CurContent := ''; -end; - -procedure TXmlParser.AnalyzeComment(Start: PAnsiChar; var Final: PAnsiChar); - // Analyze Comments -begin - Final := StrPos(Start + 4, '-->'); - if Final = nil - then - Final := StrEnd(Start) - 1 - else - INC(Final, 2); - CurPartType := ptComment; -end; - -procedure TXmlParser.AnalyzePI(Start: PAnsiChar; var Final: PAnsiChar); - // Analyze Processing Instructions (PI) - // This is also called for Character -var - F: PAnsiChar; -begin - CurPartType := ptPI; - Final := StrPos(Start + 2, '?>'); - if Final = nil - then - Final := StrEnd(Start) - 1 - else - INC(Final); - ExtractName(Start + 2, CWhitespace + ['?', '>'], F); - SetStringSF(CurName, Start + 2, F); - SetStringSF(CurContent, F + 1, Final - 2); - CurAttr.Analyze(F + 1, F); -end; - -procedure TXmlParser.AnalyzeDtdc; - (* Analyze Document Type Declaration - doctypedecl ::= '' - markupdecl ::= elementdecl | AttlistDecl | EntityDecl | NotationDecl | PI | Comment - PEReference ::= '%' Name ';' - - elementdecl ::= '' - AttlistDecl ::= '' - EntityDecl ::= '' | - '' - NotationDecl ::= '' - PI ::= '' Char* )))? '?>' - Comment ::= '' *) -type - TPhase = (phName, phDtd, phInternal, phFinishing); -var - Phase: TPhase; - F: PAnsiChar; - ExternalID: TExternalID; - ExternalDTD: TXmlParser; - DER: TDtdElementRec; -begin - DER.Start := CurStart; - EntityStack.Clear; // Clear stack for Parameter Entities - CurPartType := ptDtdc; - - // --- Don't read DTDc twice - if FDtdcFinal <> nil then - begin - CurFinal := FDtdcFinal; - EXIT; - end; - - // --- Scan DTDc - CurFinal := CurStart + 9; // First char after '': BREAK; - else - if not (CharInSet(CurFinal^, CWhitespace)) then - begin - case Phase of - phName: - if (CharInSet(CurFinal^, CNameStart)) then - begin - ExtractName(CurFinal, CWhitespace + ['[', '>'], F); - SetStringSF(FRootName, CurFinal, F); - CurFinal := F; - Phase := phDtd; - end; - phDtd: - if (StrLComp(CurFinal, 'SYSTEM', 6) = 0) or - (StrLComp(CurFinal, 'PUBLIC', 6) = 0) then - begin - ExternalID := TExternalID.Create(CurFinal); - ExternalDTD := LoadExternalEntity(ExternalId.SystemId, ExternalID.PublicId, ''); - F := StrPos(ExternalDtd.DocBuffer, ' nil then - AnalyzeDtdElements(F, F); - ExternalDTD.Free; - CurFinal := ExternalID.Final; - ExternalID.Free; - end; - else - begin - DER.ElementType := deError; - DER.Pos := CurFinal; - DER.Final := CurFinal; - DtdElementFound(DER); - end; - end; - - end; - end; - INC(CurFinal); - until FALSE; - - CurPartType := ptDtdc; - CurName := ''; - CurContent := ''; - - // It is an error in the document if "EntityStack" is not empty now - if EntityStack.Count > 0 then - begin - DER.ElementType := deError; - DER.Final := CurFinal; - DER.Pos := CurFinal; - DtdElementFound(DER); - end; - - EntityStack.Clear; // Clear stack for General Entities - FDtdcFinal := CurFinal; -end; - -procedure TXmlParser.AnalyzeDtdElements(Start: PAnsiChar; var Final: PAnsiChar); - // Analyze the "Elements" of a DTD contained in the external or - // internal DTD subset. -var - DER: TDtdElementRec; -begin - Final := Start; - repeat - case Final^ of - '%': - begin - PushPE(Final); - CONTINUE; - end; - #0: - if EntityStack.Count = 0 then - BREAK - else - begin - CurFinal := EntityStack.Pop; - CONTINUE; - end; - ']', - '>': BREAK; - '<': - if StrLComp(Final, ''); - - // --- Set Default Attribute values for nonexistent attributes - if (CurPartType = ptStartTag) or (CurPartType = ptEmptyTag) then - begin - ElemDef := Elements.Node(CurName); - if ElemDef <> nil then - begin - for I := 0 to ElemDef.Count - 1 do - begin - AttrDef := TAttrDef(ElemDef[I]); - Attr := TAttr(CurAttr.Node(AttrDef.Name)); - if (Attr = nil) and (AttrDef.Value <> '') then - begin - Attr := TAttr.Create(AttrDef.Name, AttrDef.Value); - Attr.ValueType := vtDefault; - CurAttr.Add(Attr); - end; - if Attr <> nil then - begin - case AttrDef.DefaultType of - adDefault: ; - adRequired: ; // -!- It is an error in the document if "Attr.Value" is an empty string - adImplied: Attr.ValueType := vtImplied; - adFixed: - begin - Attr.ValueType := vtFixed; - Attr.Value := AttrDef.Value; - end; - end; - Attr.AttrType := AttrDef.AttrType; - end; - end; - end; - - // --- Normalize Attribute Values. XmlSpec: - // - a character reference is processed by appending the referenced character to the attribute value - // - an entity reference is processed by recursively processing the replacement text of the entity - // - a whitespace character (#x20, #xD, #xA, #x9) is processed by appending #x20 to the normalized value, - // except that only a single #x20 is appended for a "#xD#xA" sequence that is part of an external - // parsed entity or the literal entity value of an internal parsed entity - // - other characters are processed by appending them to the normalized value - // If the declared value is not CDATA, then the XML processor must further process the - // normalized attribute value by discarding any leading and trailing space (#x20) characters, - // and by replacing sequences of space (#x20) characters by a single space (#x20) character. - // All attributes for which no declaration has been read should be treated by a - // non-validating parser as if declared CDATA. - // !!! The XML 1.0 SE specification is somewhat different here - // This code does not conform exactly to this specification - for I := 0 to CurAttr.Count - 1 do - with TAttr(CurAttr[I]) do - begin - ReplaceGeneralEntities(Value); - ReplaceCharacterEntities(Value); - if (AttrType <> atCData) and (AttrType <> atUnknown) - then - Value := TranslateEncoding(TrimWs(ConvertWs(Value, TRUE))) - else - Value := TranslateEncoding(ConvertWs(Value, FALSE)); - end; - end; -end; - -procedure TXmlParser.AnalyzeCData; - // Analyze CDATA Sections -begin - CurPartType := ptCData; - CurFinal := StrPos(CurStart, CDEnd); - if CurFinal = nil then - begin - CurFinal := StrEnd(CurStart) - 1; - CurContent := TranslateEncoding(string(StrPas(CurStart + Length(CDStart)))); - end - else - begin - SetStringSF(CurContent, CurStart + Length(CDStart), CurFinal - 1); - INC(CurFinal, Length(CDEnd) - 1); - CurContent := TranslateEncoding(CurContent); - end; -end; - -procedure TXmlParser.AnalyzeText(var IsDone: BOOLEAN); - (* Analyzes Text Content between Tags. CurFinal will point to the last content character. - Content ends at a '<' character or at the end of the document. - Entity References and Character Entity references are resolved. - If PackSpaces is TRUE, contiguous Whitespace Characters will be compressed to - one Space #x20 character, Whitespace at the beginning and end of content will - be trimmed off and content which is or becomes empty is not returned to - the application (in this case, "IsDone" is set to FALSE which causes the - Scan method to proceed directly to the next part. *) - - procedure ProcessEntity; - (* Is called if there is an ampsersand '&' character found in the document. - IN "CurFinal" points to the ampersand - OUT "CurFinal" points to the first character after the semi-colon ';' *) - var - P: PAnsiChar; - Name: string; - EntityDef: TEntityDef; - ExternalEntity: TXmlParser; - begin - P := StrScan(CurFinal, ';'); - if P <> nil then - begin - SetStringSF(Name, CurFinal + 1, P - 1); - - // Is it a Character Entity? - if (CurFinal + 1)^ = '#' then - begin - if UpCase((CurFinal + 2)^) = 'X' // !!! Can't use "CHR" for Unicode characters > 255: - then - CurContent := CurContent + CHR(StrToIntDef('$' + Copy(Name, 3, MaxInt), 32)) - else - CurContent := CurContent + CHR(StrToIntDef(Copy(Name, 2, MaxInt), 32)); - CurFinal := P + 1; - EXIT; - end - - // Is it a Predefined Entity? - else - if Name = 'lt' then - begin - CurContent := CurContent + '<'; - CurFinal := P + 1; - EXIT; - end - else - if Name = 'gt' then - begin - CurContent := CurContent + '>'; - CurFinal := P + 1; - EXIT; - end - else - if Name = 'amp' then - begin - CurContent := CurContent + '&'; - CurFinal := P + 1; - EXIT; - end - else - if Name = 'apos' then - begin - CurContent := CurContent + ''''; - CurFinal := P + 1; - EXIT; - end - else - if Name = 'quot' then - begin - CurContent := CurContent + '"'; - CurFinal := P + 1; - EXIT; - end; - - // Replace with Entity from DTD - EntityDef := TEntityDef(Entities.Node(Name)); - if EntityDef <> nil then - begin - if EntityDef.Value <> '' then - begin - EntityStack.Push(P + 1); - CurFinal := StringToPAnsiChar(EntityDef.Value); - end - else - begin - ExternalEntity := LoadExternalEntity(EntityDef.SystemId, EntityDef.PublicId, EntityDef.NotationName); - EntityStack.Push(ExternalEntity, P + 1); - CurFinal := ExternalEntity.DocBuffer; - end; - end - else - begin - CurContent := CurContent + Name; - CurFinal := P + 1; - end; - end - else - begin - INC(CurFinal); - end; - end; - -var - C: INTEGER; -begin - CurFinal := CurStart; - CurPartType := ptContent; - CurContent := ''; - C := 0; - repeat - case CurFinal^ of - '&': - begin - CurContent := CurContent + TranslateEncoding(StrLPas(CurFinal - C, C)); - C := 0; - ProcessEntity; - CONTINUE; - end; - #0: - begin - if EntityStack.Count = 0 then - BREAK - else - begin - CurContent := CurContent + TranslateEncoding(StrLPas(CurFinal - C, C)); - C := 0; - CurFinal := EntityStack.Pop; - CONTINUE; - end; - end; - '<': BREAK; - else - INC(C); - end; - INC(CurFinal); - until FALSE; - CurContent := CurContent + TranslateEncoding(StrLPas(CurFinal - C, C)); - DEC(CurFinal); - - if FNormalize then - begin - CurContent := ConvertWs(TrimWs(CurContent), TRUE); - IsDone := CurContent <> ''; // IsDone will only get FALSE if PackSpaces is TRUE - end; -end; - -procedure TXmlParser.AnalyzeElementDecl(Start: PAnsiChar; var Final: PAnsiChar); - (* Parse ' character - XmlSpec 3.2: - elementdecl ::= '' - contentspec ::= 'EMPTY' | 'ANY' | Mixed | children - Mixed ::= '(' S? '#PCDATA' (S? '|' S? Name)* S? ')*' | - '(' S? '#PCDATA' S? ')' - children ::= (choice | seq) ('?' | '*' | '+')? - choice ::= '(' S? cp ( S? '|' S? cp )* S? ')' - cp ::= (Name | choice | seq) ('?' | '*' | '+')? - seq ::= '(' S? cp ( S? ',' S? cp )* S? ')' - - More simply: - contentspec ::= EMPTY - ANY - '(#PCDATA)' - '(#PCDATA | A | B)*' - '(A, B, C)' - '(A | B | C)' - '(A?, B*, C+), - '(A, (B | C | D)* )' *) -var - Element: TElemDef; - Elem2: TElemDef; - F: PAnsiChar; - DER: TDtdElementRec; -begin - Element := TElemDef.Create; - Final := Start + 9; - DER.Start := Start; - repeat - if Final^ = '>' then - BREAK; - if (CharInSet(Final^, CNameStart)) and (Element.Name = '') then - begin - ExtractName(Final, CWhitespace, F); - SetStringSF(Element.Name, Final, F); - Final := F; - F := StrScan(Final + 1, '>'); - if F = nil then - begin - Element.Definition := string(Final); - Final := StrEnd(Final); - BREAK; - end - else - begin - SetStringSF(Element.Definition, Final + 1, F - 1); - Final := F; - BREAK; - end; - end; - INC(Final); - until FALSE; - Element.Definition := DelChars(Element.Definition, CWhitespace); - ReplaceParameterEntities(Element.Definition); - if Element.Definition = 'EMPTY' then - Element.ElemType := etEmpty - else - if Element.Definition = 'ANY' then - Element.ElemType := etAny - else - if Copy(Element.Definition, 1, 8) = '(#PCDATA' then - Element.ElemType := etMixed - else - if Copy(Element.Definition, 1, 1) = '(' then - Element.ElemType := etChildren - else - Element.ElemType := etAny; - - Elem2 := Elements.Node(Element.Name); - if Elem2 <> nil then - Elements.Delete(Elements.IndexOf(Elem2)); - Elements.Add(Element); - Final := StrScanE(Final, '>'); - DER.ElementType := deElement; - DER.ElemDef := Element; - DER.Final := Final; - DtdElementFound(DER); -end; - -procedure TXmlParser.AnalyzeAttListDecl(Start: PAnsiChar; var Final: PAnsiChar); - (* Parse ' character - XmlSpec 3.3: - AttlistDecl ::= '' - AttDef ::= S Name S AttType S DefaultDecl - AttType ::= StringType | TokenizedType | EnumeratedType - StringType ::= 'CDATA' - TokenizedType ::= 'ID' | 'IDREF' | 'IDREFS' | 'ENTITY' | 'ENTITIES' | 'NMTOKEN' | 'NMTOKENS' - EnumeratedType ::= NotationType | Enumeration - NotationType ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')' - Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')' - DefaultDecl ::= '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue) - AttValue ::= '"' ([^<&"] | Reference)* '"' | "'" ([^<&'] | Reference)* "'" - Examples: - *) -type - TPhase = (phElementName, phName, phType, phNotationContent, phDefault); -var - Phase: TPhase; - F: PAnsiChar; - ElementName: string; - ElemDef: TElemDef; - AttrDef: TAttrDef; - AttrDef2: TAttrDef; - Strg: string; - DER: TDtdElementRec; -begin - Final := Start + 9; // The character after ': BREAK; - else - case Phase of - phElementName: - begin - ExtractName(Final, CWhitespace + CQuoteChar + ['#'], F); - SetStringSF(ElementName, Final, F); - Final := F; - ElemDef := Elements.Node(ElementName); - if ElemDef = nil then - begin - ElemDef := TElemDef.Create; - ElemDef.Name := ElementName; - ElemDef.Definition := 'ANY'; - ElemDef.ElemType := etAny; - Elements.Add(ElemDef); - end; - Phase := phName; - end; - phName: - begin - AttrDef := TAttrDef.Create; - ExtractName(Final, CWhitespace + CQuoteChar + ['#'], F); - SetStringSF(AttrDef.Name, Final, F); - Final := F; - AttrDef2 := TAttrDef(ElemDef.Node(AttrDef.Name)); - if AttrDef2 <> nil then - ElemDef.Delete(ElemDef.IndexOf(AttrDef2)); - ElemDef.Add(AttrDef); - Phase := phType; - end; - phType: - begin - if Final^ = '(' then - begin - F := StrScan(Final + 1, ')'); - if F <> nil - then - SetStringSF(AttrDef.TypeDef, Final + 1, F - 1) - else - AttrDef.TypeDef := string(Final + 1); - AttrDef.TypeDef := DelChars(AttrDef.TypeDef, CWhitespace); - AttrDef.AttrType := atEnumeration; - ReplaceParameterEntities(AttrDef.TypeDef); - ReplaceCharacterEntities(AttrDef.TypeDef); - Phase := phDefault; - end - else - if StrLComp(Final, 'NOTATION', 8) = 0 then - begin - INC(Final, 8); - AttrDef.AttrType := atNotation; - Phase := phNotationContent; - end - else - begin - ExtractName(Final, CWhitespace + CQuoteChar + ['#'], F); - SetStringSF(AttrDef.TypeDef, Final, F); - if AttrDef.TypeDef = 'CDATA' then - AttrDef.AttrType := atCData - else - if AttrDef.TypeDef = 'ID' then - AttrDef.AttrType := atId - else - if AttrDef.TypeDef = 'IDREF' then - AttrDef.AttrType := atIdRef - else - if AttrDef.TypeDef = 'IDREFS' then - AttrDef.AttrType := atIdRefs - else - if AttrDef.TypeDef = 'ENTITY' then - AttrDef.AttrType := atEntity - else - if AttrDef.TypeDef = 'ENTITIES' then - AttrDef.AttrType := atEntities - else - if AttrDef.TypeDef = 'NMTOKEN' then - AttrDef.AttrType := atNmToken - else - if AttrDef.TypeDef = 'NMTOKENS' then - AttrDef.AttrType := atNmTokens; - Phase := phDefault; - end - end; - phNotationContent: - begin - F := StrScan(Final, ')'); - if F <> nil then - SetStringSF(AttrDef.Notations, Final + 1, F - 1) - else - begin - AttrDef.Notations := string(Final + 1); - Final := StrEnd(Final); - end; - ReplaceParameterEntities(AttrDef.Notations); - AttrDef.Notations := DelChars(AttrDef.Notations, CWhitespace); - Phase := phDefault; - end; - phDefault: - begin - if Final^ = '#' then - begin - ExtractName(Final, CWhiteSpace + CQuoteChar, F); - SetStringSF(Strg, Final, F); - Final := F; - ReplaceParameterEntities(Strg); - if Strg = '#REQUIRED' then - begin - AttrDef.DefaultType := adRequired; - Phase := phName; - end - else - if Strg = '#IMPLIED' then - begin - AttrDef.DefaultType := adImplied; - Phase := phName; - end - else - if Strg = '#FIXED' then - AttrDef.DefaultType := adFixed; - end - else - if (CharInSet(Final^, CQuoteChar)) then - begin - ExtractQuote(Final, AttrDef.Value, Final); - ReplaceParameterEntities(AttrDef.Value); - ReplaceCharacterEntities(AttrDef.Value); - Phase := phName; - end; - if Phase = phName then - begin - AttrDef := nil; - end; - end; - - end; - end; - INC(Final); - until FALSE; - - Final := StrScan(Final, '>'); - - DER.ElementType := deAttList; - DER.ElemDef := ElemDef; - DER.Final := Final; - DtdElementFound(DER); -end; - -procedure TXmlParser.AnalyzeEntityDecl(Start: PAnsiChar; var Final: PAnsiChar); - (* Parse ' character - XmlSpec 4.2: - EntityDecl ::= '' | - '' - EntityDef ::= EntityValue | (ExternalID NDataDecl?) - PEDef ::= EntityValue | ExternalID - NDataDecl ::= S 'NDATA' S Name - EntityValue ::= '"' ([^%&"] | PEReference | EntityRef | CharRef)* '"' | - "'" ([^%&'] | PEReference | EntityRef | CharRef)* "'" - PEReference ::= '%' Name ';' - - Examples - - - - "> - - - Dies ist ein Test-Absatz

"> - *) -type - TPhase = (phName, phContent, phNData, phNotationName, phFinalGT); -var - Phase: TPhase; - IsParamEntity: BOOLEAN; - F: PAnsiChar; - ExternalID: TExternalID; - EntityDef: TEntityDef; - EntityDef2: TEntityDef; - DER: TDtdElementRec; -begin - Final := Start + 8; // First char after ': BREAK; - else - case Phase of - phName: - if CharInSet(Final^, CNameStart) then - begin - ExtractName(Final, CWhitespace + CQuoteChar, F); - SetStringSF(EntityDef.Name, Final, F); - Final := F; - Phase := phContent; - end; - phContent: - if CharInSet(Final^, CQuoteChar) then - begin - ExtractQuote(Final, EntityDef.Value, Final); - Phase := phFinalGT; - end - else - if (StrLComp(Final, 'SYSTEM', 6) = 0) or - (StrLComp(Final, 'PUBLIC', 6) = 0) then - begin - ExternalID := TExternalID.Create(Final); - EntityDef.SystemId := ExternalID.SystemId; - EntityDef.PublicId := ExternalID.PublicId; - Final := ExternalID.Final; - Phase := phNData; - ExternalID.Free; - end; - phNData: - if StrLComp(Final, 'NDATA', 5) = 0 then - begin - INC(Final, 4); - Phase := phNotationName; - end; - phNotationName: - if CharInSet(Final^, CNameStart) then - begin - ExtractName(Final, CWhitespace + ['>'], F); - SetStringSF(EntityDef.NotationName, Final, F); - Final := F; - Phase := phFinalGT; - end; - phFinalGT: ; // -!- There is an error in the document if this branch is called - end; - end; - INC(Final); - until FALSE; - if IsParamEntity then - begin - EntityDef2 := TEntityDef(ParEntities.Node(EntityDef.Name)); - if EntityDef2 <> nil then - ParEntities.Delete(ParEntities.IndexOf(EntityDef2)); - ParEntities.Add(EntityDef); - ReplaceCharacterEntities(EntityDef.Value); - end - else - begin - EntityDef2 := TEntityDef(Entities.Node(EntityDef.Name)); - if EntityDef2 <> nil then - Entities.Delete(Entities.IndexOf(EntityDef2)); - Entities.Add(EntityDef); - ReplaceParameterEntities(EntityDef.Value); // Create replacement texts (see XmlSpec 4.5) - ReplaceCharacterEntities(EntityDef.Value); - end; - Final := StrScanE(Final, '>'); - - DER.ElementType := deEntity; - DER.EntityDef := EntityDef; - DER.Final := Final; - DtdElementFound(DER); -end; - -procedure TXmlParser.AnalyzeNotationDecl(Start: PAnsiChar; var Final: PAnsiChar); - // Parse ' character - // XmlSpec 4.7: NotationDecl ::= '' -type - TPhase = (phName, phExtId, phEnd); -var - ExternalID: TExternalID; - Phase: TPhase; - F: PAnsiChar; - NotationDef: TNotationDef; - DER: TDtdElementRec; -begin - Final := Start + 10; // Character after ', - #0: BREAK; - else - case Phase of - phName: - begin - ExtractName(Final, CWhitespace + ['>'], F); - SetStringSF(NotationDef.Name, Final, F); - Final := F; - Phase := phExtId; - end; - phExtId: - begin - ExternalID := TExternalID.Create(Final); - NotationDef.Value := ExternalID.SystemId; - NotationDef.PublicId := ExternalID.PublicId; - Final := ExternalId.Final; - ExternalId.Free; - Phase := phEnd; - end; - phEnd: ; // -!- There is an error in the document if this branch is called - end; - end; - INC(Final); - until FALSE; - Notations.Add(NotationDef); - Final := StrScanE(Final, '>'); - - DER.ElementType := deNotation; - DER.NotationDef := NotationDef; - DER.Final := Final; - DtdElementFound(DER); -end; - -procedure TXmlParser.PushPE(var Start: PAnsiChar); - (* If there is a parameter entity reference found in the data stream, - the current position will be pushed to the entity stack. - Start: IN Pointer to the '%' character starting the PE reference - OUT Pointer to first character of PE replacement text *) -var - P: PAnsiChar; - EntityDef: TEntityDef; -begin - P := StrScan(Start, ';'); - if P <> nil then - begin - EntityDef := TEntityDef(ParEntities.Node(StrSFPas(Start + 1, P - 1))); - if EntityDef <> nil then - begin - EntityStack.Push(P + 1); - Start := StringToPAnsiChar(EntityDef.Value); - end - else - Start := P + 1; - end; -end; - -procedure TXmlParser.ReplaceCharacterEntities(var Str: string); - // Replaces all Character Entity References in the String -var - Start: INTEGER; - PAmp: PAnsiChar; - PSemi: PAnsiChar; - PosAmp: INTEGER; - Len: INTEGER; // Length of Entity Reference -begin - if Str = '' then - EXIT; - Start := 1; - repeat - PAmp := StrPos(StringToPAnsiChar(Str) + Start - 1, '&#'); - if PAmp = nil then - BREAK; - PSemi := StrScan(PAmp + 2, ';'); - if PSemi = nil then - BREAK; - PosAmp := PAmp - StringToPAnsiChar(Str) + 1; - Len := PSemi - PAmp + 1; - if CompareText(Str[PosAmp + 2], 'x') = 0 // !!! Can't use "CHR" for Unicode characters > 255 - then - Str[PosAmp] := CHR(StrToIntDef('$' + Copy(Str, PosAmp + 3, Len - 4), 0)) - else - Str[PosAmp] := CHR(StrToIntDef(Copy(Str, PosAmp + 2, Len - 3), 32)); - Delete(Str, PosAmp + 1, Len - 1); - Start := PosAmp + 1; - until FALSE; -end; - -procedure TXmlParser.ReplaceParameterEntities(var Str: string); - // Recursively replaces all Parameter Entity References in the String - - procedure ReplaceEntities(var Str: string); - var - Start: INTEGER; - PAmp: PAnsiChar; - PSemi: PAnsiChar; - PosAmp: INTEGER; - Len: INTEGER; - Entity: TEntityDef; - Repl: string; // Replacement - begin - if Str = '' then - EXIT; - Start := 1; - repeat - PAmp := StrPos(StringToPAnsiChar(Str) + Start - 1, '%'); - if PAmp = nil then - BREAK; - PSemi := StrScan(PAmp + 2, ';'); - if PSemi = nil then - BREAK; - PosAmp := PAmp - StringToPAnsiChar(Str) + 1; - Len := PSemi - PAmp + 1; - Entity := TEntityDef(ParEntities.Node(Copy(Str, PosAmp + 1, Len - 2))); - if Entity <> nil then - begin - Repl := Entity.Value; - ReplaceEntities(Repl); // Recursion - end - else - Repl := Copy(Str, PosAmp, Len); - Delete(Str, PosAmp, Len); - Insert(Repl, Str, PosAmp); - Start := PosAmp + Length(Repl); - until FALSE; - end; -begin - ReplaceEntities(Str); -end; - -procedure TXmlParser.ReplaceGeneralEntities(var Str: string); - // Recursively replaces General Entity References in the String - - procedure ReplaceEntities(var Str: string); - var - Start: INTEGER; - PAmp: PAnsiChar; - PSemi: PAnsiChar; - PosAmp: INTEGER; - Len: INTEGER; - EntityDef: TEntityDef; - EntName: string; - Repl: string; // Replacement - ExternalEntity: TXmlParser; - begin - if Str = '' then - EXIT; - Start := 1; - repeat - PAmp := StrPos(StringToPAnsiChar(Str) + Start - 1, '&'); - if PAmp = nil then - BREAK; - PSemi := StrScan(PAmp + 2, ';'); - if PSemi = nil then - BREAK; - PosAmp := PAmp - StringToPAnsiChar(Str) + 1; - Len := PSemi - PAmp + 1; - EntName := Copy(Str, PosAmp + 1, Len - 2); - if EntName = 'lt' then - Repl := '<' - else - if EntName = 'gt' then - Repl := '>' - else - if EntName = 'amp' then - Repl := '&' - else - if EntName = 'apos' then - Repl := '''' - else - if EntName = 'quot' then - Repl := '"' - else - begin - EntityDef := TEntityDef(Entities.Node(EntName)); - if EntityDef <> nil then - begin - if EntityDef.Value <> '' then // Internal Entity - Repl := EntityDef.Value - else - begin // External Entity - ExternalEntity := LoadExternalEntity(EntityDef.SystemId, EntityDef.PublicId, EntityDef.NotationName); - Repl := string(StrPas(ExternalEntity.DocBuffer)); // !!! What if it contains a Text Declaration? - ExternalEntity.Free; - end; - ReplaceEntities(Repl); // Recursion - end - else - Repl := Copy(Str, PosAmp, Len); - end; - Delete(Str, PosAmp, Len); - Insert(Repl, Str, PosAmp); - Start := PosAmp + Length(Repl); - until FALSE; - end; -begin - ReplaceEntities(Str); -end; - -function TXmlParser.LoadExternalEntity(SystemId, PublicId, Notation: string): TXmlParser; - // This will be called whenever there is a Parsed External Entity or - // the DTD External Subset to be parsed. - // It has to create a TXmlParser instance and load the desired Entity. - // This instance of LoadExternalEntity assumes that "SystemId" is a valid - // file name (relative to the Document source) and loads this file using - // the LoadFromFile method. -var - Filename: string; -begin - // --- Convert System ID to complete filename - Filename := StringReplace(SystemId, '/', '\', [rfReplaceAll]); - if Copy(FSource, 1, 1) <> '<' then - if (Copy(Filename, 1, 2) = '\\') or (Copy(Filename, 2, 1) = ':') then - // Already has an absolute Path - else - begin - Filename := ExtractFilePath(FSource) + Filename; - end; - - // --- Load the File - Result := TXmlParser.Create; - Result.LoadFromFile(Filename); -end; - -function TXmlParser.TranslateEncoding(const Source: string): string; - // The member variable "CurEncoding" always holds the name of the current - // encoding, e.g. 'UTF-8' or 'ISO-8859-1'. - // This virtual method "TranslateEncoding" is responsible for translating - // the content passed in the "Source" parameter to the Encoding which - // is expected by the application. - // This instance of "TranlateEncoding" assumes that the Application expects - // Windows ANSI (Win1252) strings. It is able to transform UTF-8 or ISO-8859-1 - // encodings. - // If you want your application to understand or create other encodings, you - // override this function. -begin - if CurEncoding = 'UTF-8' - then - Result := string(Utf8ToAnsi(Source)) - else - Result := Source; -end; - -procedure TXmlParser.DtdElementFound(DtdElementRec: TDtdElementRec); - // This method is called for every element which is found in the DTD - // declaration. The variant record TDtdElementRec is passed which - // holds informations about the element. - // You can override this function to handle DTD declarations. - // Note that when you parse the same Document instance a second time, - // the DTD will not get parsed again. -begin -end; - -function TXmlParser.GetDocBuffer: PAnsiChar; - // Returns FBuffer or a pointer to a NUL char if Buffer is empty -begin - if FBuffer = nil - then - Result := #0 - else - Result := FBuffer; -end; - -(*$IFNDEF HAS_CONTNRS_UNIT -=============================================================================================== -TObjectList -=============================================================================================== -*) - -destructor TObjectList.Destroy; -begin - Clear; - SetCapacity(0); - inherited Destroy; -end; - -procedure TObjectList.Delete(Index: INTEGER); -begin - if (Index < 0) or (Index >= Count) then - EXIT; - TObject(Items[Index]).Free; - inherited Delete(Index); -end; - -procedure TObjectList.Clear; -begin - while Count > 0 do - Delete(Count - 1); -end; - -(*$ENDIF *) - -(* -=============================================================================================== -TNvpNode --------- -Node base class for the TNvpList -=============================================================================================== -*) - -constructor TNvpNode.Create(TheName, TheValue: string); -begin - inherited Create; - Name := TheName; - Value := TheValue; -end; - -(* -=============================================================================================== -TNvpList --------- -A generic List of Name-Value Pairs, based on the TObjectList introduced in Delphi 5 -=============================================================================================== -*) - -procedure TNvpList.Add(Node: TNvpNode); -var - I: INTEGER; -begin - for I := Count - 1 downto 0 do - if Node.Name > TNvpNode(Items[I]).Name then - begin - Insert(I + 1, Node); - EXIT; - end; - Insert(0, Node); -end; - -function TNvpList.Node(Name: string): TNvpNode; - // Binary search for Node -var - L, H: INTEGER; // Low, High Limit - T, C: INTEGER; // Test Index, Comparison result - Last: INTEGER; // Last Test Index -begin - if Count = 0 then - begin - Result := nil; - EXIT; - end; - - L := 0; - H := Count; - Last := -1; - repeat - T := (L + H) div 2; - if T = Last then - BREAK; - Result := TNvpNode(Items[T]); - C := CompareStr(Result.Name, Name); - if C = 0 then - EXIT - else - if C < 0 then - L := T - else - H := T; - Last := T; - until FALSE; - Result := nil; -end; - -function TNvpList.Node(Index: INTEGER): TNvpNode; -begin - if (Index < 0) or (Index >= Count) - then - Result := nil - else - Result := TNvpNode(Items[Index]); -end; - -function TNvpList.Value(Name: string): string; -var - Nvp: TNvpNode; -begin - Nvp := TNvpNode(Node(Name)); - if Nvp <> nil - then - Result := Nvp.Value - else - Result := ''; -end; - -function TNvpList.Value(Index: INTEGER): string; -begin - if (Index < 0) or (Index >= Count) - then - Result := '' - else - Result := TNvpNode(Items[Index]).Value; -end; - -function TNvpList.Name(Index: INTEGER): string; -begin - if (Index < 0) or (Index >= Count) - then - Result := '' - else - Result := TNvpNode(Items[Index]).Name; -end; - -(* -=============================================================================================== -TAttrList -List of Attributes. The "Analyze" method extracts the Attributes from the given Buffer. -Is used for extraction of Attributes in Start-Tags, Empty-Element Tags and the "pseudo" -attributes in XML Prologs, Text Declarations and PIs. -=============================================================================================== -*) - -procedure TAttrList.Analyze(Start: PAnsiChar; var Final: PAnsiChar); - // Analyze the Buffer for Attribute=Name pairs. - // Terminates when there is a character which is not IN CNameStart - // (e.g. '?>' or '>' or '/>') -type - TPhase = (phName, phEq, phValue); -var - Phase: TPhase; - F: PAnsiChar; - Name: string; - Value: string; - Attr: TAttr; -begin - Clear; - Phase := phName; - Final := Start; - repeat - if (Final^ = #0) or (Final^ = '>') then - BREAK; - if not (CharInSet(Final^, CWhitespace)) then - case Phase of - phName: - begin - if not (CharInSet(Final^, CNameStart)) then - EXIT; - ExtractName(Final, CWhitespace + ['=', '/'], F); - SetStringSF(Name, Final, F); - Final := F; - Phase := phEq; - end; - phEq: - begin - if Final^ = '=' then - Phase := phValue - end; - phValue: - begin - if CharInSet(Final^, CQuoteChar) then - begin - ExtractQuote(Final, Value, F); - Attr := TAttr.Create; - Attr.Name := Name; - Attr.Value := Value; - Attr.ValueType := vtNormal; - Add(Attr); - Final := F; - Phase := phName; - end; - end; - end; - INC(Final); - until FALSE; -end; - -(* -=============================================================================================== -TElemList -List of TElemDef nodes. -=============================================================================================== -*) - -function TElemList.Node(Name: string): TElemDef; - // Binary search for the Node with the given Name -var - L, H: INTEGER; // Low, High Limit - T, C: INTEGER; // Test Index, Comparison result - Last: INTEGER; // Last Test Index -begin - if Count = 0 then - begin - Result := nil; - EXIT; - end; - - L := 0; - H := Count; - Last := -1; - repeat - T := (L + H) div 2; - if T = Last then - BREAK; - Result := TElemDef(Items[T]); - C := CompareStr(Result.Name, Name); - if C = 0 then - EXIT - else - if C < 0 then - L := T - else - H := T; - Last := T; - until FALSE; - Result := nil; -end; - -procedure TElemList.Add(Node: TElemDef); -var - I: INTEGER; -begin - for I := Count - 1 downto 0 do - if Node.Name > TElemDef(Items[I]).Name then - begin - Insert(I + 1, Node); - EXIT; - end; - Insert(0, Node); -end; - -(* -=============================================================================================== -TScannerXmlParser -A TXmlParser descendant for the TCustomXmlScanner component -=============================================================================================== -*) - -type - TScannerXmlParser = class(TXmlParser) - Scanner: TCustomXmlScanner; - constructor Create(TheScanner: TCustomXmlScanner); - function LoadExternalEntity(SystemId, PublicId, - Notation: string): TXmlParser; override; - function TranslateEncoding(const Source: string): string; override; - procedure DtdElementFound(DtdElementRec: TDtdElementRec); override; - end; - -constructor TScannerXmlParser.Create(TheScanner: TCustomXmlScanner); -begin - inherited Create; - Scanner := TheScanner; -end; - -function TScannerXmlParser.LoadExternalEntity(SystemId, PublicId, Notation: string): TXmlParser; -begin - if Assigned(Scanner.FOnLoadExternal) - then - Scanner.FOnLoadExternal(Scanner, SystemId, PublicId, Notation, Result) - else - Result := inherited LoadExternalEntity(SystemId, PublicId, Notation); -end; - -function TScannerXmlParser.TranslateEncoding(const Source: string): string; -begin - if Assigned(Scanner.FOnTranslateEncoding) - then - Result := Scanner.FOnTranslateEncoding(Scanner, CurEncoding, Source) - else - Result := inherited TranslateEncoding(Source); -end; - -procedure TScannerXmlParser.DtdElementFound(DtdElementRec: TDtdElementRec); -begin - with DtdElementRec do - case ElementType of - deElement: Scanner.WhenElement(ElemDef); - deAttList: Scanner.WhenAttList(ElemDef); - deEntity: Scanner.WhenEntity(EntityDef); - deNotation: Scanner.WhenNotation(NotationDef); - dePI: Scanner.WhenPI(string(Target), string(Content), AttrList); - deComment: Scanner.WhenComment(StrSFPas(Start, Final)); - deError: Scanner.WhenDtdError(Pos); - end; -end; - -(* -=============================================================================================== -TCustomXmlScanner -=============================================================================================== -*) - -constructor TCustomXmlScanner.Create(AOwner: TComponent); -begin - inherited; - FXmlParser := TScannerXmlParser.Create(Self); -end; - -destructor TCustomXmlScanner.Destroy; -begin - FXmlParser.Free; - inherited; -end; - -procedure TCustomXmlScanner.LoadFromFile(Filename: TFilename); - // Load XML Document from file -begin - FXmlParser.LoadFromFile(Filename); -end; - -procedure TCustomXmlScanner.LoadFromBuffer(Buffer: PAnsiChar); - // Load XML Document from buffer -begin - FXmlParser.LoadFromBuffer(Buffer); -end; - -procedure TCustomXmlScanner.SetBuffer(Buffer: PAnsiChar); - // Refer to Buffer -begin - FXmlParser.SetBuffer(Buffer); -end; - -function TCustomXmlScanner.GetFilename: TFilename; -begin - Result := FXmlParser.Source; -end; - -function TCustomXmlScanner.GetNormalize: BOOLEAN; -begin - Result := FXmlParser.Normalize; -end; - -procedure TCustomXmlScanner.SetNormalize(Value: BOOLEAN); -begin - FXmlParser.Normalize := Value; -end; - -procedure TCustomXmlScanner.WhenXmlProlog(XmlVersion, Encoding: string; Standalone: BOOLEAN); - // Is called when the parser has parsed the declaration of the prolog -begin - if Assigned(FOnXmlProlog) then - FOnXmlProlog(Self, XmlVersion, Encoding, Standalone); -end; - -procedure TCustomXmlScanner.WhenComment(Comment: string); - // Is called when the parser has parsed a -begin - if Assigned(FOnComment) then - FOnComment(Self, Comment); -end; - -procedure TCustomXmlScanner.WhenPI(Target, Content: string; Attributes: TAttrList); - // Is called when the parser has parsed a -begin - if Assigned(FOnPI) then - FOnPI(Self, Target, Content, Attributes); -end; - -procedure TCustomXmlScanner.WhenDtdRead(RootElementName: string); - // Is called when the parser has completely parsed the DTD -begin - if Assigned(FOnDtdRead) then - FOnDtdRead(Self, RootElementName); -end; - -procedure TCustomXmlScanner.WhenStartTag(TagName: string; Attributes: TAttrList); - // Is called when the parser has parsed a start tag like

-begin - if Assigned(FOnStartTag) then - FOnStartTag(Self, TagName, Attributes); -end; - -procedure TCustomXmlScanner.WhenEmptyTag(TagName: string; Attributes: TAttrList); - // Is called when the parser has parsed an Empty Element Tag like
-begin - if Assigned(FOnEmptyTag) then - FOnEmptyTag(Self, TagName, Attributes); -end; - -procedure TCustomXmlScanner.WhenEndTag(TagName: string); - // Is called when the parser has parsed an End Tag like

-begin - if Assigned(FOnEndTag) then - FOnEndTag(Self, TagName); -end; - -procedure TCustomXmlScanner.WhenContent(Content: string); - // Is called when the parser has parsed an element's text content -begin - if Assigned(FOnContent) then - FOnContent(Self, Content); -end; - -procedure TCustomXmlScanner.WhenCData(Content: string); - // Is called when the parser has parsed a CDATA section -begin - if Assigned(FOnCData) then - FOnCData(Self, Content); -end; - -procedure TCustomXmlScanner.WhenElement(ElemDef: TElemDef); - // Is called when the parser has parsed an definition - // inside the DTD -begin - if Assigned(FOnElement) then - FOnElement(Self, ElemDef); -end; - -procedure TCustomXmlScanner.WhenAttList(ElemDef: TElemDef); - // Is called when the parser has parsed an definition - // inside the DTD -begin - if Assigned(FOnAttList) then - FOnAttList(Self, ElemDef); -end; - -procedure TCustomXmlScanner.WhenEntity(EntityDef: TEntityDef); - // Is called when the parser has parsed an definition - // inside the DTD -begin - if Assigned(FOnEntity) then - FOnEntity(Self, EntityDef); -end; - -procedure TCustomXmlScanner.WhenNotation(NotationDef: TNotationDef); - // Is called when the parser has parsed a definition - // inside the DTD -begin - if Assigned(FOnNotation) then - FOnNotation(Self, NotationDef); -end; - -procedure TCustomXmlScanner.WhenDtdError(ErrorPos: PAnsiChar); - // Is called when the parser has found an Error in the DTD -begin - if Assigned(FOnDtdError) then - FOnDtdError(Self, ErrorPos); -end; - -procedure TCustomXmlScanner.Execute; - // Perform scanning - // Scanning is done synchronously, i.e. you can expect events to be triggered - // in the order of the XML data stream. Execute will finish when the whole XML - // document has been scanned or when the StopParser property has been set to TRUE. -begin - FStopParser := FALSE; - FXmlParser.StartScan; - while FXmlParser.Scan and (not FStopParser) do - case FXmlParser.CurPartType of - ptNone: ; - ptXmlProlog: WhenXmlProlog(FXmlParser.XmlVersion, FXmlParser.Encoding, FXmlParser.Standalone); - ptComment: WhenComment(StrSFPas(FXmlParser.CurStart, FXmlParser.CurFinal)); - ptPI: WhenPI(FXmlParser.CurName, FXmlParser.CurContent, FXmlParser.CurAttr); - ptDtdc: WhenDtdRead(FXmlParser.RootName); - ptStartTag: WhenStartTag(FXmlParser.CurName, FXmlParser.CurAttr); - ptEmptyTag: WhenEmptyTag(FXmlParser.CurName, FXmlParser.CurAttr); - ptEndTag: WhenEndTag(FXmlParser.CurName); - ptContent: WhenContent(FXmlParser.CurContent); - ptCData: WhenCData(FXmlParser.CurContent); - end; -end; - -end. - From cf9217f18c1eccdac213cc79057c2f112806e2fd Mon Sep 17 00:00:00 2001 From: Tristan Marlow Date: Wed, 17 Feb 2016 12:54:42 +0800 Subject: [PATCH 03/15] Missing files --- Packages/EmbeddedWebBrowser_Seattle.dpk | 132 + Source/EwbLibXmlComps.pas | 110 + Source/EwbLibXmlParser.pas | 2961 +++++++++++++++++++++++ 3 files changed, 3203 insertions(+) create mode 100644 Packages/EmbeddedWebBrowser_Seattle.dpk create mode 100644 Source/EwbLibXmlComps.pas create mode 100644 Source/EwbLibXmlParser.pas diff --git a/Packages/EmbeddedWebBrowser_Seattle.dpk b/Packages/EmbeddedWebBrowser_Seattle.dpk new file mode 100644 index 0000000..d608037 --- /dev/null +++ b/Packages/EmbeddedWebBrowser_Seattle.dpk @@ -0,0 +1,132 @@ +{*******************************************************} +{ Embedded Web Browser package Delphi Seattle } +{ } +{ For Delphi 5 - Seattle } +{ Freeware Components } +{ Please note our uses terms } +{ } +{ Enjoy! } +{ UPDATES: } +{ http://www.bsalsa.com } +{*******************************************************************************} +{LICENSE: +THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, +EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED +WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. +YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE +AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE +AND DOCUMENTATION. [YOUR NAME] DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE +OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED +OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, +INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR +OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, +AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. VSOFT SPECIFICALLY +DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. + +You may use, change or modify the component under 4 conditions: +1. In your website, add a link to "http://www.bsalsa.com" +2. In your application, add credits to "Embedded Web Browser" +3. Mail me (bsalsa@bsalsa.com) any code change in the unit + for the benefit of the other users. +4. Please, consider donation in our web site! +{*******************************************************************************} + +package EmbeddedWebBrowser_Seattle; +{$R *.res} +{$R 'EWB.dcr'} +{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION OFF} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES ON} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DEFINE DEBUG} +{$ENDIF IMPLICITBUILDING} +{$DESCRIPTION 'Internet Embedded Web Browser Components'} +{$IMPLICITBUILD ON} + +requires + designide, + rtl, + vcl, + vclimg; + +contains + EmbeddedWB in '..\Source\EmbeddedWB.pas', + AppWebUpdater in '..\Source\AppWebUpdater.pas', + AppWUStrings in '..\Source\AppWUStrings.pas', + ExportFavorites in '..\Source\ExportFavorites.pas', + IEParser in '..\Source\IEParser.pas', + FavMenu in '..\Source\FavMenu.pas', + FavoritesListView in '..\Source\FavoritesListView.pas', + FavoritesTree in '..\Source\FavoritesTree.pas', + HistoryListView in '..\Source\HistoryListView.pas', + HistoryMenu in '..\Source\HistoryMenu.pas', + IECache in '..\Source\IECache.pas', + IEDownload in '..\Source\IEDownload.pas', + IEMultiDownload in '..\Source\IEMultiDownload.pas', + IEDownloadStrings in '..\Source\IEDownloadStrings.pas', + IEDownloadAcc in '..\Source\IEDownloadAcc.pas', + IETravelLog in '..\Source\IETravelLog.pas', + ImportFavorites in '..\Source\ImportFavorites.pas', + LibXmlComps in '..\Source\LibXmlComps.pas', + LibXmlParser in '..\Source\LibXmlParser.pas', + LinksBar in '..\Source\LinksBar.pas', + RichEditBrowser in '..\Source\RichEditBrowser.pas', + SecurityManager in '..\Source\SecurityManager.pas', + SendMail_For_Ewb in '..\Source\SendMail_For_Ewb.pas', + UrlHistory in '..\Source\UrlHistory.pas', + Edithost in '..\Source\Edithost.pas', + EditDesigner in '..\Source\EditDesigner.pas', + IEAddress in '..\Source\IEAddress.pas', + EwbEditors in '..\Source\EwbEditors.pas', + EwbReg in '..\Source\EwbReg.pas', + Browse4Folder in '..\Source\Browse4Folder.pas', + FileExtAssociate in '..\Source\FileExtAssociate.pas', + LinksLabel in '..\Source\LinksLabel.pas', + IeConst in '..\Source\IeConst.pas', + EwbAcc in '..\Source\EwbAcc.pas', + EwbTools in '..\Source\EwbTools.pas', + DirMonitor in '..\Source\DirMonitor.pas', + HighLightXML in '..\Source\HighLightXML.pas', + HighLightHTML in '..\Source\HighLightHTML.pas', + Mshtml_Ewb in '..\Source\Mshtml_Ewb.pas', + HighLightRichSyntax in '..\Source\HighLightRichSyntax.pas', + SHDocVw_EWB in '..\Source\SHDocVw_EWB.pas', + UI_Less in '..\Source\UI_Less.pas', + EwbCore in '..\Source\EwbCore.pas', + MenuContext in '..\Source\MenuContext.pas', + FavoritesPopup in '..\Source\FavoritesPopup.pas', + EwbDDE in '..\Source\EwbDDE.pas', + EwbCoreTools in '..\Source\EwbCoreTools.pas', + EwbClasses in '..\Source\EwbClasses.pas', + EwbBehaviorsComp in '..\Source\EwbBehaviorsComp.pas', + EwbEvents in '..\Source\EwbEvents.pas', + EwbEventsComp in '..\Source\EwbEventsComp.pas', + EwbActns in '..\Source\EwbActns.pas', + EwbUrl in '..\Source\EwbUrl.pas', + IEDownloadTools in '..\Source\IEDownloadTools.pas', + wbhFixes in '..\Source\wbhFixes.pas', + MSHTMLEvents in '..\Source\MSHTMLEvents.pas', + EwbControlComponent in '..\Source\EwbControlComponent.pas', + EwbMouseHook in '..\Source\EwbMouseHook.pas', + EwbFocusControl in '..\Source\EwbFocusControl.pas', + EwbLibXmlParser in '..\Source\EwbLibXmlParser.pas'; + +end. diff --git a/Source/EwbLibXmlComps.pas b/Source/EwbLibXmlComps.pas new file mode 100644 index 0000000..48bd9b0 --- /dev/null +++ b/Source/EwbLibXmlComps.pas @@ -0,0 +1,110 @@ +(** +=============================================================================================== +Name : LibXmlComps +=============================================================================================== +Project : All Projects processing XML documents +=============================================================================================== +Subject : XML parser for Delphi's VCL toolbar +=============================================================================================== +Dipl.-Ing. (FH) Stefan Heymann, Softwaresysteme, Tbingen, Germany +=============================================================================================== +Date Author Changes +----------------------------------------------------------------------------------------------- +$Id: LibXmlComps.pas,v 1.2 2006/11/15 21:01:42 sergev Exp $ +2000-03-31 HeySt 1.0.0 Start +2000-07-27 HeySt 1.0.1 Added "TAttr" declaration + Moved GetNormalize/SetNormalize to PROTECTED section +2001-02-03 HeySt Changed prototype for the TExternalEvent callback function type + so that C++Builder users should get it compiled better. + +2001-02-28 HeySt 1.0.2 Introduced the "StopParser" property. When you set this property to + TRUE in one of the Parser Events, parsing is stopped and the Execute + method returns. + Introduced Version numbers +2001-07-10 HeySt 1.0.3 Fixed a bug in TScannerXmlParser.DtdElementFound so that the + OnAttList event is correctly fired +2001-07-11 HeySt 1.1.0 Derived from the new TCustomXmlScanner class from LibXmlParser +*) + +unit EwbLibXmlComps; + +interface + +uses + Classes, + EwbLibXmlParser; + +type + TXmlScanner = class(TCustomXmlScanner) + public + property XmlParser; + property StopParser; + published + property Filename; + property Normalize; + property OnXmlProlog; + property OnComment; + property OnPI; + property OnDtdRead; + property OnStartTag; + property OnEmptyTag; + property OnEndTag; + property OnContent; + property OnCData; + property OnElement; + property OnAttList; + property OnEntity; + property OnNotation; + property OnDtdError; + property OnLoadExternal; + property OnTranslateEncoding; + end; + + // The "Easy" XML Scanner leaves out events and properties which you are unlikely to use + // for "normal" XML files. + // CDATA sections trigger "OnContent" events + TEasyXmlScanner = class(TCustomXmlScanner) + protected + procedure WhenCData(Content: string); override; + public + property XmlParser; + property StopParser; + published + property Filename; + property Normalize; + property OnComment; + property OnPI; + property OnStartTag; + property OnEmptyTag; + property OnEndTag; + property OnContent; + property OnLoadExternal; + property OnTranslateEncoding; + end; + +(* +=============================================================================================== +IMPLEMENTATION +=============================================================================================== +*) + +implementation + +(* +=============================================================================================== +TEasyXmlScanner +=============================================================================================== +*) + +procedure TEasyXmlScanner.WhenCData(Content: string); +begin + inherited WhenContent(Content); +end; + +(* +=============================================================================================== +INITIALIZATION +=============================================================================================== +*) + +end. diff --git a/Source/EwbLibXmlParser.pas b/Source/EwbLibXmlParser.pas new file mode 100644 index 0000000..7310a53 --- /dev/null +++ b/Source/EwbLibXmlParser.pas @@ -0,0 +1,2961 @@ +(** +=============================================================================================== +Name : LibXmlParser +=============================================================================================== +Project : All Projects +=============================================================================================== +Subject : Progressive XML Parser for all types of XML Files +=============================================================================================== +Author : Stefan Heymann + Eschenweg 3 + 72076 Tbingen + GERMANY + +E-Mail: stefan@destructor.de +URL: www.destructor.de +=============================================================================================== +Source, Legals ("Licence") +-------------------------- +The official site to get this parser is http://www.destructor.de/ + +Usage and Distribution of this Source Code is ruled by the +"Destructor.de Source code Licence" (DSL) which comes with this file or +can be downloaded at http://www.destructor.de/ + +IN SHORT: Usage and distribution of this source code is free. + You use it completely on your own risk. + +Postcardware +------------ +If you like this code, please send a postcard of your city to my above address. +=============================================================================================== +!!! All parts of this code which are not finished or not conforming exactly to + the XmlSpec are marked with three exclamation marks + +-!- Parts where the parser may be able to detect errors in the document's syntax are + marked with the dash-exlamation mark-dash sequence. +=============================================================================================== +Terminology: +------------ +- Start: Start of a buffer part +- Final: End (last character) of a buffer part +- DTD: Document Type Definition +- DTDc: Document Type Declaration +- XMLSpec: The current W3C XML Recommendation (version 1.0 as of 1998-02-10), Chapter No. +- Cur*: Fields concerning the "Current" part passed back by the "Scan" method +=============================================================================================== +Scanning the XML document +------------------------- +- Create TXmlParser Instance MyXml := TXmlParser.Create; +- Load XML Document MyXml.LoadFromFile (Filename); +- Start Scanning MyXml.StartScan; +- Scan Loop WHILE MyXml.Scan DO +- Test for Part Type CASE MyXml.CurPartType OF +- Handle Parts ... : ;;; +- Handle Parts ... : ;;; +- Handle Parts ... : ;;; + END; +- Destroy MyXml.Free; +=============================================================================================== +Loading the XML document +------------------------ +You can load the XML document from a file with the "LoadFromFile" method. +It is beyond the scope of this parser to perform HTTP or FTP accesses. If you want your +application to handle such requests (URLs), you can load the XML via HTTP or FTP or whatever +protocol and hand over the data buffer using the "LoadFromBuffer" or "SetBuffer" method. +"LoadFromBuffer" loads the internal buffer of TXmlParser with the given null-terminated +string, thereby creating a copy of that buffer. +"SetBuffer" just takes the pointer to another buffer, which means that the given +buffer pointer must be valid while the document is accessed via TXmlParser. +=============================================================================================== +Encodings: +---------- +This XML parser kind of "understands" the following encodings: +- UTF-8 +- ISO-8859-1 +- Windows-1252 + +Any flavor of multi-byte characters (and this includes UTF-16) is not supported. Sorry. + +Every string which has to be passed to the application passes the virtual method +"TranslateEncoding" which translates the string from the current encoding (stored in +"CurEncoding") into the encoding the application wishes to receive. +The "TranslateEncoding" method that is built into TXmlParser assumes that the application +wants to receive Windows ANSI (Windows-1252, about the same as ISO-8859-1) and is able +to convert UTF-8 and ISO-8859-1 encodings. +For other source and target encodings, you will have to override "TranslateEncoding". +=============================================================================================== +Buffer Handling +--------------- +- The document must be loaded completely into a piece of RAM +- All character positions are referenced by PAnsiChar pointers +- The TXmlParser instance can either "own" the buffer itself (then, FBufferSize is > 0) + or reference the buffer of another instance or object (then, FBuffersize is 0 and + FBuffer is not NIL) +- The Property DocBuffer passes back a pointer to the first byte of the document. If there + is no document stored (FBuffer is NIL), the DocBuffer returns a pointer to a NULL character. +=============================================================================================== +Whitespace Handling +------------------- +The TXmlParser property "PackSpaces" determines how Whitespace is returned in Text Content: +While PackSpaces is true, all leading and trailing whitespace characters are trimmed of, all +Whitespace is converted to Space #x20 characters and contiguous Whitespace characters are +compressed to one. +If the "Scan" method reports a ptContent part, the application can get the original text +with all whitespace characters by extracting the characters from "CurStart" to "CurFinal". +If the application detects an xml:space attribute, it can set "PackSpaces" accordingly or +use CurStart/CurFinal. +Please note that TXmlParser does _not_ normalize Line Breaks to single LineFeed characters +as the XmlSpec requires (XmlSpec 2.11). +The xml:space attribute is not handled by TXmlParser. This is on behalf of the application. +=============================================================================================== +Non-XML-Conforming +------------------ +TXmlParser does not conform 100 % exactly to the XmlSpec: +- UTF-16 is not supported (XmlSpec 2.2) + (Workaround: Convert UTF-16 to UTF-8 and hand the buffer over to TXmlParser) +- As the parser only works with single byte strings, all Unicode characters > 255 + can currently not be handled correctly. +- Line breaks are not normalized to single Linefeed #x0A characters (XmlSpec 2.11) + (Workaround: The Application can access the text contents on its own [CurStart, CurFinal], + thereby applying every normalization it wishes to) +- The attribute value normalization does not work exactly as defined in the + Second Edition of the XML 1.0 specification. +- See also the code parts marked with three consecutive exclamation marks. These are + parts which are not finished in the current code release. + +This list may be incomplete, so it may grow if I get to know any other points. +As work on the parser proceeds, this list may also shrink. +=============================================================================================== +Things Todo +----------- +- Introduce a new event/callback which is called when there is an unresolvable + entity or character reference +- Support Unicode +- Use Streams instead of reading the whole XML into memory +=============================================================================================== +Change History, Version numbers +------------------------------- +The Date is given in ISO Year-Month-Day (YYYY-MM-DD) order. +Versions are counted from 1.0.0 beginning with the version from 2000-03-16. +Unreleased versions don't get a version number. + +Date Author Version Changes +----------------------------------------------------------------------------------------------- +2000-03-16 HeySt 1.0.0 Start +2000-03-28 HeySt 1.0.1 Initial Publishing of TXmlParser on the destructor.de Web Site +2000-03-30 HeySt 1.0.2 TXmlParser.AnalyzeCData: Call "TranslateEncoding" for CurContent +2000-03-31 HeySt 1.0.3 Deleted the StrPosE function (was not needed anyway) +2000-04-04 HeySt 1.0.4 TDtdElementRec modified: Start/Final for all Elements; + Should be backwards compatible. + AnalyzeDtdc: Set CurPartType to ptDtdc +2000-04-23 HeySt 1.0.5 New class TObjectList. Eliminated reference to the Delphi 5 + "Contnrs" unit so LibXmlParser is Delphi 4 compatible. +2000-07-03 HeySt 1.0.6 TNvpNode: Added Constructor +2000-07-11 HeySt 1.0.7 Removed "Windows" from USES clause + Added three-exclamation-mark comments for Utf8ToAnsi/AnsiToUtf8 + Added three-exclamation-mark comments for CHR function calls +2000-07-23 HeySt 1.0.8 TXmlParser.Clear: CurAttr.Clear; EntityStack.Clear; + (This was not a bug; just defensive programming) +2000-07-29 HeySt 1.0.9 TNvpList: Added methods: Node(Index), Value(Index), Name(Index); +2000-10-07 HeySt Introduced Conditional Defines + Uses Contnrs unit and its TObjectList class again for + Delphi 5 and newer versions +2001-01-30 HeySt Introduced Version Numbering + Made LoadFromFile and LoadFromBuffer BOOLEAN functions + Introduced FileMode parameter for LoadFromFile + BugFix: TAttrList.Analyze: Must add CWhitespace to ExtractName call + Comments worked over +2001-02-28 HeySt 1.0.10 Completely worked over and tested the UTF-8 functions + Fixed a bug in TXmlParser.Scan which caused it to start over when it + was called after the end of scanning, resulting in an endless loop + TEntityStack is now a TObjectList instead of TList +2001-07-03 HeySt 1.0.11 Updated Compiler Version IFDEFs for Kylix +2001-07-11 HeySt 1.0.12 New TCustomXmlScanner component (taken over from LibXmlComps.pas) +2001-07-14 HeySt 1.0.13 Bugfix TCustomXmlScanner.FOnTranslateEncoding +2001-10-22 HeySt Don't clear CurName anymore when the parser finds a CDATA section. +2001-12-03 HeySt 1.0.14 TObjectList.Clear: Make call to INHERITED method (fixes a memory leak) +2001-12-05 HeySt 1.0.15 TObjectList.Clear: removed call to INHERITED method + TObjectList.Destroy: Inserted SetCapacity call. + Reduces need for frequent re-allocation of pointer buffer + Dedicated to my father, Theodor Heymann +2002-06-26 HeySt 1.0.16 TXmlParser.Scan: Fixed a bug with PIs whose name is beginning + with 'xml'. Thanks to Uwe Kamm for submitting this bug. + The CurEncoding property is now always in uppercase letters (the XML + spec wants it to be treated case independently so when it's uppercase + comparisons are faster) +2002-03-04 HeySt 1.0.17 Included an IFDEF for Delphi 7 (VER150) and Kylix + There is a new symbol HAS_CONTNRS_UNIT which is used now to + distinguish between IDEs which come with the Contnrs unit and + those that don't. +2009-05-17 bsalsa 1.0.18 Added D2009 support. + +*) + +// --- Delphi/Kylix Version Numbers +// As this is no code, this does not blow up your object or executable code at all + (*$IFDEF LINUX *) + (*$DEFINE K1_OR_NEWER *) + (*$ENDIF *) + + (*$IFDEF MSWINDOWS *) + (*$DEFINE D1_OR_NEWER *) + (*$IFNDEF VER80 *) + (*$DEFINE D2_OR_NEWER *) + (*$IFNDEF VER90 *) + (*$DEFINE D3_OR_NEWER *) + (*$IFNDEF VER100 *) + (*$DEFINE D4_OR_NEWER *) + (*$IFNDEF VER120 *) + (*$DEFINE D5_OR_NEWER *) + (*$IFNDEF VER130 *) + (*$IFNDEF VER140 *) + (*$IFNDEF VER150 *) + { If the compiler gets stuck here, + you are using a compiler version unknown to this code. + You will probably have to change this code accordingly. + At first, try to comment out these lines and see what will happen.} + (*$ENDIF *) + (*$ENDIF *) + (*$ENDIF *) + (*$ENDIF *) + (*$ENDIF *) + (*$ENDIF *) + (*$ENDIF *) + (*$ENDIF *) + + (*$IFDEF D5_OR_NEWER *) + (*$DEFINE HAS_CONTNRS_UNIT *) + (*$ENDIF *) + + (*$IFDEF K1_OR_NEWER *) + (*$DEFINE HAS_CONTNRS_UNIT *) + (*$ENDIF *) + +unit EwbLibXmlParser; + +{$I EWB.inc} + +interface + +uses + SysUtils, Classes, + (*$IFDEF HAS_CONTNRS_UNIT *)// The Contnrs Unit was introduced in Delphi 5 + Contnrs, + (*$ENDIF*) + Math; + +const + CVersion = '1.0.18'; // This variable will be updated for every release + // (I hope, I won't forget to do it everytime ...) + +type + TPartType = // --- Document Part Types + (ptNone, // Nothing + ptXmlProlog, // XML Prolog XmlSpec 2.8 / 4.3.1 + ptComment, // Comment XmlSpec 2.5 + ptPI, // Processing Instruction XmlSpec 2.6 + ptDtdc, // Document Type Declaration XmlSpec 2.8 + ptStartTag, // Start Tag XmlSpec 3.1 + ptEmptyTag, // Empty-Element Tag XmlSpec 3.1 + ptEndTag, // End Tag XmlSpec 3.1 + ptContent, // Text Content between Tags + ptCData); // CDATA Section XmlSpec 2.7 + + TDtdElemType = // --- DTD Elements + (deElement, // !ELEMENT declaration + deAttList, // !ATTLIST declaration + deEntity, // !ENTITY declaration + deNotation, // !NOTATION declaration + dePI, // PI in DTD + deComment, // Comment in DTD + deError); // Error found in the DTD + +type + TAttrList = class; + TEntityStack = class; + TNvpList = class; + TElemDef = class; + TElemList = class; + TEntityDef = class; + TNotationDef = class; + + TDtdElementRec = record // --- This Record is returned by the DTD parser callback function + Start, Final: PAnsiChar; // Start/End of the Element's Declaration + case ElementType: TDtdElemType of // Type of the Element + deElement, // + deAttList: (ElemDef: TElemDef); // + deEntity: (EntityDef: TEntityDef); // + deNotation: (NotationDef: TNotationDef); // + dePI: (Target: PAnsiChar; // + Content: PAnsiChar; + AttrList: TAttrList); + deError: (Pos: PAnsiChar); // Error + // deComment : ((No additional fields here)); // + end; + + TXmlParser = class // --- Internal Properties and Methods + protected + FBuffer: PAnsiChar; // NIL if there is no buffer available + FBufferSize: INTEGER; // 0 if the buffer is not owned by the Document instance + FSource: string; // Name of Source of document. Filename for Documents loaded with LoadFromFile + + FXmlVersion: string; // XML version from Document header. Default is '1.0' + FEncoding: string; // Encoding from Document header. Default is 'UTF-8' + FStandalone: BOOLEAN; // Standalone declaration from Document header. Default is 'yes' + FRootName: string; // Name of the Root Element (= DTD name) + FDtdcFinal: PAnsiChar; // Pointer to the '>' character terminating the DTD declaration + + FNormalize: BOOLEAN; // If true: Pack Whitespace and don't return empty contents + EntityStack: TEntityStack; // Entity Stack for Parameter and General Entities + FCurEncoding: string; // Current Encoding during parsing (always uppercase) + + procedure AnalyzeProlog; // Analyze XML Prolog or Text Declaration + procedure AnalyzeComment(Start: PAnsiChar; var Final: PAnsiChar); // Analyze Comments + procedure AnalyzePI(Start: PAnsiChar; var Final: PAnsiChar); // Analyze Processing Instructions (PI) + procedure AnalyzeDtdc; // Analyze Document Type Declaration + procedure AnalyzeDtdElements(Start: PAnsiChar; var Final: PAnsiChar); // Analyze DTD declarations + procedure AnalyzeTag; // Analyze Start/End/Empty-Element Tags + procedure AnalyzeCData; // Analyze CDATA Sections + procedure AnalyzeText(var IsDone: BOOLEAN); // Analyze Text Content between Tags + procedure AnalyzeElementDecl(Start: PAnsiChar; var Final: PAnsiChar); + procedure AnalyzeAttListDecl(Start: PAnsiChar; var Final: PAnsiChar); + procedure AnalyzeEntityDecl(Start: PAnsiChar; var Final: PAnsiChar); + procedure AnalyzeNotationDecl(Start: PAnsiChar; var Final: PAnsiChar); + + procedure PushPE(var Start: PAnsiChar); + procedure ReplaceCharacterEntities(var Str: string); + procedure ReplaceParameterEntities(var Str: string); + procedure ReplaceGeneralEntities(var Str: string); + + function GetDocBuffer: PAnsiChar; // Returns FBuffer or a pointer to a NUL char if Buffer is empty + + public // --- Document Properties + property XmlVersion: string read FXmlVersion; // XML version from the Document Prolog + property Encoding: string read FEncoding; // Document Encoding from Prolog + property Standalone: BOOLEAN read FStandalone; // Standalone Declaration from Prolog + property RootName: string read FRootName; // Name of the Root Element + property Normalize: BOOLEAN read FNormalize write FNormalize; // True if Content is to be normalized + property Source: string read FSource; // Name of Document Source (Filename) + property DocBuffer: PAnsiChar read GetDocBuffer; // Returns document buffer + public // --- DTD Objects + Elements: TElemList; // Elements: List of TElemDef (contains Attribute Definitions) + Entities: TNvpList; // General Entities: List of TEntityDef + ParEntities: TNvpList; // Parameter Entities: List of TEntityDef + Notations: TNvpList; // Notations: List of TNotationDef + public + constructor Create; + destructor Destroy; override; + + // --- Document Handling + function LoadFromFile(Filename: string; + FileMode: INTEGER = fmOpenRead or fmShareDenyNone): BOOLEAN; + // Loads Document from given file + function LoadFromBuffer(Buffer: PAnsiChar): BOOLEAN; // Loads Document from another buffer + procedure SetBuffer(Buffer: PAnsiChar); // References another buffer + procedure Clear; // Clear Document + + public + // --- Scanning through the document + CurPartType: TPartType; // Current Type + CurName: string; // Current Name + CurContent: string; // Current Normalized Content + CurStart: PAnsiChar; // Current First character + CurFinal: PAnsiChar; // Current Last character + CurAttr: TAttrList; // Current Attribute List + property CurEncoding: string read FCurEncoding; // Current Encoding + procedure StartScan; + function Scan: BOOLEAN; + + // --- Events / Callbacks + function LoadExternalEntity(SystemId, PublicId, + Notation: string): TXmlParser; virtual; + function TranslateEncoding(const Source: string): string; virtual; + procedure DtdElementFound(DtdElementRec: TDtdElementRec); virtual; + end; + + TValueType = // --- Attribute Value Type + (vtNormal, // Normal specified Attribute + vtImplied, // #IMPLIED attribute value + vtFixed, // #FIXED attribute value + vtDefault); // Attribute value from default value in !ATTLIST declaration + + TAttrDefault = // --- Attribute Default Type + (adDefault, // Normal default value + adRequired, // #REQUIRED attribute + adImplied, // #IMPLIED attribute + adFixed); // #FIXED attribute + + TAttrType = // --- Type of attribute + (atUnknown, // Unknown type + atCData, // Character data only + atID, // ID + atIdRef, // ID Reference + atIdRefs, // Several ID References, separated by Whitespace + atEntity, // Name of an unparsed Entity + atEntities, // Several unparsed Entity names, separated by Whitespace + atNmToken, // Name Token + atNmTokens, // Several Name Tokens, separated by Whitespace + atNotation, // A selection of Notation names (Unparsed Entity) + atEnumeration); // Enumeration + + TElemType = // --- Element content type + (etEmpty, // Element is always empty + etAny, // Element can have any mixture of PCDATA and any elements + etChildren, // Element must contain only elements + etMixed); // Mixed PCDATA and elements + + (*$IFDEF HAS_CONTNRS_UNIT *) + TObjectList = Contnrs.TObjectList; // Re-Export this identifier + (*$ELSE *) + TObjectList = class(TList) + destructor Destroy; override; + procedure Delete(Index: INTEGER); + procedure Clear; override; + end; + (*$ENDIF *) + + TNvpNode = class // Name-Value Pair Node + Name: string; + Value: string; + constructor Create(TheName: string = ''; TheValue: string = ''); + end; + + TNvpList = class(TObjectList) // Name-Value Pair List + procedure Add(Node: TNvpNode); + function Node(Name: string): TNvpNode; overload; + function Node(Index: INTEGER): TNvpNode; overload; + function Value(Name: string): string; overload; + function Value(Index: INTEGER): string; overload; + function Name(Index: INTEGER): string; + end; + + TAttr = class(TNvpNode) // Attribute of a Start-Tag or Empty-Element-Tag + ValueType: TValueType; + AttrType: TAttrType; + end; + + TAttrList = class(TNvpList) // List of Attributes + procedure Analyze(Start: PAnsiChar; var Final: PAnsiChar); + end; + + TEntityStack = class(TObjectList) // Stack where current position is stored before parsing entities + protected + Owner: TXmlParser; + public + constructor Create(TheOwner: TXmlParser); + procedure Push(LastPos: PAnsiChar); overload; + procedure Push(Instance: TObject; LastPos: PAnsiChar); overload; + function Pop: PAnsiChar; // Returns next char or NIL if EOF is reached. Frees Instance. + end; + + TAttrDef = class(TNvpNode) // Represents a '; + + // --- Name Constants for the above enumeration types + CPartType_Name: array[TPartType] of string = + ('', 'XML Prolog', 'Comment', 'PI', + 'DTD Declaration', 'Start Tag', 'Empty Tag', 'End Tag', + 'Text', 'CDATA'); + CValueType_Name: array[TValueType] of string = ('Normal', 'Implied', 'Fixed', 'Default'); + CAttrDefault_Name: array[TAttrDefault] of string = ('Default', 'Required', 'Implied', 'Fixed'); + CElemType_Name: array[TElemType] of string = ('Empty', 'Any', 'Childs only', 'Mixed'); + CAttrType_Name: array[TAttrType] of string = ('Unknown', 'CDATA', + 'ID', 'IDREF', 'IDREFS', + 'ENTITY', 'ENTITIES', + 'NMTOKEN', 'NMTOKENS', + 'Notation', 'Enumeration'); + +function ConvertWs(Source: string; PackWs: BOOLEAN): string; // Convert WS to spaces #x20 +procedure SetStringSF(var S: string; BufferStart, BufferFinal: PAnsiChar); // SetString by Start/Final of buffer +function StrSFPas(Start, Finish: PAnsiChar): string; // Convert buffer part to Pascal string +function TrimWs(Source: string): string; // Trim Whitespace + +function AnsiToUtf8(Source: ANSISTRING): string; // Convert Win-1252 to UTF-8 +function Utf8ToAnsi(Source: string; UnknownChar: AnsiChar = ''): ANSISTRING; // Convert UTF-8 to Win-1252 + +(* +=============================================================================================== +TCustomXmlScanner event based component wrapper for TXmlParser +=============================================================================================== +*) + +type + TCustomXmlScanner = class; + TXmlPrologEvent = procedure(Sender: TObject; XmlVersion, Encoding: string; Standalone: BOOLEAN) of object; + TCommentEvent = procedure(Sender: TObject; Comment: string) of object; + TPIEvent = procedure(Sender: TObject; Target, Content: string; Attributes: TAttrList) of object; + TDtdEvent = procedure(Sender: TObject; RootElementName: string) of object; + TStartTagEvent = procedure(Sender: TObject; TagName: string; Attributes: TAttrList) of object; + TEndTagEvent = procedure(Sender: TObject; TagName: string) of object; + TContentEvent = procedure(Sender: TObject; Content: string) of object; + TElementEvent = procedure(Sender: TObject; ElemDef: TElemDef) of object; + TEntityEvent = procedure(Sender: TObject; EntityDef: TEntityDef) of object; + TNotationEvent = procedure(Sender: TObject; NotationDef: TNotationDef) of object; + TErrorEvent = procedure(Sender: TObject; ErrorPos: PAnsiChar) of object; + TExternalEvent = procedure(Sender: TObject; SystemId, PublicId, NotationId: string; + var Result: TXmlParser) of object; + TEncodingEvent = function(Sender: TObject; CurrentEncoding, Source: string): string of object; + + TCustomXmlScanner = class(TComponent) + protected + FXmlParser: TXmlParser; + FOnXmlProlog: TXmlPrologEvent; + FOnComment: TCommentEvent; + FOnPI: TPIEvent; + FOnDtdRead: TDtdEvent; + FOnStartTag: TStartTagEvent; + FOnEmptyTag: TStartTagEvent; + FOnEndTag: TEndTagEvent; + FOnContent: TContentEvent; + FOnCData: TContentEvent; + FOnElement: TElementEvent; + FOnAttList: TElementEvent; + FOnEntity: TEntityEvent; + FOnNotation: TNotationEvent; + FOnDtdError: TErrorEvent; + FOnLoadExternal: TExternalEvent; + FOnTranslateEncoding: TEncodingEvent; + FStopParser: BOOLEAN; + function GetNormalize: BOOLEAN; + procedure SetNormalize(Value: BOOLEAN); + + procedure WhenXmlProlog(XmlVersion, Encoding: string; Standalone: BOOLEAN); virtual; + procedure WhenComment(Comment: string); virtual; + procedure WhenPI(Target, Content: string; Attributes: TAttrList); virtual; + procedure WhenDtdRead(RootElementName: string); virtual; + procedure WhenStartTag(TagName: string; Attributes: TAttrList); virtual; + procedure WhenEmptyTag(TagName: string; Attributes: TAttrList); virtual; + procedure WhenEndTag(TagName: string); virtual; + procedure WhenContent(Content: string); virtual; + procedure WhenCData(Content: string); virtual; + procedure WhenElement(ElemDef: TElemDef); virtual; + procedure WhenAttList(ElemDef: TElemDef); virtual; + procedure WhenEntity(EntityDef: TEntityDef); virtual; + procedure WhenNotation(NotationDef: TNotationDef); virtual; + procedure WhenDtdError(ErrorPos: PAnsiChar); virtual; + + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + procedure LoadFromFile(Filename: TFilename); // Load XML Document from file + procedure LoadFromBuffer(Buffer: PAnsiChar); // Load XML Document from buffer + procedure SetBuffer(Buffer: PAnsiChar); // Refer to Buffer + function GetFilename: TFilename; + + procedure Execute; // Perform scanning + + protected + property XmlParser: TXmlParser read FXmlParser; + property StopParser: BOOLEAN read FStopParser write FStopParser; + property Filename: TFilename read GetFilename write LoadFromFile; + property Normalize: BOOLEAN read GetNormalize write SetNormalize; + property OnXmlProlog: TXmlPrologEvent read FOnXmlProlog write FOnXmlProlog; + property OnComment: TCommentEvent read FOnComment write FOnComment; + property OnPI: TPIEvent read FOnPI write FOnPI; + property OnDtdRead: TDtdEvent read FOnDtdRead write FOnDtdRead; + property OnStartTag: TStartTagEvent read FOnStartTag write FOnStartTag; + property OnEmptyTag: TStartTagEvent read FOnEmptyTag write FOnEmptyTag; + property OnEndTag: TEndTagEvent read FOnEndTag write FOnEndTag; + property OnContent: TContentEvent read FOnContent write FOnContent; + property OnCData: TContentEvent read FOnCData write FOnCData; + property OnElement: TElementEvent read FOnElement write FOnElement; + property OnAttList: TElementEvent read FOnAttList write FOnAttList; + property OnEntity: TEntityEvent read FOnEntity write FOnEntity; + property OnNotation: TNotationEvent read FOnNotation write FOnNotation; + property OnDtdError: TErrorEvent read FOnDtdError write FOnDtdError; + property OnLoadExternal: TExternalEvent read FOnLoadExternal write FOnLoadExternal; + property OnTranslateEncoding: TEncodingEvent read FOnTranslateEncoding write FOnTranslateEncoding; + end; + +(* +=============================================================================================== +IMPLEMENTATION +=============================================================================================== +*) + +implementation + +{$IFNDEF DELPHI12_UP} +function CharInSet(C: Char; const CharSet: TSysCharSet): Boolean; +begin + Result := C in CharSet; +end; +{$ENDIF} + +(* +=============================================================================================== +Unicode and UTF-8 stuff +=============================================================================================== +*) + +const + // --- Character Translation Table for Unicode <-> Win-1252 + WIN1252_UNICODE: array[$00..$FF] of WORD = ( + $0000, $0001, $0002, $0003, $0004, $0005, $0006, $0007, $0008, $0009, + $000A, $000B, $000C, $000D, $000E, $000F, $0010, $0011, $0012, $0013, + $0014, $0015, $0016, $0017, $0018, $0019, $001A, $001B, $001C, $001D, + $001E, $001F, $0020, $0021, $0022, $0023, $0024, $0025, $0026, $0027, + $0028, $0029, $002A, $002B, $002C, $002D, $002E, $002F, $0030, $0031, + $0032, $0033, $0034, $0035, $0036, $0037, $0038, $0039, $003A, $003B, + $003C, $003D, $003E, $003F, $0040, $0041, $0042, $0043, $0044, $0045, + $0046, $0047, $0048, $0049, $004A, $004B, $004C, $004D, $004E, $004F, + $0050, $0051, $0052, $0053, $0054, $0055, $0056, $0057, $0058, $0059, + $005A, $005B, $005C, $005D, $005E, $005F, $0060, $0061, $0062, $0063, + $0064, $0065, $0066, $0067, $0068, $0069, $006A, $006B, $006C, $006D, + $006E, $006F, $0070, $0071, $0072, $0073, $0074, $0075, $0076, $0077, + $0078, $0079, $007A, $007B, $007C, $007D, $007E, $007F, + + $20AC, $0081, $201A, $0192, $201E, $2026, $2020, $2021, $02C6, $2030, + $0160, $2039, $0152, $008D, $017D, $008F, $0090, $2018, $2019, $201C, + $201D, $2022, $2013, $2014, $02DC, $2122, $0161, $203A, $0153, $009D, + $017E, $0178, $00A0, $00A1, $00A2, $00A3, $00A4, $00A5, $00A6, $00A7, + $00A8, $00A9, $00AA, $00AB, $00AC, $00AD, $00AE, $00AF, $00B0, $00B1, + $00B2, $00B3, $00B4, $00B5, $00B6, $00B7, $00B8, $00B9, $00BA, $00BB, + $00BC, $00BD, $00BE, $00BF, $00C0, $00C1, $00C2, $00C3, $00C4, $00C5, + $00C6, $00C7, $00C8, $00C9, $00CA, $00CB, $00CC, $00CD, $00CE, $00CF, + $00D0, $00D1, $00D2, $00D3, $00D4, $00D5, $00D6, $00D7, $00D8, $00D9, + $00DA, $00DB, $00DC, $00DD, $00DE, $00DF, $00E0, $00E1, $00E2, $00E3, + $00E4, $00E5, $00E6, $00E7, $00E8, $00E9, $00EA, $00EB, $00EC, $00ED, + $00EE, $00EF, $00F0, $00F1, $00F2, $00F3, $00F4, $00F5, $00F6, $00F7, + $00F8, $00F9, $00FA, $00FB, $00FC, $00FD, $00FE, $00FF); + +(* UTF-8 (somewhat simplified) + ----- + Character Range Byte sequence + --------------- -------------------------- (x=Bits from original character) + $0000..$007F 0xxxxxxx + $0080..$07FF 110xxxxx 10xxxxxx + $8000..$FFFF 1110xxxx 10xxxxxx 10xxxxxx + + Example + -------- + Transforming the Unicode character U+00E4 LATIN SMALL LETTER A WITH DIAERESIS (""): + + ISO-8859-1, Decimal 228 + Win1252, Hex $E4 + ANSI Bin 1110 0100 + abcd efgh + + UTF-8 Binary 1100xxab 10cdefgh + Binary 11000011 10100100 + Hex $C3 $A4 + Decimal 195 164 + ANSI *) + + +function StringToPAnsiChar(inString: string): PAnsiChar; +var + AnsString: AnsiString; + InternalError: Boolean; +begin + InternalError := False; + Result := ''; + try + if inString <> EmptyStr then + begin + AnsString := AnsiString(inString); + Result := PAnsiChar(PAnsiString(AnsString)); + end; + except + InternalError := True; + end; + if InternalError or (string(Result) <> inString) then + begin + raise Exception.Create('Conversion from string to PAnsiChar failed!'); + end; +end; + +function AnsiToUtf8(Source: ANSISTRING): string; + (* Converts the given Windows ANSI (Win1252) String to UTF-8. *) +var + I: INTEGER; // Loop counter + U: WORD; // Current Unicode value + Len: INTEGER; // Current real length of "Result" string +begin + SetLength(Result, Length(Source) * 3); // Worst case + Len := 0; + for I := 1 to Length(Source) do + begin + U := WIN1252_UNICODE[ORD(Source[I])]; + case U of + $0000..$007F: + begin + INC(Len); + Result[Len] := CHR(U); + end; + $0080..$07FF: + begin + INC(Len); + Result[Len] := CHR($C0 or (U shr 6)); + INC(Len); + Result[Len] := CHR($80 or (U and $3F)); + end; + $0800..$FFFF: + begin + INC(Len); + Result[Len] := CHR($E0 or (U shr 12)); + INC(Len); + Result[Len] := CHR($80 or ((U shr 6) and $3F)); + INC(Len); + Result[Len] := CHR($80 or (U and $3F)); + end; + end; + end; + SetLength(Result, Len); +end; + +function Utf8ToAnsi(Source: string; UnknownChar: AnsiChar = ''): ANSISTRING; + (* Converts the given UTF-8 String to Windows ANSI (Win-1252). + If a character can not be converted, the "UnknownChar" is inserted. *) +var + SourceLen: INTEGER; // Length of Source string + I, K: INTEGER; + A: BYTE; // Current ANSI character value + U: WORD; + Ch: AnsiChar; // Dest char + Len: INTEGER; // Current real length of "Result" string +begin + SourceLen := Length(Source); + SetLength(Result, SourceLen); // Enough room to live + Len := 0; + I := 1; + while I <= SourceLen do + begin + A := ORD(Source[I]); + if A < $80 then + begin // Range $0000..$007F + INC(Len); + Result[Len] := AnsiChar(Source[I]); + INC(I); + end + else + begin // Determine U, Inc I + if (A and $E0 = $C0) and (I < SourceLen) then + begin // Range $0080..$07FF + U := (WORD(A and $1F) shl 6) or (ORD(Source[I + 1]) and $3F); + INC(I, 2); + end + else + if (A and $F0 = $E0) and (I < SourceLen - 1) then + begin // Range $0800..$FFFF + U := (WORD(A and $0F) shl 12) or + (WORD(ORD(Source[I + 1]) and $3F) shl 6) or + (ORD(Source[I + 2]) and $3F); + INC(I, 3); + end + else + begin // Unknown/unsupported + INC(I); + for K := 7 downto 0 do + if A and (1 shl K) = 0 then + begin + INC(I, (A shr (K + 1)) - 1); + BREAK; + end; + U := WIN1252_UNICODE[ORD(UnknownChar)]; + end; + Ch := UnknownChar; // Retrieve ANSI char + for A := $00 to $FF do + if WIN1252_UNICODE[A] = U then + begin + Ch := AnsiChar(CHR(A)); + BREAK; + end; + INC(Len); + Result[Len] := AnsiChar(Ch); + end; + end; + SetLength(Result, Len); +end; + +(* +=============================================================================================== +"Special" Helper Functions + +Don't ask me why. But including these functions makes the parser *DRAMATICALLY* faster +on my K6-233 machine. You can test it yourself just by commenting them out. +They do exactly the same as the Assembler routines defined in SysUtils. +(This is where you can see how great the Delphi compiler really is. The compiled code is +faster than hand-coded assembler!) +=============================================================================================== +--> Just move this line below the StrScan function --> *) + +function StrPos(const Str, SearchStr: PAnsiChar): PAnsiChar; + // Same functionality as SysUtils.StrPos +var + First: AnsiChar; + Len: INTEGER; +begin + First := AnsiChar(SearchStr^); + Len := StrLen(SearchStr); + Result := Str; + repeat + if AnsiChar(Result^) = First then + if StrLComp(Result, SearchStr, Len) = 0 then + BREAK; + if Result^ = #0 then + begin + Result := nil; + BREAK; + end; + INC(Result); + until FALSE; +end; + +function StrScan(const Start: PAnsiChar; const Ch: AnsiChar): PAnsiChar; + // Same functionality as SysUtils.StrScan +begin + Result := Start; + while AnsiChar(Result^) <> Ch do + begin + if Result^ = #0 then + begin + Result := nil; + EXIT; + end; + INC(Result); + end; +end; + +(* +=============================================================================================== +Helper Functions +=============================================================================================== +*) + +function DelChars(Source: string; CharsToDelete: TCharset): string; + // Delete all "CharsToDelete" from the string +var + I: INTEGER; +begin + Result := Source; + for I := Length(Result) downto 1 do + if CharInSet(Result[I], CharsToDelete) then + Delete(Result, I, 1); +end; + +function TrimWs(Source: string): string; + // Trimms off Whitespace characters from both ends of the string +var + I: INTEGER; +begin + // --- Trim Left + I := 1; + while (I <= Length(Source)) and (CharInSet(Source[I], CWhitespace)) do + INC(I); + Result := Copy(Source, I, MaxInt); + + // --- Trim Right + I := Length(Result); + while (I > 1) and (CharInSet(Result[I], CWhitespace)) do + DEC(I); + Delete(Result, I + 1, Length(Result) - I); +end; + +function ConvertWs(Source: string; PackWs: BOOLEAN): string; + // Converts all Whitespace characters to the Space #x20 character + // If "PackWs" is true, contiguous Whitespace characters are packed to one +var + I: INTEGER; +begin + Result := Source; + for I := Length(Result) downto 1 do + if (CharInSet(Result[I], CWhitespace)) then + if PackWs and (I > 1) and (CharInSet(Result[I - 1], CWhitespace)) + then + Delete(Result, I, 1) + else + Result[I] := #32; +end; + +procedure SetStringSF(var S: string; BufferStart, BufferFinal: PAnsiChar); +begin + SetString(S, BufferStart, BufferFinal - BufferStart + 1); +end; + +function StrLPas(Start: PAnsiChar; Len: INTEGER): string; +begin + SetString(Result, Start, Len); +end; + +function StrSFPas(Start, Finish: PAnsiChar): string; +begin + SetString(Result, Start, Finish - Start + 1); +end; + +function StrScanE(const Source: PAnsiChar; const CharToScanFor: AnsiChar): PAnsiChar; + // If "CharToScanFor" is not found, StrScanE returns the last char of the + // buffer instead of NIL +begin + Result := StrScan(Source, CharToScanFor); + if Result = nil then + Result := StrEnd(Source) - 1; +end; + +procedure ExtractName(Start: PAnsiChar; Terminators: TCharset; var Final: PAnsiChar); + (* Extracts the complete Name beginning at "Start". + It is assumed that the name is contained in Markup, so the '>' character is + always a Termination. + Start: IN Pointer to first char of name. Is always considered to be valid + Terminators: IN Characters which terminate the name + Final: OUT Pointer to last char of name *) +begin + Final := Start + 1; + Include(Terminators, #0); + Include(Terminators, '>'); + while not (CharInSet(Final^, Terminators)) do + INC(Final); + DEC(Final); +end; + +procedure ExtractQuote(Start: PAnsiChar; var Content: string; var Final: PAnsiChar); + (* Extract a string which is contained in single or double Quotes. + Start: IN Pointer to opening quote + Content: OUT The quoted string + Final: OUT Pointer to closing quote *) +begin + Final := StrScan(Start + 1, AnsiChar(Start^)); + if Final = nil then + begin + Final := StrEnd(Start + 1) - 1; + SetString(Content, Start + 1, Final - Start); + end + else + SetString(Content, Start + 1, Final - 1 - Start); +end; + +(* +=============================================================================================== +TEntityStackNode +This Node is pushed to the "Entity Stack" whenever the parser parses entity replacement text. +The "Instance" field holds the Instance pointer of an External Entity buffer. When it is +popped, the Instance is freed. +The "Encoding" field holds the name of the Encoding. External Parsed Entities may have +another encoding as the document entity (XmlSpec 4.3.3). So when there is an " 0 then + begin + ESN := TEntityStackNode(Items[Count - 1]); + Result := ESN.LastPos; + if ESN.Instance <> nil then + ESN.Instance.Free; + if ESN.Encoding <> '' then + Owner.FCurEncoding := ESN.Encoding; // Restore current Encoding + Delete(Count - 1); + end + else + Result := nil; +end; + +(* +=============================================================================================== +TExternalID +----------- +XmlSpec 4.2.2: ExternalID ::= 'SYSTEM' S SystemLiteral | + 'PUBLIC' S PubidLiteral S SystemLiteral +XmlSpec 4.7: PublicID ::= 'PUBLIC' S PubidLiteral +SystemLiteral and PubidLiteral are quoted +=============================================================================================== +*) + +type + TExternalID = class + PublicId: string; + SystemId: string; + Final: PAnsiChar; + constructor Create(Start: PAnsiChar); + end; + +constructor TExternalID.Create(Start: PAnsiChar); +begin + inherited Create; + Final := Start; + if StrLComp(Start, 'SYSTEM', 6) = 0 then + begin + while not (CharInSet(Final^, (CQuoteChar + [#0, '>', '[']))) do + INC(Final); + if not (CharInSet(Final^, CQuoteChar)) then + EXIT; + ExtractQuote(Final, SystemID, Final); + end + else + if StrLComp(Start, 'PUBLIC', 6) = 0 then + begin + while not (CharInSet(Final^, (CQuoteChar + [#0, '>', '[']))) do + INC(Final); + if not (CharInSet(Final^, CQuoteChar)) then + EXIT; + ExtractQuote(Final, PublicID, Final); + INC(Final); + while not (CharInSet(Final^, (CQuoteChar + [#0, '>', '[']))) do + INC(Final); + if not (CharInSet(Final^, CQuoteChar)) then + EXIT; + ExtractQuote(Final, SystemID, Final); + end; +end; + +(* +=============================================================================================== +TXmlParser +=============================================================================================== +*) + +constructor TXmlParser.Create; +begin + inherited Create; + FBuffer := nil; + FBufferSize := 0; + Elements := TElemList.Create; + Entities := TNvpList.Create; + ParEntities := TNvpList.Create; + Notations := TNvpList.Create; + CurAttr := TAttrList.Create; + EntityStack := TEntityStack.Create(Self); + Clear; +end; + +destructor TXmlParser.Destroy; +begin + Clear; + Elements.Free; + Entities.Free; + ParEntities.Free; + Notations.Free; + CurAttr.Free; + EntityStack.Free; + inherited Destroy; +end; + +procedure TXmlParser.Clear; + // Free Buffer and clear all object attributes +begin + if (FBufferSize > 0) and (FBuffer <> nil) then + FreeMem(FBuffer); + FBuffer := nil; + FBufferSize := 0; + FSource := ''; + FXmlVersion := ''; + FEncoding := ''; + FStandalone := FALSE; + FRootName := ''; + FDtdcFinal := nil; + FNormalize := TRUE; + Elements.Clear; + Entities.Clear; + ParEntities.Clear; + Notations.Clear; + CurAttr.Clear; + EntityStack.Clear; +end; + +function TXmlParser.LoadFromFile(Filename: string; FileMode: INTEGER = fmOpenRead or fmShareDenyNone): BOOLEAN; + // Loads Document from given file + // Returns TRUE if successful +var + f: file; + ReadIn: INTEGER; + OldFileMode: INTEGER; +begin + Result := FALSE; + Clear; + + // --- Open File + OldFileMode := SYSTEM.FileMode; + try + SYSTEM.FileMode := FileMode; + try + AssignFile(f, Filename); + Reset(f, 1); + except + EXIT; + end; + + try + // --- Allocate Memory + try + FBufferSize := Filesize(f) + 1; + GetMem(FBuffer, FBufferSize); + except + Clear; + EXIT; + end; + + // --- Read File + try + BlockRead(f, FBuffer^, FBufferSize, ReadIn); + (FBuffer + ReadIn)^ := #0; // NULL termination + except + Clear; + EXIT; + end; + finally + CloseFile(f); + end; + + FSource := Filename; + Result := TRUE; + + finally + SYSTEM.FileMode := OldFileMode; + end; +end; + +function TXmlParser.LoadFromBuffer(Buffer: PAnsiChar): BOOLEAN; + // Loads Document from another buffer + // Returns TRUE if successful + // The "Source" property becomes '' if successful +begin + Result := FALSE; + Clear; + FBufferSize := StrLen(Buffer) + 1; + try + GetMem(FBuffer, FBufferSize); + except + Clear; + EXIT; + end; + StrCopy(FBuffer, Buffer); + FSource := ''; + Result := TRUE; +end; + +procedure TXmlParser.SetBuffer(Buffer: PAnsiChar); // References another buffer +begin + Clear; + FBuffer := Buffer; + FBufferSize := 0; + FSource := ''; +end; + +//----------------------------------------------------------------------------------------------- +// Scanning through the document +//----------------------------------------------------------------------------------------------- + +procedure TXmlParser.StartScan; +begin + CurPartType := ptNone; + CurName := ''; + CurContent := ''; + CurStart := nil; + CurFinal := nil; + CurAttr.Clear; + EntityStack.Clear; +end; + +function TXmlParser.Scan: BOOLEAN; + // Scans the next Part + // Returns TRUE if a part could be found, FALSE if there is no part any more + // + // "IsDone" can be set to FALSE by AnalyzeText in order to go to the next part + // if there is no Content due to normalization +var + IsDone: BOOLEAN; +begin + repeat + IsDone := TRUE; + + // --- Start of next Part + if CurStart = nil + then + CurStart := DocBuffer + else + CurStart := CurFinal + 1; + CurFinal := CurStart; + // --- End of Document of Pop off a new part from the Entity stack? + if CurStart^ = #0 then + CurStart := EntityStack.Pop; + + // --- No Document or End Of Document: Terminate Scan + if (CurStart = nil) or (CurStart^ = #0) then + begin + CurStart := StrEnd(DocBuffer); + CurFinal := CurStart - 1; + EntityStack.Clear; + Result := FALSE; + EXIT; + end; + + if (StrLComp(CurStart, ''); + if CurFinal <> nil + then + INC(CurFinal) + else + CurFinal := StrEnd(CurStart) - 1; + FCurEncoding := AnsiUpperCase(CurAttr.Value('encoding')); + if FCurEncoding = '' then + FCurEncoding := 'UTF-8'; // Default XML Encoding is UTF-8 + CurPartType := ptXmlProlog; + CurName := ''; + CurContent := ''; +end; + +procedure TXmlParser.AnalyzeComment(Start: PAnsiChar; var Final: PAnsiChar); + // Analyze Comments +begin + Final := StrPos(Start + 4, '-->'); + if Final = nil + then + Final := StrEnd(Start) - 1 + else + INC(Final, 2); + CurPartType := ptComment; +end; + +procedure TXmlParser.AnalyzePI(Start: PAnsiChar; var Final: PAnsiChar); + // Analyze Processing Instructions (PI) + // This is also called for Character +var + F: PAnsiChar; +begin + CurPartType := ptPI; + Final := StrPos(Start + 2, '?>'); + if Final = nil + then + Final := StrEnd(Start) - 1 + else + INC(Final); + ExtractName(Start + 2, CWhitespace + ['?', '>'], F); + SetStringSF(CurName, Start + 2, F); + SetStringSF(CurContent, F + 1, Final - 2); + CurAttr.Analyze(F + 1, F); +end; + +procedure TXmlParser.AnalyzeDtdc; + (* Analyze Document Type Declaration + doctypedecl ::= '' + markupdecl ::= elementdecl | AttlistDecl | EntityDecl | NotationDecl | PI | Comment + PEReference ::= '%' Name ';' + + elementdecl ::= '' + AttlistDecl ::= '' + EntityDecl ::= '' | + '' + NotationDecl ::= '' + PI ::= '' Char* )))? '?>' + Comment ::= '' *) +type + TPhase = (phName, phDtd, phInternal, phFinishing); +var + Phase: TPhase; + F: PAnsiChar; + ExternalID: TExternalID; + ExternalDTD: TXmlParser; + DER: TDtdElementRec; +begin + DER.Start := CurStart; + EntityStack.Clear; // Clear stack for Parameter Entities + CurPartType := ptDtdc; + + // --- Don't read DTDc twice + if FDtdcFinal <> nil then + begin + CurFinal := FDtdcFinal; + EXIT; + end; + + // --- Scan DTDc + CurFinal := CurStart + 9; // First char after '': BREAK; + else + if not (CharInSet(CurFinal^, CWhitespace)) then + begin + case Phase of + phName: + if (CharInSet(CurFinal^, CNameStart)) then + begin + ExtractName(CurFinal, CWhitespace + ['[', '>'], F); + SetStringSF(FRootName, CurFinal, F); + CurFinal := F; + Phase := phDtd; + end; + phDtd: + if (StrLComp(CurFinal, 'SYSTEM', 6) = 0) or + (StrLComp(CurFinal, 'PUBLIC', 6) = 0) then + begin + ExternalID := TExternalID.Create(CurFinal); + ExternalDTD := LoadExternalEntity(ExternalId.SystemId, ExternalID.PublicId, ''); + F := StrPos(ExternalDtd.DocBuffer, ' nil then + AnalyzeDtdElements(F, F); + ExternalDTD.Free; + CurFinal := ExternalID.Final; + ExternalID.Free; + end; + else + begin + DER.ElementType := deError; + DER.Pos := CurFinal; + DER.Final := CurFinal; + DtdElementFound(DER); + end; + end; + + end; + end; + INC(CurFinal); + until FALSE; + + CurPartType := ptDtdc; + CurName := ''; + CurContent := ''; + + // It is an error in the document if "EntityStack" is not empty now + if EntityStack.Count > 0 then + begin + DER.ElementType := deError; + DER.Final := CurFinal; + DER.Pos := CurFinal; + DtdElementFound(DER); + end; + + EntityStack.Clear; // Clear stack for General Entities + FDtdcFinal := CurFinal; +end; + +procedure TXmlParser.AnalyzeDtdElements(Start: PAnsiChar; var Final: PAnsiChar); + // Analyze the "Elements" of a DTD contained in the external or + // internal DTD subset. +var + DER: TDtdElementRec; +begin + Final := Start; + repeat + case Final^ of + '%': + begin + PushPE(Final); + CONTINUE; + end; + #0: + if EntityStack.Count = 0 then + BREAK + else + begin + CurFinal := EntityStack.Pop; + CONTINUE; + end; + ']', + '>': BREAK; + '<': + if StrLComp(Final, ''); + + // --- Set Default Attribute values for nonexistent attributes + if (CurPartType = ptStartTag) or (CurPartType = ptEmptyTag) then + begin + ElemDef := Elements.Node(CurName); + if ElemDef <> nil then + begin + for I := 0 to ElemDef.Count - 1 do + begin + AttrDef := TAttrDef(ElemDef[I]); + Attr := TAttr(CurAttr.Node(AttrDef.Name)); + if (Attr = nil) and (AttrDef.Value <> '') then + begin + Attr := TAttr.Create(AttrDef.Name, AttrDef.Value); + Attr.ValueType := vtDefault; + CurAttr.Add(Attr); + end; + if Attr <> nil then + begin + case AttrDef.DefaultType of + adDefault: ; + adRequired: ; // -!- It is an error in the document if "Attr.Value" is an empty string + adImplied: Attr.ValueType := vtImplied; + adFixed: + begin + Attr.ValueType := vtFixed; + Attr.Value := AttrDef.Value; + end; + end; + Attr.AttrType := AttrDef.AttrType; + end; + end; + end; + + // --- Normalize Attribute Values. XmlSpec: + // - a character reference is processed by appending the referenced character to the attribute value + // - an entity reference is processed by recursively processing the replacement text of the entity + // - a whitespace character (#x20, #xD, #xA, #x9) is processed by appending #x20 to the normalized value, + // except that only a single #x20 is appended for a "#xD#xA" sequence that is part of an external + // parsed entity or the literal entity value of an internal parsed entity + // - other characters are processed by appending them to the normalized value + // If the declared value is not CDATA, then the XML processor must further process the + // normalized attribute value by discarding any leading and trailing space (#x20) characters, + // and by replacing sequences of space (#x20) characters by a single space (#x20) character. + // All attributes for which no declaration has been read should be treated by a + // non-validating parser as if declared CDATA. + // !!! The XML 1.0 SE specification is somewhat different here + // This code does not conform exactly to this specification + for I := 0 to CurAttr.Count - 1 do + with TAttr(CurAttr[I]) do + begin + ReplaceGeneralEntities(Value); + ReplaceCharacterEntities(Value); + if (AttrType <> atCData) and (AttrType <> atUnknown) + then + Value := TranslateEncoding(TrimWs(ConvertWs(Value, TRUE))) + else + Value := TranslateEncoding(ConvertWs(Value, FALSE)); + end; + end; +end; + +procedure TXmlParser.AnalyzeCData; + // Analyze CDATA Sections +begin + CurPartType := ptCData; + CurFinal := StrPos(CurStart, CDEnd); + if CurFinal = nil then + begin + CurFinal := StrEnd(CurStart) - 1; + CurContent := TranslateEncoding(string(StrPas(CurStart + Length(CDStart)))); + end + else + begin + SetStringSF(CurContent, CurStart + Length(CDStart), CurFinal - 1); + INC(CurFinal, Length(CDEnd) - 1); + CurContent := TranslateEncoding(CurContent); + end; +end; + +procedure TXmlParser.AnalyzeText(var IsDone: BOOLEAN); + (* Analyzes Text Content between Tags. CurFinal will point to the last content character. + Content ends at a '<' character or at the end of the document. + Entity References and Character Entity references are resolved. + If PackSpaces is TRUE, contiguous Whitespace Characters will be compressed to + one Space #x20 character, Whitespace at the beginning and end of content will + be trimmed off and content which is or becomes empty is not returned to + the application (in this case, "IsDone" is set to FALSE which causes the + Scan method to proceed directly to the next part. *) + + procedure ProcessEntity; + (* Is called if there is an ampsersand '&' character found in the document. + IN "CurFinal" points to the ampersand + OUT "CurFinal" points to the first character after the semi-colon ';' *) + var + P: PAnsiChar; + Name: string; + EntityDef: TEntityDef; + ExternalEntity: TXmlParser; + begin + P := StrScan(CurFinal, ';'); + if P <> nil then + begin + SetStringSF(Name, CurFinal + 1, P - 1); + + // Is it a Character Entity? + if (CurFinal + 1)^ = '#' then + begin + if UpCase((CurFinal + 2)^) = 'X' // !!! Can't use "CHR" for Unicode characters > 255: + then + CurContent := CurContent + CHR(StrToIntDef('$' + Copy(Name, 3, MaxInt), 32)) + else + CurContent := CurContent + CHR(StrToIntDef(Copy(Name, 2, MaxInt), 32)); + CurFinal := P + 1; + EXIT; + end + + // Is it a Predefined Entity? + else + if Name = 'lt' then + begin + CurContent := CurContent + '<'; + CurFinal := P + 1; + EXIT; + end + else + if Name = 'gt' then + begin + CurContent := CurContent + '>'; + CurFinal := P + 1; + EXIT; + end + else + if Name = 'amp' then + begin + CurContent := CurContent + '&'; + CurFinal := P + 1; + EXIT; + end + else + if Name = 'apos' then + begin + CurContent := CurContent + ''''; + CurFinal := P + 1; + EXIT; + end + else + if Name = 'quot' then + begin + CurContent := CurContent + '"'; + CurFinal := P + 1; + EXIT; + end; + + // Replace with Entity from DTD + EntityDef := TEntityDef(Entities.Node(Name)); + if EntityDef <> nil then + begin + if EntityDef.Value <> '' then + begin + EntityStack.Push(P + 1); + CurFinal := StringToPAnsiChar(EntityDef.Value); + end + else + begin + ExternalEntity := LoadExternalEntity(EntityDef.SystemId, EntityDef.PublicId, EntityDef.NotationName); + EntityStack.Push(ExternalEntity, P + 1); + CurFinal := ExternalEntity.DocBuffer; + end; + end + else + begin + CurContent := CurContent + Name; + CurFinal := P + 1; + end; + end + else + begin + INC(CurFinal); + end; + end; + +var + C: INTEGER; +begin + CurFinal := CurStart; + CurPartType := ptContent; + CurContent := ''; + C := 0; + repeat + case CurFinal^ of + '&': + begin + CurContent := CurContent + TranslateEncoding(StrLPas(CurFinal - C, C)); + C := 0; + ProcessEntity; + CONTINUE; + end; + #0: + begin + if EntityStack.Count = 0 then + BREAK + else + begin + CurContent := CurContent + TranslateEncoding(StrLPas(CurFinal - C, C)); + C := 0; + CurFinal := EntityStack.Pop; + CONTINUE; + end; + end; + '<': BREAK; + else + INC(C); + end; + INC(CurFinal); + until FALSE; + CurContent := CurContent + TranslateEncoding(StrLPas(CurFinal - C, C)); + DEC(CurFinal); + + if FNormalize then + begin + CurContent := ConvertWs(TrimWs(CurContent), TRUE); + IsDone := CurContent <> ''; // IsDone will only get FALSE if PackSpaces is TRUE + end; +end; + +procedure TXmlParser.AnalyzeElementDecl(Start: PAnsiChar; var Final: PAnsiChar); + (* Parse ' character + XmlSpec 3.2: + elementdecl ::= '' + contentspec ::= 'EMPTY' | 'ANY' | Mixed | children + Mixed ::= '(' S? '#PCDATA' (S? '|' S? Name)* S? ')*' | + '(' S? '#PCDATA' S? ')' + children ::= (choice | seq) ('?' | '*' | '+')? + choice ::= '(' S? cp ( S? '|' S? cp )* S? ')' + cp ::= (Name | choice | seq) ('?' | '*' | '+')? + seq ::= '(' S? cp ( S? ',' S? cp )* S? ')' + + More simply: + contentspec ::= EMPTY + ANY + '(#PCDATA)' + '(#PCDATA | A | B)*' + '(A, B, C)' + '(A | B | C)' + '(A?, B*, C+), + '(A, (B | C | D)* )' *) +var + Element: TElemDef; + Elem2: TElemDef; + F: PAnsiChar; + DER: TDtdElementRec; +begin + Element := TElemDef.Create; + Final := Start + 9; + DER.Start := Start; + repeat + if Final^ = '>' then + BREAK; + if (CharInSet(Final^, CNameStart)) and (Element.Name = '') then + begin + ExtractName(Final, CWhitespace, F); + SetStringSF(Element.Name, Final, F); + Final := F; + F := StrScan(Final + 1, '>'); + if F = nil then + begin + Element.Definition := string(Final); + Final := StrEnd(Final); + BREAK; + end + else + begin + SetStringSF(Element.Definition, Final + 1, F - 1); + Final := F; + BREAK; + end; + end; + INC(Final); + until FALSE; + Element.Definition := DelChars(Element.Definition, CWhitespace); + ReplaceParameterEntities(Element.Definition); + if Element.Definition = 'EMPTY' then + Element.ElemType := etEmpty + else + if Element.Definition = 'ANY' then + Element.ElemType := etAny + else + if Copy(Element.Definition, 1, 8) = '(#PCDATA' then + Element.ElemType := etMixed + else + if Copy(Element.Definition, 1, 1) = '(' then + Element.ElemType := etChildren + else + Element.ElemType := etAny; + + Elem2 := Elements.Node(Element.Name); + if Elem2 <> nil then + Elements.Delete(Elements.IndexOf(Elem2)); + Elements.Add(Element); + Final := StrScanE(Final, '>'); + DER.ElementType := deElement; + DER.ElemDef := Element; + DER.Final := Final; + DtdElementFound(DER); +end; + +procedure TXmlParser.AnalyzeAttListDecl(Start: PAnsiChar; var Final: PAnsiChar); + (* Parse ' character + XmlSpec 3.3: + AttlistDecl ::= '' + AttDef ::= S Name S AttType S DefaultDecl + AttType ::= StringType | TokenizedType | EnumeratedType + StringType ::= 'CDATA' + TokenizedType ::= 'ID' | 'IDREF' | 'IDREFS' | 'ENTITY' | 'ENTITIES' | 'NMTOKEN' | 'NMTOKENS' + EnumeratedType ::= NotationType | Enumeration + NotationType ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')' + Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')' + DefaultDecl ::= '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue) + AttValue ::= '"' ([^<&"] | Reference)* '"' | "'" ([^<&'] | Reference)* "'" + Examples: + *) +type + TPhase = (phElementName, phName, phType, phNotationContent, phDefault); +var + Phase: TPhase; + F: PAnsiChar; + ElementName: string; + ElemDef: TElemDef; + AttrDef: TAttrDef; + AttrDef2: TAttrDef; + Strg: string; + DER: TDtdElementRec; +begin + Final := Start + 9; // The character after ': BREAK; + else + case Phase of + phElementName: + begin + ExtractName(Final, CWhitespace + CQuoteChar + ['#'], F); + SetStringSF(ElementName, Final, F); + Final := F; + ElemDef := Elements.Node(ElementName); + if ElemDef = nil then + begin + ElemDef := TElemDef.Create; + ElemDef.Name := ElementName; + ElemDef.Definition := 'ANY'; + ElemDef.ElemType := etAny; + Elements.Add(ElemDef); + end; + Phase := phName; + end; + phName: + begin + AttrDef := TAttrDef.Create; + ExtractName(Final, CWhitespace + CQuoteChar + ['#'], F); + SetStringSF(AttrDef.Name, Final, F); + Final := F; + AttrDef2 := TAttrDef(ElemDef.Node(AttrDef.Name)); + if AttrDef2 <> nil then + ElemDef.Delete(ElemDef.IndexOf(AttrDef2)); + ElemDef.Add(AttrDef); + Phase := phType; + end; + phType: + begin + if Final^ = '(' then + begin + F := StrScan(Final + 1, ')'); + if F <> nil + then + SetStringSF(AttrDef.TypeDef, Final + 1, F - 1) + else + AttrDef.TypeDef := string(Final + 1); + AttrDef.TypeDef := DelChars(AttrDef.TypeDef, CWhitespace); + AttrDef.AttrType := atEnumeration; + ReplaceParameterEntities(AttrDef.TypeDef); + ReplaceCharacterEntities(AttrDef.TypeDef); + Phase := phDefault; + end + else + if StrLComp(Final, 'NOTATION', 8) = 0 then + begin + INC(Final, 8); + AttrDef.AttrType := atNotation; + Phase := phNotationContent; + end + else + begin + ExtractName(Final, CWhitespace + CQuoteChar + ['#'], F); + SetStringSF(AttrDef.TypeDef, Final, F); + if AttrDef.TypeDef = 'CDATA' then + AttrDef.AttrType := atCData + else + if AttrDef.TypeDef = 'ID' then + AttrDef.AttrType := atId + else + if AttrDef.TypeDef = 'IDREF' then + AttrDef.AttrType := atIdRef + else + if AttrDef.TypeDef = 'IDREFS' then + AttrDef.AttrType := atIdRefs + else + if AttrDef.TypeDef = 'ENTITY' then + AttrDef.AttrType := atEntity + else + if AttrDef.TypeDef = 'ENTITIES' then + AttrDef.AttrType := atEntities + else + if AttrDef.TypeDef = 'NMTOKEN' then + AttrDef.AttrType := atNmToken + else + if AttrDef.TypeDef = 'NMTOKENS' then + AttrDef.AttrType := atNmTokens; + Phase := phDefault; + end + end; + phNotationContent: + begin + F := StrScan(Final, ')'); + if F <> nil then + SetStringSF(AttrDef.Notations, Final + 1, F - 1) + else + begin + AttrDef.Notations := string(Final + 1); + Final := StrEnd(Final); + end; + ReplaceParameterEntities(AttrDef.Notations); + AttrDef.Notations := DelChars(AttrDef.Notations, CWhitespace); + Phase := phDefault; + end; + phDefault: + begin + if Final^ = '#' then + begin + ExtractName(Final, CWhiteSpace + CQuoteChar, F); + SetStringSF(Strg, Final, F); + Final := F; + ReplaceParameterEntities(Strg); + if Strg = '#REQUIRED' then + begin + AttrDef.DefaultType := adRequired; + Phase := phName; + end + else + if Strg = '#IMPLIED' then + begin + AttrDef.DefaultType := adImplied; + Phase := phName; + end + else + if Strg = '#FIXED' then + AttrDef.DefaultType := adFixed; + end + else + if (CharInSet(Final^, CQuoteChar)) then + begin + ExtractQuote(Final, AttrDef.Value, Final); + ReplaceParameterEntities(AttrDef.Value); + ReplaceCharacterEntities(AttrDef.Value); + Phase := phName; + end; + if Phase = phName then + begin + AttrDef := nil; + end; + end; + + end; + end; + INC(Final); + until FALSE; + + Final := StrScan(Final, '>'); + + DER.ElementType := deAttList; + DER.ElemDef := ElemDef; + DER.Final := Final; + DtdElementFound(DER); +end; + +procedure TXmlParser.AnalyzeEntityDecl(Start: PAnsiChar; var Final: PAnsiChar); + (* Parse ' character + XmlSpec 4.2: + EntityDecl ::= '' | + '' + EntityDef ::= EntityValue | (ExternalID NDataDecl?) + PEDef ::= EntityValue | ExternalID + NDataDecl ::= S 'NDATA' S Name + EntityValue ::= '"' ([^%&"] | PEReference | EntityRef | CharRef)* '"' | + "'" ([^%&'] | PEReference | EntityRef | CharRef)* "'" + PEReference ::= '%' Name ';' + + Examples + + + + "> + + + Dies ist ein Test-Absatz

"> + *) +type + TPhase = (phName, phContent, phNData, phNotationName, phFinalGT); +var + Phase: TPhase; + IsParamEntity: BOOLEAN; + F: PAnsiChar; + ExternalID: TExternalID; + EntityDef: TEntityDef; + EntityDef2: TEntityDef; + DER: TDtdElementRec; +begin + Final := Start + 8; // First char after ': BREAK; + else + case Phase of + phName: + if CharInSet(Final^, CNameStart) then + begin + ExtractName(Final, CWhitespace + CQuoteChar, F); + SetStringSF(EntityDef.Name, Final, F); + Final := F; + Phase := phContent; + end; + phContent: + if CharInSet(Final^, CQuoteChar) then + begin + ExtractQuote(Final, EntityDef.Value, Final); + Phase := phFinalGT; + end + else + if (StrLComp(Final, 'SYSTEM', 6) = 0) or + (StrLComp(Final, 'PUBLIC', 6) = 0) then + begin + ExternalID := TExternalID.Create(Final); + EntityDef.SystemId := ExternalID.SystemId; + EntityDef.PublicId := ExternalID.PublicId; + Final := ExternalID.Final; + Phase := phNData; + ExternalID.Free; + end; + phNData: + if StrLComp(Final, 'NDATA', 5) = 0 then + begin + INC(Final, 4); + Phase := phNotationName; + end; + phNotationName: + if CharInSet(Final^, CNameStart) then + begin + ExtractName(Final, CWhitespace + ['>'], F); + SetStringSF(EntityDef.NotationName, Final, F); + Final := F; + Phase := phFinalGT; + end; + phFinalGT: ; // -!- There is an error in the document if this branch is called + end; + end; + INC(Final); + until FALSE; + if IsParamEntity then + begin + EntityDef2 := TEntityDef(ParEntities.Node(EntityDef.Name)); + if EntityDef2 <> nil then + ParEntities.Delete(ParEntities.IndexOf(EntityDef2)); + ParEntities.Add(EntityDef); + ReplaceCharacterEntities(EntityDef.Value); + end + else + begin + EntityDef2 := TEntityDef(Entities.Node(EntityDef.Name)); + if EntityDef2 <> nil then + Entities.Delete(Entities.IndexOf(EntityDef2)); + Entities.Add(EntityDef); + ReplaceParameterEntities(EntityDef.Value); // Create replacement texts (see XmlSpec 4.5) + ReplaceCharacterEntities(EntityDef.Value); + end; + Final := StrScanE(Final, '>'); + + DER.ElementType := deEntity; + DER.EntityDef := EntityDef; + DER.Final := Final; + DtdElementFound(DER); +end; + +procedure TXmlParser.AnalyzeNotationDecl(Start: PAnsiChar; var Final: PAnsiChar); + // Parse ' character + // XmlSpec 4.7: NotationDecl ::= '' +type + TPhase = (phName, phExtId, phEnd); +var + ExternalID: TExternalID; + Phase: TPhase; + F: PAnsiChar; + NotationDef: TNotationDef; + DER: TDtdElementRec; +begin + Final := Start + 10; // Character after ', + #0: BREAK; + else + case Phase of + phName: + begin + ExtractName(Final, CWhitespace + ['>'], F); + SetStringSF(NotationDef.Name, Final, F); + Final := F; + Phase := phExtId; + end; + phExtId: + begin + ExternalID := TExternalID.Create(Final); + NotationDef.Value := ExternalID.SystemId; + NotationDef.PublicId := ExternalID.PublicId; + Final := ExternalId.Final; + ExternalId.Free; + Phase := phEnd; + end; + phEnd: ; // -!- There is an error in the document if this branch is called + end; + end; + INC(Final); + until FALSE; + Notations.Add(NotationDef); + Final := StrScanE(Final, '>'); + + DER.ElementType := deNotation; + DER.NotationDef := NotationDef; + DER.Final := Final; + DtdElementFound(DER); +end; + +procedure TXmlParser.PushPE(var Start: PAnsiChar); + (* If there is a parameter entity reference found in the data stream, + the current position will be pushed to the entity stack. + Start: IN Pointer to the '%' character starting the PE reference + OUT Pointer to first character of PE replacement text *) +var + P: PAnsiChar; + EntityDef: TEntityDef; +begin + P := StrScan(Start, ';'); + if P <> nil then + begin + EntityDef := TEntityDef(ParEntities.Node(StrSFPas(Start + 1, P - 1))); + if EntityDef <> nil then + begin + EntityStack.Push(P + 1); + Start := StringToPAnsiChar(EntityDef.Value); + end + else + Start := P + 1; + end; +end; + +procedure TXmlParser.ReplaceCharacterEntities(var Str: string); + // Replaces all Character Entity References in the String +var + Start: INTEGER; + PAmp: PAnsiChar; + PSemi: PAnsiChar; + PosAmp: INTEGER; + Len: INTEGER; // Length of Entity Reference +begin + if Str = '' then + EXIT; + Start := 1; + repeat + PAmp := StrPos(StringToPAnsiChar(Str) + Start - 1, '&#'); + if PAmp = nil then + BREAK; + PSemi := StrScan(PAmp + 2, ';'); + if PSemi = nil then + BREAK; + PosAmp := PAmp - StringToPAnsiChar(Str) + 1; + Len := PSemi - PAmp + 1; + if CompareText(Str[PosAmp + 2], 'x') = 0 // !!! Can't use "CHR" for Unicode characters > 255 + then + Str[PosAmp] := CHR(StrToIntDef('$' + Copy(Str, PosAmp + 3, Len - 4), 0)) + else + Str[PosAmp] := CHR(StrToIntDef(Copy(Str, PosAmp + 2, Len - 3), 32)); + Delete(Str, PosAmp + 1, Len - 1); + Start := PosAmp + 1; + until FALSE; +end; + +procedure TXmlParser.ReplaceParameterEntities(var Str: string); + // Recursively replaces all Parameter Entity References in the String + + procedure ReplaceEntities(var Str: string); + var + Start: INTEGER; + PAmp: PAnsiChar; + PSemi: PAnsiChar; + PosAmp: INTEGER; + Len: INTEGER; + Entity: TEntityDef; + Repl: string; // Replacement + begin + if Str = '' then + EXIT; + Start := 1; + repeat + PAmp := StrPos(StringToPAnsiChar(Str) + Start - 1, '%'); + if PAmp = nil then + BREAK; + PSemi := StrScan(PAmp + 2, ';'); + if PSemi = nil then + BREAK; + PosAmp := PAmp - StringToPAnsiChar(Str) + 1; + Len := PSemi - PAmp + 1; + Entity := TEntityDef(ParEntities.Node(Copy(Str, PosAmp + 1, Len - 2))); + if Entity <> nil then + begin + Repl := Entity.Value; + ReplaceEntities(Repl); // Recursion + end + else + Repl := Copy(Str, PosAmp, Len); + Delete(Str, PosAmp, Len); + Insert(Repl, Str, PosAmp); + Start := PosAmp + Length(Repl); + until FALSE; + end; +begin + ReplaceEntities(Str); +end; + +procedure TXmlParser.ReplaceGeneralEntities(var Str: string); + // Recursively replaces General Entity References in the String + + procedure ReplaceEntities(var Str: string); + var + Start: INTEGER; + PAmp: PAnsiChar; + PSemi: PAnsiChar; + PosAmp: INTEGER; + Len: INTEGER; + EntityDef: TEntityDef; + EntName: string; + Repl: string; // Replacement + ExternalEntity: TXmlParser; + begin + if Str = '' then + EXIT; + Start := 1; + repeat + PAmp := StrPos(StringToPAnsiChar(Str) + Start - 1, '&'); + if PAmp = nil then + BREAK; + PSemi := StrScan(PAmp + 2, ';'); + if PSemi = nil then + BREAK; + PosAmp := PAmp - StringToPAnsiChar(Str) + 1; + Len := PSemi - PAmp + 1; + EntName := Copy(Str, PosAmp + 1, Len - 2); + if EntName = 'lt' then + Repl := '<' + else + if EntName = 'gt' then + Repl := '>' + else + if EntName = 'amp' then + Repl := '&' + else + if EntName = 'apos' then + Repl := '''' + else + if EntName = 'quot' then + Repl := '"' + else + begin + EntityDef := TEntityDef(Entities.Node(EntName)); + if EntityDef <> nil then + begin + if EntityDef.Value <> '' then // Internal Entity + Repl := EntityDef.Value + else + begin // External Entity + ExternalEntity := LoadExternalEntity(EntityDef.SystemId, EntityDef.PublicId, EntityDef.NotationName); + Repl := string(StrPas(ExternalEntity.DocBuffer)); // !!! What if it contains a Text Declaration? + ExternalEntity.Free; + end; + ReplaceEntities(Repl); // Recursion + end + else + Repl := Copy(Str, PosAmp, Len); + end; + Delete(Str, PosAmp, Len); + Insert(Repl, Str, PosAmp); + Start := PosAmp + Length(Repl); + until FALSE; + end; +begin + ReplaceEntities(Str); +end; + +function TXmlParser.LoadExternalEntity(SystemId, PublicId, Notation: string): TXmlParser; + // This will be called whenever there is a Parsed External Entity or + // the DTD External Subset to be parsed. + // It has to create a TXmlParser instance and load the desired Entity. + // This instance of LoadExternalEntity assumes that "SystemId" is a valid + // file name (relative to the Document source) and loads this file using + // the LoadFromFile method. +var + Filename: string; +begin + // --- Convert System ID to complete filename + Filename := StringReplace(SystemId, '/', '\', [rfReplaceAll]); + if Copy(FSource, 1, 1) <> '<' then + if (Copy(Filename, 1, 2) = '\\') or (Copy(Filename, 2, 1) = ':') then + // Already has an absolute Path + else + begin + Filename := ExtractFilePath(FSource) + Filename; + end; + + // --- Load the File + Result := TXmlParser.Create; + Result.LoadFromFile(Filename); +end; + +function TXmlParser.TranslateEncoding(const Source: string): string; + // The member variable "CurEncoding" always holds the name of the current + // encoding, e.g. 'UTF-8' or 'ISO-8859-1'. + // This virtual method "TranslateEncoding" is responsible for translating + // the content passed in the "Source" parameter to the Encoding which + // is expected by the application. + // This instance of "TranlateEncoding" assumes that the Application expects + // Windows ANSI (Win1252) strings. It is able to transform UTF-8 or ISO-8859-1 + // encodings. + // If you want your application to understand or create other encodings, you + // override this function. +begin + if CurEncoding = 'UTF-8' + then + Result := string(Utf8ToAnsi(Source)) + else + Result := Source; +end; + +procedure TXmlParser.DtdElementFound(DtdElementRec: TDtdElementRec); + // This method is called for every element which is found in the DTD + // declaration. The variant record TDtdElementRec is passed which + // holds informations about the element. + // You can override this function to handle DTD declarations. + // Note that when you parse the same Document instance a second time, + // the DTD will not get parsed again. +begin +end; + +function TXmlParser.GetDocBuffer: PAnsiChar; + // Returns FBuffer or a pointer to a NUL char if Buffer is empty +begin + if FBuffer = nil + then + Result := #0 + else + Result := FBuffer; +end; + +(*$IFNDEF HAS_CONTNRS_UNIT +=============================================================================================== +TObjectList +=============================================================================================== +*) + +destructor TObjectList.Destroy; +begin + Clear; + SetCapacity(0); + inherited Destroy; +end; + +procedure TObjectList.Delete(Index: INTEGER); +begin + if (Index < 0) or (Index >= Count) then + EXIT; + TObject(Items[Index]).Free; + inherited Delete(Index); +end; + +procedure TObjectList.Clear; +begin + while Count > 0 do + Delete(Count - 1); +end; + +(*$ENDIF *) + +(* +=============================================================================================== +TNvpNode +-------- +Node base class for the TNvpList +=============================================================================================== +*) + +constructor TNvpNode.Create(TheName, TheValue: string); +begin + inherited Create; + Name := TheName; + Value := TheValue; +end; + +(* +=============================================================================================== +TNvpList +-------- +A generic List of Name-Value Pairs, based on the TObjectList introduced in Delphi 5 +=============================================================================================== +*) + +procedure TNvpList.Add(Node: TNvpNode); +var + I: INTEGER; +begin + for I := Count - 1 downto 0 do + if Node.Name > TNvpNode(Items[I]).Name then + begin + Insert(I + 1, Node); + EXIT; + end; + Insert(0, Node); +end; + +function TNvpList.Node(Name: string): TNvpNode; + // Binary search for Node +var + L, H: INTEGER; // Low, High Limit + T, C: INTEGER; // Test Index, Comparison result + Last: INTEGER; // Last Test Index +begin + if Count = 0 then + begin + Result := nil; + EXIT; + end; + + L := 0; + H := Count; + Last := -1; + repeat + T := (L + H) div 2; + if T = Last then + BREAK; + Result := TNvpNode(Items[T]); + C := CompareStr(Result.Name, Name); + if C = 0 then + EXIT + else + if C < 0 then + L := T + else + H := T; + Last := T; + until FALSE; + Result := nil; +end; + +function TNvpList.Node(Index: INTEGER): TNvpNode; +begin + if (Index < 0) or (Index >= Count) + then + Result := nil + else + Result := TNvpNode(Items[Index]); +end; + +function TNvpList.Value(Name: string): string; +var + Nvp: TNvpNode; +begin + Nvp := TNvpNode(Node(Name)); + if Nvp <> nil + then + Result := Nvp.Value + else + Result := ''; +end; + +function TNvpList.Value(Index: INTEGER): string; +begin + if (Index < 0) or (Index >= Count) + then + Result := '' + else + Result := TNvpNode(Items[Index]).Value; +end; + +function TNvpList.Name(Index: INTEGER): string; +begin + if (Index < 0) or (Index >= Count) + then + Result := '' + else + Result := TNvpNode(Items[Index]).Name; +end; + +(* +=============================================================================================== +TAttrList +List of Attributes. The "Analyze" method extracts the Attributes from the given Buffer. +Is used for extraction of Attributes in Start-Tags, Empty-Element Tags and the "pseudo" +attributes in XML Prologs, Text Declarations and PIs. +=============================================================================================== +*) + +procedure TAttrList.Analyze(Start: PAnsiChar; var Final: PAnsiChar); + // Analyze the Buffer for Attribute=Name pairs. + // Terminates when there is a character which is not IN CNameStart + // (e.g. '?>' or '>' or '/>') +type + TPhase = (phName, phEq, phValue); +var + Phase: TPhase; + F: PAnsiChar; + Name: string; + Value: string; + Attr: TAttr; +begin + Clear; + Phase := phName; + Final := Start; + repeat + if (Final^ = #0) or (Final^ = '>') then + BREAK; + if not (CharInSet(Final^, CWhitespace)) then + case Phase of + phName: + begin + if not (CharInSet(Final^, CNameStart)) then + EXIT; + ExtractName(Final, CWhitespace + ['=', '/'], F); + SetStringSF(Name, Final, F); + Final := F; + Phase := phEq; + end; + phEq: + begin + if Final^ = '=' then + Phase := phValue + end; + phValue: + begin + if CharInSet(Final^, CQuoteChar) then + begin + ExtractQuote(Final, Value, F); + Attr := TAttr.Create; + Attr.Name := Name; + Attr.Value := Value; + Attr.ValueType := vtNormal; + Add(Attr); + Final := F; + Phase := phName; + end; + end; + end; + INC(Final); + until FALSE; +end; + +(* +=============================================================================================== +TElemList +List of TElemDef nodes. +=============================================================================================== +*) + +function TElemList.Node(Name: string): TElemDef; + // Binary search for the Node with the given Name +var + L, H: INTEGER; // Low, High Limit + T, C: INTEGER; // Test Index, Comparison result + Last: INTEGER; // Last Test Index +begin + if Count = 0 then + begin + Result := nil; + EXIT; + end; + + L := 0; + H := Count; + Last := -1; + repeat + T := (L + H) div 2; + if T = Last then + BREAK; + Result := TElemDef(Items[T]); + C := CompareStr(Result.Name, Name); + if C = 0 then + EXIT + else + if C < 0 then + L := T + else + H := T; + Last := T; + until FALSE; + Result := nil; +end; + +procedure TElemList.Add(Node: TElemDef); +var + I: INTEGER; +begin + for I := Count - 1 downto 0 do + if Node.Name > TElemDef(Items[I]).Name then + begin + Insert(I + 1, Node); + EXIT; + end; + Insert(0, Node); +end; + +(* +=============================================================================================== +TScannerXmlParser +A TXmlParser descendant for the TCustomXmlScanner component +=============================================================================================== +*) + +type + TScannerXmlParser = class(TXmlParser) + Scanner: TCustomXmlScanner; + constructor Create(TheScanner: TCustomXmlScanner); + function LoadExternalEntity(SystemId, PublicId, + Notation: string): TXmlParser; override; + function TranslateEncoding(const Source: string): string; override; + procedure DtdElementFound(DtdElementRec: TDtdElementRec); override; + end; + +constructor TScannerXmlParser.Create(TheScanner: TCustomXmlScanner); +begin + inherited Create; + Scanner := TheScanner; +end; + +function TScannerXmlParser.LoadExternalEntity(SystemId, PublicId, Notation: string): TXmlParser; +begin + if Assigned(Scanner.FOnLoadExternal) + then + Scanner.FOnLoadExternal(Scanner, SystemId, PublicId, Notation, Result) + else + Result := inherited LoadExternalEntity(SystemId, PublicId, Notation); +end; + +function TScannerXmlParser.TranslateEncoding(const Source: string): string; +begin + if Assigned(Scanner.FOnTranslateEncoding) + then + Result := Scanner.FOnTranslateEncoding(Scanner, CurEncoding, Source) + else + Result := inherited TranslateEncoding(Source); +end; + +procedure TScannerXmlParser.DtdElementFound(DtdElementRec: TDtdElementRec); +begin + with DtdElementRec do + case ElementType of + deElement: Scanner.WhenElement(ElemDef); + deAttList: Scanner.WhenAttList(ElemDef); + deEntity: Scanner.WhenEntity(EntityDef); + deNotation: Scanner.WhenNotation(NotationDef); + dePI: Scanner.WhenPI(string(Target), string(Content), AttrList); + deComment: Scanner.WhenComment(StrSFPas(Start, Final)); + deError: Scanner.WhenDtdError(Pos); + end; +end; + +(* +=============================================================================================== +TCustomXmlScanner +=============================================================================================== +*) + +constructor TCustomXmlScanner.Create(AOwner: TComponent); +begin + inherited; + FXmlParser := TScannerXmlParser.Create(Self); +end; + +destructor TCustomXmlScanner.Destroy; +begin + FXmlParser.Free; + inherited; +end; + +procedure TCustomXmlScanner.LoadFromFile(Filename: TFilename); + // Load XML Document from file +begin + FXmlParser.LoadFromFile(Filename); +end; + +procedure TCustomXmlScanner.LoadFromBuffer(Buffer: PAnsiChar); + // Load XML Document from buffer +begin + FXmlParser.LoadFromBuffer(Buffer); +end; + +procedure TCustomXmlScanner.SetBuffer(Buffer: PAnsiChar); + // Refer to Buffer +begin + FXmlParser.SetBuffer(Buffer); +end; + +function TCustomXmlScanner.GetFilename: TFilename; +begin + Result := FXmlParser.Source; +end; + +function TCustomXmlScanner.GetNormalize: BOOLEAN; +begin + Result := FXmlParser.Normalize; +end; + +procedure TCustomXmlScanner.SetNormalize(Value: BOOLEAN); +begin + FXmlParser.Normalize := Value; +end; + +procedure TCustomXmlScanner.WhenXmlProlog(XmlVersion, Encoding: string; Standalone: BOOLEAN); + // Is called when the parser has parsed the declaration of the prolog +begin + if Assigned(FOnXmlProlog) then + FOnXmlProlog(Self, XmlVersion, Encoding, Standalone); +end; + +procedure TCustomXmlScanner.WhenComment(Comment: string); + // Is called when the parser has parsed a +begin + if Assigned(FOnComment) then + FOnComment(Self, Comment); +end; + +procedure TCustomXmlScanner.WhenPI(Target, Content: string; Attributes: TAttrList); + // Is called when the parser has parsed a +begin + if Assigned(FOnPI) then + FOnPI(Self, Target, Content, Attributes); +end; + +procedure TCustomXmlScanner.WhenDtdRead(RootElementName: string); + // Is called when the parser has completely parsed the DTD +begin + if Assigned(FOnDtdRead) then + FOnDtdRead(Self, RootElementName); +end; + +procedure TCustomXmlScanner.WhenStartTag(TagName: string; Attributes: TAttrList); + // Is called when the parser has parsed a start tag like

+begin + if Assigned(FOnStartTag) then + FOnStartTag(Self, TagName, Attributes); +end; + +procedure TCustomXmlScanner.WhenEmptyTag(TagName: string; Attributes: TAttrList); + // Is called when the parser has parsed an Empty Element Tag like
+begin + if Assigned(FOnEmptyTag) then + FOnEmptyTag(Self, TagName, Attributes); +end; + +procedure TCustomXmlScanner.WhenEndTag(TagName: string); + // Is called when the parser has parsed an End Tag like

+begin + if Assigned(FOnEndTag) then + FOnEndTag(Self, TagName); +end; + +procedure TCustomXmlScanner.WhenContent(Content: string); + // Is called when the parser has parsed an element's text content +begin + if Assigned(FOnContent) then + FOnContent(Self, Content); +end; + +procedure TCustomXmlScanner.WhenCData(Content: string); + // Is called when the parser has parsed a CDATA section +begin + if Assigned(FOnCData) then + FOnCData(Self, Content); +end; + +procedure TCustomXmlScanner.WhenElement(ElemDef: TElemDef); + // Is called when the parser has parsed an definition + // inside the DTD +begin + if Assigned(FOnElement) then + FOnElement(Self, ElemDef); +end; + +procedure TCustomXmlScanner.WhenAttList(ElemDef: TElemDef); + // Is called when the parser has parsed an definition + // inside the DTD +begin + if Assigned(FOnAttList) then + FOnAttList(Self, ElemDef); +end; + +procedure TCustomXmlScanner.WhenEntity(EntityDef: TEntityDef); + // Is called when the parser has parsed an definition + // inside the DTD +begin + if Assigned(FOnEntity) then + FOnEntity(Self, EntityDef); +end; + +procedure TCustomXmlScanner.WhenNotation(NotationDef: TNotationDef); + // Is called when the parser has parsed a definition + // inside the DTD +begin + if Assigned(FOnNotation) then + FOnNotation(Self, NotationDef); +end; + +procedure TCustomXmlScanner.WhenDtdError(ErrorPos: PAnsiChar); + // Is called when the parser has found an Error in the DTD +begin + if Assigned(FOnDtdError) then + FOnDtdError(Self, ErrorPos); +end; + +procedure TCustomXmlScanner.Execute; + // Perform scanning + // Scanning is done synchronously, i.e. you can expect events to be triggered + // in the order of the XML data stream. Execute will finish when the whole XML + // document has been scanned or when the StopParser property has been set to TRUE. +begin + FStopParser := FALSE; + FXmlParser.StartScan; + while FXmlParser.Scan and (not FStopParser) do + case FXmlParser.CurPartType of + ptNone: ; + ptXmlProlog: WhenXmlProlog(FXmlParser.XmlVersion, FXmlParser.Encoding, FXmlParser.Standalone); + ptComment: WhenComment(StrSFPas(FXmlParser.CurStart, FXmlParser.CurFinal)); + ptPI: WhenPI(FXmlParser.CurName, FXmlParser.CurContent, FXmlParser.CurAttr); + ptDtdc: WhenDtdRead(FXmlParser.RootName); + ptStartTag: WhenStartTag(FXmlParser.CurName, FXmlParser.CurAttr); + ptEmptyTag: WhenEmptyTag(FXmlParser.CurName, FXmlParser.CurAttr); + ptEndTag: WhenEndTag(FXmlParser.CurName); + ptContent: WhenContent(FXmlParser.CurContent); + ptCData: WhenCData(FXmlParser.CurContent); + end; +end; + +end. + From 77e3b8b71d58277d6ac4b22950e982c114efce81 Mon Sep 17 00:00:00 2001 From: Tristan Marlow Date: Wed, 17 Feb 2016 13:02:13 +0800 Subject: [PATCH 04/15] Delphi XE8 package --- Packages/EmbeddedWebBrowser_XE8.dpk | 132 ++++++++++++++++++++++++++++ 1 file changed, 132 insertions(+) create mode 100644 Packages/EmbeddedWebBrowser_XE8.dpk diff --git a/Packages/EmbeddedWebBrowser_XE8.dpk b/Packages/EmbeddedWebBrowser_XE8.dpk new file mode 100644 index 0000000..a163052 --- /dev/null +++ b/Packages/EmbeddedWebBrowser_XE8.dpk @@ -0,0 +1,132 @@ +{*******************************************************} +{ Embedded Web Browser package Delphi XE8 } +{ } +{ For Delphi 5 - XE8 } +{ Freeware Components } +{ Please note our uses terms } +{ } +{ Enjoy! } +{ UPDATES: } +{ http://www.bsalsa.com } +{*******************************************************************************} +{LICENSE: +THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, +EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED +WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. +YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE +AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE +AND DOCUMENTATION. [YOUR NAME] DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE +OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED +OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, +INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR +OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, +AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. VSOFT SPECIFICALLY +DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. + +You may use, change or modify the component under 4 conditions: +1. In your website, add a link to "http://www.bsalsa.com" +2. In your application, add credits to "Embedded Web Browser" +3. Mail me (bsalsa@bsalsa.com) any code change in the unit + for the benefit of the other users. +4. Please, consider donation in our web site! +{*******************************************************************************} + +package EmbeddedWebBrowser_XE8; +{$R *.res} +{$R '..\Source\EWB.dcr'} +{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} +{$ALIGN 8} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION OFF} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES ON} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DEFINE DEBUG} +{$ENDIF IMPLICITBUILDING} +{$DESCRIPTION 'Internet Embedded Web Browser Components'} +{$IMPLICITBUILD ON} + +requires + designide, + rtl, + vcl, + vclimg; + +contains + EmbeddedWB in '..\Source\EmbeddedWB.pas', + AppWebUpdater in '..\Source\AppWebUpdater.pas', + AppWUStrings in '..\Source\AppWUStrings.pas', + ExportFavorites in '..\Source\ExportFavorites.pas', + IEParser in '..\Source\IEParser.pas', + FavMenu in '..\Source\FavMenu.pas', + FavoritesListView in '..\Source\FavoritesListView.pas', + FavoritesTree in '..\Source\FavoritesTree.pas', + HistoryListView in '..\Source\HistoryListView.pas', + HistoryMenu in '..\Source\HistoryMenu.pas', + IECache in '..\Source\IECache.pas', + IEDownload in '..\Source\IEDownload.pas', + IEMultiDownload in '..\Source\IEMultiDownload.pas', + IEDownloadStrings in '..\Source\IEDownloadStrings.pas', + IEDownloadAcc in '..\Source\IEDownloadAcc.pas', + IETravelLog in '..\Source\IETravelLog.pas', + ImportFavorites in '..\Source\ImportFavorites.pas', + LinksBar in '..\Source\LinksBar.pas', + RichEditBrowser in '..\Source\RichEditBrowser.pas', + SecurityManager in '..\Source\SecurityManager.pas', + SendMail_For_Ewb in '..\Source\SendMail_For_Ewb.pas', + UrlHistory in '..\Source\UrlHistory.pas', + Edithost in '..\Source\Edithost.pas', + EditDesigner in '..\Source\EditDesigner.pas', + IEAddress in '..\Source\IEAddress.pas', + EwbEditors in '..\Source\EwbEditors.pas', + EwbReg in '..\Source\EwbReg.pas', + Browse4Folder in '..\Source\Browse4Folder.pas', + FileExtAssociate in '..\Source\FileExtAssociate.pas', + LinksLabel in '..\Source\LinksLabel.pas', + EwbAcc in '..\Source\EwbAcc.pas', + EwbTools in '..\Source\EwbTools.pas', + DirMonitor in '..\Source\DirMonitor.pas', + HighLightXML in '..\Source\HighLightXML.pas', + HighLightHTML in '..\Source\HighLightHTML.pas', + Mshtml_Ewb in '..\Source\Mshtml_Ewb.pas', + HighLightRichSyntax in '..\Source\HighLightRichSyntax.pas', + SHDocVw_EWB in '..\Source\SHDocVw_EWB.pas', + UI_Less in '..\Source\UI_Less.pas', + EwbCore in '..\Source\EwbCore.pas', + MenuContext in '..\Source\MenuContext.pas', + FavoritesPopup in '..\Source\FavoritesPopup.pas', + EwbDDE in '..\Source\EwbDDE.pas', + EwbCoreTools in '..\Source\EwbCoreTools.pas', + EwbClasses in '..\Source\EwbClasses.pas', + EwbBehaviorsComp in '..\Source\EwbBehaviorsComp.pas', + EwbEvents in '..\Source\EwbEvents.pas', + EwbEventsComp in '..\Source\EwbEventsComp.pas', + EwbActns in '..\Source\EwbActns.pas', + EwbUrl in '..\Source\EwbUrl.pas', + IEDownloadTools in '..\Source\IEDownloadTools.pas', + wbhFixes in '..\Source\wbhFixes.pas', + MSHTMLEvents in '..\Source\MSHTMLEvents.pas', + EwbControlComponent in '..\Source\EwbControlComponent.pas', + EwbMouseHook in '..\Source\EwbMouseHook.pas', + EwbFocusControl in '..\Source\EwbFocusControl.pas', + Wcrypt2 in '..\Source\Wcrypt2.pas', + EwbLibXmlComps in '..\Source\EwbLibXmlComps.pas', + EwbLibXmlParser in '..\Source\EwbLibXmlParser.pas', + EWB.IEConst in '..\Source\EWB.IEConst.pas'; + +end. From a4ba8e09d19646075c27600a297bb2632496b9d1 Mon Sep 17 00:00:00 2001 From: tristan Date: Tue, 9 Aug 2016 21:23:33 +0800 Subject: [PATCH 05/15] Delphi Berlin --- Packages/EmbeddedWebBrowser_Berlin.dpk | 129 +++++++++++++++++++++++++ 1 file changed, 129 insertions(+) create mode 100644 Packages/EmbeddedWebBrowser_Berlin.dpk diff --git a/Packages/EmbeddedWebBrowser_Berlin.dpk b/Packages/EmbeddedWebBrowser_Berlin.dpk new file mode 100644 index 0000000..6149d80 --- /dev/null +++ b/Packages/EmbeddedWebBrowser_Berlin.dpk @@ -0,0 +1,129 @@ +{*******************************************************} +{ Embedded Web Browser package Delphi Seattle } +{ } +{ For Delphi 5 - Seattle } +{ Freeware Components } +{ Please note our uses terms } +{ } +{ Enjoy! } +{ UPDATES: } +{ http://www.bsalsa.com } +{*******************************************************************************} +{LICENSE: +THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, +EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED +WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. +YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE +AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE +AND DOCUMENTATION. [YOUR NAME] DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE +OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED +OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, +INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR +OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, +AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. VSOFT SPECIFICALLY +DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. + +You may use, change or modify the component under 4 conditions: +1. In your website, add a link to "http://www.bsalsa.com" +2. In your application, add credits to "Embedded Web Browser" +3. Mail me (bsalsa@bsalsa.com) any code change in the unit + for the benefit of the other users. +4. Please, consider donation in our web site! +{*******************************************************************************} + +package EmbeddedWebBrowser_Berlin; +{$R *.res} +{$R 'EWB.dcr'} +{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION OFF} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES ON} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DEFINE DEBUG} +{$ENDIF IMPLICITBUILDING} +{$DESCRIPTION 'Internet Embedded Web Browser Components'} +{$IMPLICITBUILD ON} + +requires + designide, + rtl, + vcl, + vclimg; + +contains + EmbeddedWB in '..\Source\EmbeddedWB.pas', + AppWebUpdater in '..\Source\AppWebUpdater.pas', + AppWUStrings in '..\Source\AppWUStrings.pas', + ExportFavorites in '..\Source\ExportFavorites.pas', + IEParser in '..\Source\IEParser.pas', + FavMenu in '..\Source\FavMenu.pas', + FavoritesListView in '..\Source\FavoritesListView.pas', + FavoritesTree in '..\Source\FavoritesTree.pas', + HistoryListView in '..\Source\HistoryListView.pas', + HistoryMenu in '..\Source\HistoryMenu.pas', + IECache in '..\Source\IECache.pas', + IEDownload in '..\Source\IEDownload.pas', + IEMultiDownload in '..\Source\IEMultiDownload.pas', + IEDownloadStrings in '..\Source\IEDownloadStrings.pas', + IEDownloadAcc in '..\Source\IEDownloadAcc.pas', + IETravelLog in '..\Source\IETravelLog.pas', + ImportFavorites in '..\Source\ImportFavorites.pas', + LinksBar in '..\Source\LinksBar.pas', + RichEditBrowser in '..\Source\RichEditBrowser.pas', + SecurityManager in '..\Source\SecurityManager.pas', + SendMail_For_Ewb in '..\Source\SendMail_For_Ewb.pas', + UrlHistory in '..\Source\UrlHistory.pas', + Edithost in '..\Source\Edithost.pas', + EditDesigner in '..\Source\EditDesigner.pas', + IEAddress in '..\Source\IEAddress.pas', + EwbEditors in '..\Source\EwbEditors.pas', + EwbReg in '..\Source\EwbReg.pas', + Browse4Folder in '..\Source\Browse4Folder.pas', + FileExtAssociate in '..\Source\FileExtAssociate.pas', + LinksLabel in '..\Source\LinksLabel.pas', + EwbAcc in '..\Source\EwbAcc.pas', + EwbTools in '..\Source\EwbTools.pas', + DirMonitor in '..\Source\DirMonitor.pas', + HighLightXML in '..\Source\HighLightXML.pas', + HighLightHTML in '..\Source\HighLightHTML.pas', + Mshtml_Ewb in '..\Source\Mshtml_Ewb.pas', + HighLightRichSyntax in '..\Source\HighLightRichSyntax.pas', + SHDocVw_EWB in '..\Source\SHDocVw_EWB.pas', + UI_Less in '..\Source\UI_Less.pas', + EwbCore in '..\Source\EwbCore.pas', + MenuContext in '..\Source\MenuContext.pas', + FavoritesPopup in '..\Source\FavoritesPopup.pas', + EwbDDE in '..\Source\EwbDDE.pas', + EwbCoreTools in '..\Source\EwbCoreTools.pas', + EwbClasses in '..\Source\EwbClasses.pas', + EwbBehaviorsComp in '..\Source\EwbBehaviorsComp.pas', + EwbEvents in '..\Source\EwbEvents.pas', + EwbEventsComp in '..\Source\EwbEventsComp.pas', + EwbActns in '..\Source\EwbActns.pas', + EwbUrl in '..\Source\EwbUrl.pas', + IEDownloadTools in '..\Source\IEDownloadTools.pas', + wbhFixes in '..\Source\wbhFixes.pas', + MSHTMLEvents in '..\Source\MSHTMLEvents.pas', + EwbControlComponent in '..\Source\EwbControlComponent.pas', + EwbMouseHook in '..\Source\EwbMouseHook.pas', + EwbFocusControl in '..\Source\EwbFocusControl.pas', + EwbLibXmlParser in '..\Source\EwbLibXmlParser.pas'; + +end. From 6877fc73df597ef80e80033ffb9e9499eec3ed25 Mon Sep 17 00:00:00 2001 From: AndrewBJ Date: Thu, 15 Dec 2016 13:10:36 +0200 Subject: [PATCH 06/15] Win64 Support --- Source/Browse4Folder.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Source/Browse4Folder.pas b/Source/Browse4Folder.pas index 3e0c991..1283102 100644 --- a/Source/Browse4Folder.pas +++ b/Source/Browse4Folder.pas @@ -183,7 +183,7 @@ function BrowseForFolderCallBack(Wnd: HWND; uMsg: UINT; begin if uMsg = BFFM_INITIALIZED then begin - SendMessage(Wnd, BFFM_SETSELECTION, 1, Integer(@lg_StartFolder[1])); + SendMessage(Wnd, BFFM_SETSELECTION, 1, NativeInt(@lg_StartFolder[1])); {$IFDEF DELPHI7_UP} wa := Screen.WorkAreaRect; GetWindowRect(Wnd, Rect); From a89ecfb4f4b62f4f0235c26a5f515819485005c7 Mon Sep 17 00:00:00 2001 From: AndrewBJ Date: Thu, 15 Dec 2016 13:16:13 +0200 Subject: [PATCH 07/15] Win64 Support --- Source/EWBMouseHook.pas | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/Source/EWBMouseHook.pas b/Source/EWBMouseHook.pas index 150e3e1..7a0e419 100644 --- a/Source/EWBMouseHook.pas +++ b/Source/EWBMouseHook.pas @@ -93,6 +93,26 @@ TMethod = record // MakeStdcallCallback (thunk to use stdcall method as static callback) function MakeStdcallCallback(const Method: TMethod): Pointer; +{$IFDEF WIN64} +var + P: PByte; +begin + Result := VirtualAlloc(nil, $100, MEM_COMMIT, PAGE_EXECUTE_READWRITE); + if Assigned(Result) then + begin + P := Result; + PDWORD(P)^ := $4D905141; Inc(P, 4); + PDWORD(P)^ := $8949C189; Inc(P, 4); + PDWORD(P)^ := $CA8948D0; Inc(P, 4); + PWORD(P)^ := $B948; Inc(P, 2); + PPointer(P)^ := Method.Data; Inc(P, 8); + PWORD(P)^ := $B848; Inc(P, 2); + PPointer(P)^ := Method.Code; Inc(P, 8); + PDWORD(P)^ := $4190D0FF; Inc(P, 4); + PWORD(P)^ := $C359; + end; +end; +{$ELSE} type PCallbackCode = ^TCallbackCode; TCallbackCode = packed record @@ -120,6 +140,7 @@ function MakeStdcallCallback(const Method: TMethod): Pointer; Result := nil; end; end; +{$ENDIF} procedure FreeCallback(Callback: Pointer); begin From 9c8b6aa4065e4c3b8543a339a00974c9e130f3b9 Mon Sep 17 00:00:00 2001 From: AndrewBJ Date: Thu, 15 Dec 2016 13:17:47 +0200 Subject: [PATCH 08/15] Update EmbeddedWB.pas --- Source/EmbeddedWB.pas | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Source/EmbeddedWB.pas b/Source/EmbeddedWB.pas index bb77095..3263c74 100644 --- a/Source/EmbeddedWB.pas +++ b/Source/EmbeddedWB.pas @@ -1105,7 +1105,7 @@ procedure TEmbeddedWB.UnHookChildWindows; begin if FSysListViewHandle <> 0 then begin - SetWindowLongW(FSysListViewHandle, GWL_WNDPROC, Integer(FDefSysListViewObjProc)); + SetWindowLongW(FSysListViewHandle, GWL_WNDPROC, NativeInt(FDefSysListViewObjProc)); {$IFDEF DELPHI6_UP}Classes.{$ENDIF}FreeObjectInstance(FSysListViewObjInstance); FSysListViewHandle := 0; FSysListViewObjInstance := nil; @@ -1113,7 +1113,7 @@ procedure TEmbeddedWB.UnHookChildWindows; if FShellDocObjViewHandle <> 0 then begin - SetWindowLongW(FShellDocObjViewHandle, GWL_WNDPROC, Integer(FDefShellObjViewProc)); + SetWindowLongW(FShellDocObjViewHandle, GWL_WNDPROC, NativeInt(FDefShellObjViewProc)); {$IFDEF DELPHI6_UP}Classes.{$ENDIF}FreeObjectInstance(FShellDocObjInstance); FShellDocObjViewHandle := 0; FShellDocObjInstance := nil; @@ -1121,7 +1121,7 @@ procedure TEmbeddedWB.UnHookChildWindows; if FInetExplorerServerHandle <> 0 then begin - SetWindowLongW(FInetExplorerServerHandle, GWL_WNDPROC, Integer(FDefInetExplorerServerProc)); + SetWindowLongW(FInetExplorerServerHandle, GWL_WNDPROC, NativeInt(FDefInetExplorerServerProc)); {$IFDEF DELPHI6_UP}Classes.{$ENDIF}FreeObjectInstance(FInetExplorerServerInstance); FInetExplorerServerHandle := 0; FInetExplorerServerInstance := nil; From 97ddef3a43983e0996b8773b2e08b4f7bdee7bf9 Mon Sep 17 00:00:00 2001 From: AndrewBJ Date: Thu, 15 Dec 2016 13:18:56 +0200 Subject: [PATCH 09/15] Win64 Support --- Source/EwbAcc.pas | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Source/EwbAcc.pas b/Source/EwbAcc.pas index 2abdc0e..34886ce 100644 --- a/Source/EwbAcc.pas +++ b/Source/EwbAcc.pas @@ -747,7 +747,7 @@ function CheckURLMonModuleFunc(const Name: string; var ptr: Pointer): Boolean; function CoInternetSetFeatureEnabled(aFeature: TInternetFeature; dwFlags: DWORD; fEnable: Boolean): HRESULT; begin - if (Integer(CoInternetSetFeatureEnabledPtr) > 1) or + if (NativeInt(CoInternetSetFeatureEnabledPtr) > 1) or CheckURLMonModuleFunc('CoInternetSetFeatureEnabled', CoInternetSetFeatureEnabledPtr) then Result := TCoInternetSetFeatureEnabled(CoInternetSetFeatureEnabledPtr)( @@ -759,7 +759,7 @@ function CoInternetSetFeatureEnabled(aFeature: TInternetFeature; function CoInternetIsFeatureEnabled(aFeature: TInternetFeature; dwFlags: DWORD): HRESULT; begin - if (Integer(CoInternetIsFeatureEnablePtr) > 1) or + if (NativeInt(CoInternetIsFeatureEnablePtr) > 1) or CheckURLMonModuleFunc('CoInternetIsFeatureEnabled', CoInternetIsFeatureEnablePtr) then Result := TCoInternetIsFeatureEnabled(CoInternetIsFeatureEnablePtr)( @@ -771,7 +771,7 @@ function CoInternetIsFeatureEnabled(aFeature: TInternetFeature; function CoInternetIsFeatureEnabledForUrl(aFeature: TInternetFeature; dwFlags: DWORD; szUrl: LPCWSTR; pSecMgr: IInternetSecurityManager): HRESULT; begin - if (Integer(CoInternetIsFeatureEnabledForUrlPtr) > 1) or + if (NativeInt(CoInternetIsFeatureEnabledForUrlPtr) > 1) or CheckURLMonModuleFunc('CoInternetIsFeatureEnabledForUrl', CoInternetIsFeatureEnabledForUrlPtr) then Result := @@ -786,7 +786,7 @@ function CoInternetIsFeatureZoneElevationEnabled( szFromURL, szToURL: LPCWSTR; pSecMgr: IInternetSecurityManager; dwFlags: DWORD): HRESULT; begin - if (Integer(CoInternetIsFeatureZoneElevationEnabledPtr) > 1) or + if (NativeInt(CoInternetIsFeatureZoneElevationEnabledPtr) > 1) or CheckURLMonModuleFunc('CoInternetIsFeatureZoneElevationEnabled', CoInternetIsFeatureZoneElevationEnabledPtr) then Result := From 549105fd55633c20c3205204f1a25c36922ccf09 Mon Sep 17 00:00:00 2001 From: AndrewBJ Date: Thu, 15 Dec 2016 13:19:50 +0200 Subject: [PATCH 10/15] Win64 Support --- Source/EwbFocusControl.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Source/EwbFocusControl.pas b/Source/EwbFocusControl.pas index d6281bd..5af3fbc 100644 --- a/Source/EwbFocusControl.pas +++ b/Source/EwbFocusControl.pas @@ -163,7 +163,7 @@ function TAppHookWindow.MessageHook(var Msg: TMessage): Boolean; (ActiveControl.ClassName = 'TEWBCore')) then if GetFocus <> ActiveControl.Handle then begin - PostMessage(ActiveControl.Handle, WM_SETWBFOCUS, Integer(ActiveControl), 0); + PostMessage(ActiveControl.Handle, WM_SETWBFOCUS, NativeInt(ActiveControl), 0); // OutputDebugString(PChar('Focus set')); // ActiveControl.SetFocus doesn't work when switching between forms. end; From 27aa6d5446293a57a099d4fcf75cb81be460a038 Mon Sep 17 00:00:00 2001 From: AndrewBJ Date: Thu, 15 Dec 2016 13:20:44 +0200 Subject: [PATCH 11/15] Win64 Support --- Source/RichEditBrowser.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Source/RichEditBrowser.pas b/Source/RichEditBrowser.pas index 41b1a0f..3401c26 100644 --- a/Source/RichEditBrowser.pas +++ b/Source/RichEditBrowser.pas @@ -1868,7 +1868,7 @@ procedure TRichEditWB.CNNotify(var Msg: TWMNotify); if (p.Msg = WM_LBUTTONDOWN) then begin try - SendMessage(Handle, EM_EXSETSEL, 0, Longint(@(p.chrg))); + SendMessage(Handle, EM_EXSETSEL, 0, NativeInt(@(p.chrg))); sURL := SelText; DoURLClick(sURL); except From 02484c122d60997e49e55a1e9f9c73b752d48603 Mon Sep 17 00:00:00 2001 From: tristan Date: Sat, 25 Nov 2017 12:52:31 +0800 Subject: [PATCH 12/15] Tokyo Package --- Packages/EmbeddedWebBrowser_Tokyo.dpk | 129 ++++++++++++++++++++++++++ 1 file changed, 129 insertions(+) create mode 100644 Packages/EmbeddedWebBrowser_Tokyo.dpk diff --git a/Packages/EmbeddedWebBrowser_Tokyo.dpk b/Packages/EmbeddedWebBrowser_Tokyo.dpk new file mode 100644 index 0000000..6149d80 --- /dev/null +++ b/Packages/EmbeddedWebBrowser_Tokyo.dpk @@ -0,0 +1,129 @@ +{*******************************************************} +{ Embedded Web Browser package Delphi Seattle } +{ } +{ For Delphi 5 - Seattle } +{ Freeware Components } +{ Please note our uses terms } +{ } +{ Enjoy! } +{ UPDATES: } +{ http://www.bsalsa.com } +{*******************************************************************************} +{LICENSE: +THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, +EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED +WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. +YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE +AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE +AND DOCUMENTATION. [YOUR NAME] DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE +OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED +OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, +INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR +OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, +AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. VSOFT SPECIFICALLY +DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. + +You may use, change or modify the component under 4 conditions: +1. In your website, add a link to "http://www.bsalsa.com" +2. In your application, add credits to "Embedded Web Browser" +3. Mail me (bsalsa@bsalsa.com) any code change in the unit + for the benefit of the other users. +4. Please, consider donation in our web site! +{*******************************************************************************} + +package EmbeddedWebBrowser_Berlin; +{$R *.res} +{$R 'EWB.dcr'} +{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION OFF} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES ON} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DEFINE DEBUG} +{$ENDIF IMPLICITBUILDING} +{$DESCRIPTION 'Internet Embedded Web Browser Components'} +{$IMPLICITBUILD ON} + +requires + designide, + rtl, + vcl, + vclimg; + +contains + EmbeddedWB in '..\Source\EmbeddedWB.pas', + AppWebUpdater in '..\Source\AppWebUpdater.pas', + AppWUStrings in '..\Source\AppWUStrings.pas', + ExportFavorites in '..\Source\ExportFavorites.pas', + IEParser in '..\Source\IEParser.pas', + FavMenu in '..\Source\FavMenu.pas', + FavoritesListView in '..\Source\FavoritesListView.pas', + FavoritesTree in '..\Source\FavoritesTree.pas', + HistoryListView in '..\Source\HistoryListView.pas', + HistoryMenu in '..\Source\HistoryMenu.pas', + IECache in '..\Source\IECache.pas', + IEDownload in '..\Source\IEDownload.pas', + IEMultiDownload in '..\Source\IEMultiDownload.pas', + IEDownloadStrings in '..\Source\IEDownloadStrings.pas', + IEDownloadAcc in '..\Source\IEDownloadAcc.pas', + IETravelLog in '..\Source\IETravelLog.pas', + ImportFavorites in '..\Source\ImportFavorites.pas', + LinksBar in '..\Source\LinksBar.pas', + RichEditBrowser in '..\Source\RichEditBrowser.pas', + SecurityManager in '..\Source\SecurityManager.pas', + SendMail_For_Ewb in '..\Source\SendMail_For_Ewb.pas', + UrlHistory in '..\Source\UrlHistory.pas', + Edithost in '..\Source\Edithost.pas', + EditDesigner in '..\Source\EditDesigner.pas', + IEAddress in '..\Source\IEAddress.pas', + EwbEditors in '..\Source\EwbEditors.pas', + EwbReg in '..\Source\EwbReg.pas', + Browse4Folder in '..\Source\Browse4Folder.pas', + FileExtAssociate in '..\Source\FileExtAssociate.pas', + LinksLabel in '..\Source\LinksLabel.pas', + EwbAcc in '..\Source\EwbAcc.pas', + EwbTools in '..\Source\EwbTools.pas', + DirMonitor in '..\Source\DirMonitor.pas', + HighLightXML in '..\Source\HighLightXML.pas', + HighLightHTML in '..\Source\HighLightHTML.pas', + Mshtml_Ewb in '..\Source\Mshtml_Ewb.pas', + HighLightRichSyntax in '..\Source\HighLightRichSyntax.pas', + SHDocVw_EWB in '..\Source\SHDocVw_EWB.pas', + UI_Less in '..\Source\UI_Less.pas', + EwbCore in '..\Source\EwbCore.pas', + MenuContext in '..\Source\MenuContext.pas', + FavoritesPopup in '..\Source\FavoritesPopup.pas', + EwbDDE in '..\Source\EwbDDE.pas', + EwbCoreTools in '..\Source\EwbCoreTools.pas', + EwbClasses in '..\Source\EwbClasses.pas', + EwbBehaviorsComp in '..\Source\EwbBehaviorsComp.pas', + EwbEvents in '..\Source\EwbEvents.pas', + EwbEventsComp in '..\Source\EwbEventsComp.pas', + EwbActns in '..\Source\EwbActns.pas', + EwbUrl in '..\Source\EwbUrl.pas', + IEDownloadTools in '..\Source\IEDownloadTools.pas', + wbhFixes in '..\Source\wbhFixes.pas', + MSHTMLEvents in '..\Source\MSHTMLEvents.pas', + EwbControlComponent in '..\Source\EwbControlComponent.pas', + EwbMouseHook in '..\Source\EwbMouseHook.pas', + EwbFocusControl in '..\Source\EwbFocusControl.pas', + EwbLibXmlParser in '..\Source\EwbLibXmlParser.pas'; + +end. From 14e73e19a9bb510309e62be72eb2a0c64e8a8641 Mon Sep 17 00:00:00 2001 From: tristan Date: Tue, 5 Dec 2017 20:13:51 +0800 Subject: [PATCH 13/15] Berlin and Tokyo projects --- .gitignore | 79 +++- Packages/EmbeddedWebBrowser_Berlin.dproj | 554 +++++++++++++++++++++++ Packages/EmbeddedWebBrowser_Berlin.res | Bin 0 -> 448 bytes Packages/EmbeddedWebBrowser_Tokyo.dpk | 2 +- Packages/EmbeddedWebBrowser_Tokyo.dproj | 233 ++++++++++ Packages/EmbeddedWebBrowser_Tokyo.res | Bin 0 -> 736 bytes 6 files changed, 865 insertions(+), 3 deletions(-) create mode 100644 Packages/EmbeddedWebBrowser_Berlin.dproj create mode 100644 Packages/EmbeddedWebBrowser_Berlin.res create mode 100644 Packages/EmbeddedWebBrowser_Tokyo.dproj create mode 100644 Packages/EmbeddedWebBrowser_Tokyo.res diff --git a/.gitignore b/.gitignore index 4f36e6a..2e593f2 100644 --- a/.gitignore +++ b/.gitignore @@ -1,7 +1,82 @@ +# Uncomment these types if you want even more clean repository. But be careful. +# It can make harm to an existing project source. Read explanations below. +# +# Resource files are binaries containing manifest, project icon and version info. +# They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. +#*.res +# +# Type library file (binary). In old Delphi versions it should be stored. +# Since Delphi 2009 it is produced from .ridl file and can safely be ignored. +#*.tlb +# +# Diagram Portfolio file. Used by the diagram editor up to Delphi 7. +# Uncomment this if you are not using diagrams or use newer Delphi version. +#*.ddp +# +# Visual LiveBindings file. Added in Delphi XE2. +# Uncomment this if you are not using LiveBindings Designer. +#*.vlb +# +# Deployment Manager configuration file for your project. Added in Delphi XE2. +# Uncomment this if it is not mobile development and you do not use remote debug feature. +#*.deployproj +# +# C++ object files produced when C/C++ Output file generation is configured. +# Uncomment this if you are not using external objects (zlib library for example). +#*.obj +# + +# Delphi compiler-generated binaries (safe to delete) +/source/**/*.exe +/source/**/*.dll +/source/**/*.bpl +/source/**/*.bpi +/source/**/*.dcp +/source/**/*.so +/source/**/*.apk +/source/**/*.drc +/source/**/*.map +/source/**/*.dres +/source/**/*.rsm +/source/**/*.tds +/source/**/*.dcu +/source/**/*.lib +/source/**/*.a +/source/**/*.o +/source/**/*.ocx + +# Delphi autogenerated files (duplicated info) +/source/**/*.cfg +/source/**/*.hpp +/source/**/*Resource.rc + +# Delphi local files (user-specific info) +/source/**/*.local +/source/**/*.identcache +/source/**/*.projdata +/source/**/*.tvsconfig +/source/**/*.dsk /Packages/*.identcache -/Packages/*.res /Packages/*.stat /Packages/*.~dsk -/Packages/*.dproj /Packages/*.local /Packages/*.dsk + +# Delphi history and backups +__history/ +__recovery/ +*.~* + +# Castalia statistics file (since XE7 Castalia is distributed with Delphi) +*.stat + +# OS generated files # +###################### +.DS_Store +.DS_Store? +._* +.Spotlight-V100 +.Trashes +ehthumbs.db +Thumbs.db + diff --git a/Packages/EmbeddedWebBrowser_Berlin.dproj b/Packages/EmbeddedWebBrowser_Berlin.dproj new file mode 100644 index 0000000..4617ad0 --- /dev/null +++ b/Packages/EmbeddedWebBrowser_Berlin.dproj @@ -0,0 +1,554 @@ + + + {8D53994C-938C-46EB-95C9-3AB85113F99C} + EmbeddedWebBrowser_Berlin.dpk + True + Debug + 1025 + Package + VCL + 18.1 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + false + EmbeddedWebBrowser_Berlin + Internet Embedded Web Browser Components + false + true + true + false + 00400000 + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace) + 3081 + false + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + false + + + rtl;$(DCC_UsePackage) + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + android-support-v4.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services.dex.jar + Debug + + + rtl;$(DCC_UsePackage) + + + rtl;$(DCC_UsePackage) + + + rtl;$(DCC_UsePackage) + + + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + true + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + rtl;vcl;vclimg;$(DCC_UsePackage) + 1033 + + + rtl;vcl;vclimg;$(DCC_UsePackage) + + + false + 0 + RELEASE;$(DCC_Define) + 0 + + + false + true + DEBUG;$(DCC_Define) + + + Debug + + + + MainSource + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + Package + + + + EmbeddedWebBrowser_Berlin.dpk + + + + False + False + True + False + True + False + + + + + EmbeddedWebBrowser_Berlin.bpl + true + + + + + 0 + .dll;.bpl + + + 1 + .dylib + + + + + Contents\Resources + 1 + + + + + classes + 1 + + + + + Contents\MacOS + 0 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + res\drawable-xxhdpi + 1 + + + + + library\lib\mips + 1 + + + + + 1 + + + 1 + + + 0 + + + 1 + + + 1 + + + library\lib\armeabi-v7a + 1 + + + 1 + + + + + 0 + + + 1 + .framework + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + 1 + + + 1 + + + 1 + + + + + + library\lib\armeabi + 1 + + + + + 0 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + res\drawable-normal + 1 + + + + + res\drawable-xhdpi + 1 + + + + + res\drawable-large + 1 + + + + + 1 + + + 1 + + + 1 + + + + + + res\drawable-hdpi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + + + 1 + + + 1 + + + 1 + + + + + res\values + 1 + + + + + res\drawable-small + 1 + + + + + res\drawable + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + + + res\drawable + 1 + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 0 + .bpl + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + + + res\drawable-mdpi + 1 + + + + + res\drawable-xlarge + 1 + + + + + res\drawable-ldpi + 1 + + + + + + + + + + + + + + 12 + + + + + diff --git a/Packages/EmbeddedWebBrowser_Berlin.res b/Packages/EmbeddedWebBrowser_Berlin.res new file mode 100644 index 0000000000000000000000000000000000000000..3bb78759d0d01ec14176e4b53dd7e7aa7cd35082 GIT binary patch literal 448 zcmZ9IO-chn5QV>ySr}Iy!G&uXVK#zb0{#&2k7USJhD0SG8Ax>JVZ4a9aqkTrzwWV# zNkPq2cfI%ObpafhZQG^gM)b4P-xuS-DCp%0)Xz%G31c4oUNEv6a>uRbq2EjE5TE(? z4+MUvk^X0~3qde-{;v3lcVk{zGH1cFYI9zARC&P@js5qCDJXSyVwQRcjtX|wOZbVL zB`evD%n-*MiAjl^fWH^jFyoD>Q@2^$oO5+DQMIfzY3&RS + + {C99EC61E-403B-44FB-A005-65E3F99CFB6B} + EmbeddedWebBrowser_Tokyo.dpk + True + Debug + 1 + Package + VCL + 18.2 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + false + false + false + false + false + 00400000 + true + true + EmbeddedWebBrowser_Tokyo + Internet Embedded Web Browser Components + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace) + 3081 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + + + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + Debug + android-support-v4.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services.dex.jar + rtl;$(DCC_UsePackage) + + + rtl;$(DCC_UsePackage) + + + rtl;$(DCC_UsePackage) + + + rtl;$(DCC_UsePackage) + + + rtl;$(DCC_UsePackage) + + + Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + vclimg;vcl;rtl;EmbeddedWebBrowser_Tokyo;$(DCC_UsePackage) + + + vclimg;vcl;rtl;$(DCC_UsePackage) + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + DEBUG;$(DCC_Define) + false + true + + + true + 1033 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 3 + + + + MainSource + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + Package + + + + EmbeddedWebBrowser_Tokyo.dpk + + + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + False + False + False + False + False + True + False + + + 12 + + + + diff --git a/Packages/EmbeddedWebBrowser_Tokyo.res b/Packages/EmbeddedWebBrowser_Tokyo.res new file mode 100644 index 0000000000000000000000000000000000000000..034c5bd5b68bce89ae9a5b2934e43559cec6fe7a GIT binary patch literal 736 zcmbV~y-EX75QR^|7RJif&cenfMA$|UB$6lr|A--iO@7x9Og3U7;;Z;B`ZV^wf$KLD zuWs!0E^~MG&Y5%1&Wt2&VOh2`+?CZWhWG}Ug2yT5Da6R)9jo$=jZ zKf<^561{&&mcQf(?*orYMi?SrM|$O;0N+CQ8Y|TZwy`EkU`}Kz;V*Ip^W!X9vJW-Wi X*i1EbidW@*jJ6h2vRwJuw0Zgj8j@-5 literal 0 HcmV?d00001 From 4f3f995c4bdc80221b414f21a983692d853e88c2 Mon Sep 17 00:00:00 2001 From: Tristan Marlow Date: Tue, 5 Dec 2017 20:22:53 +0800 Subject: [PATCH 14/15] Removal of dproj files --- .gitignore | 1 + Packages/EmbeddedWebBrowser_Berlin.dproj | 554 ----------------------- Packages/EmbeddedWebBrowser_Tokyo.dproj | 233 ---------- 3 files changed, 1 insertion(+), 787 deletions(-) delete mode 100644 Packages/EmbeddedWebBrowser_Berlin.dproj delete mode 100644 Packages/EmbeddedWebBrowser_Tokyo.dproj diff --git a/.gitignore b/.gitignore index 2e593f2..d7d79f3 100644 --- a/.gitignore +++ b/.gitignore @@ -80,3 +80,4 @@ __recovery/ ehthumbs.db Thumbs.db +/Packages/*.dproj diff --git a/Packages/EmbeddedWebBrowser_Berlin.dproj b/Packages/EmbeddedWebBrowser_Berlin.dproj deleted file mode 100644 index 4617ad0..0000000 --- a/Packages/EmbeddedWebBrowser_Berlin.dproj +++ /dev/null @@ -1,554 +0,0 @@ - - - {8D53994C-938C-46EB-95C9-3AB85113F99C} - EmbeddedWebBrowser_Berlin.dpk - True - Debug - 1025 - Package - VCL - 18.1 - Win32 - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - false - EmbeddedWebBrowser_Berlin - Internet Embedded Web Browser Components - false - true - true - false - 00400000 - Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace) - 3081 - false - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= - false - - - rtl;$(DCC_UsePackage) - package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= - android-support-v4.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services.dex.jar - Debug - - - rtl;$(DCC_UsePackage) - - - rtl;$(DCC_UsePackage) - - - rtl;$(DCC_UsePackage) - - - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - true - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - rtl;vcl;vclimg;$(DCC_UsePackage) - 1033 - - - rtl;vcl;vclimg;$(DCC_UsePackage) - - - false - 0 - RELEASE;$(DCC_Define) - 0 - - - false - true - DEBUG;$(DCC_Define) - - - Debug - - - - MainSource - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - Delphi.Personality.12 - Package - - - - EmbeddedWebBrowser_Berlin.dpk - - - - False - False - True - False - True - False - - - - - EmbeddedWebBrowser_Berlin.bpl - true - - - - - 0 - .dll;.bpl - - - 1 - .dylib - - - - - Contents\Resources - 1 - - - - - classes - 1 - - - - - Contents\MacOS - 0 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-xxhdpi - 1 - - - - - library\lib\mips - 1 - - - - - 1 - - - 1 - - - 0 - - - 1 - - - 1 - - - library\lib\armeabi-v7a - 1 - - - 1 - - - - - 0 - - - 1 - .framework - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - 1 - - - 1 - - - 1 - - - - - - library\lib\armeabi - 1 - - - - - 0 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - res\drawable-normal - 1 - - - - - res\drawable-xhdpi - 1 - - - - - res\drawable-large - 1 - - - - - 1 - - - 1 - - - 1 - - - - - - res\drawable-hdpi - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - - - 1 - - - 1 - - - 1 - - - - - res\values - 1 - - - - - res\drawable-small - 1 - - - - - res\drawable - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - - - res\drawable - 1 - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - - - library\lib\armeabi-v7a - 1 - - - - - 0 - .bpl - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - - - res\drawable-mdpi - 1 - - - - - res\drawable-xlarge - 1 - - - - - res\drawable-ldpi - 1 - - - - - - - - - - - - - - 12 - - - - - diff --git a/Packages/EmbeddedWebBrowser_Tokyo.dproj b/Packages/EmbeddedWebBrowser_Tokyo.dproj deleted file mode 100644 index b09977d..0000000 --- a/Packages/EmbeddedWebBrowser_Tokyo.dproj +++ /dev/null @@ -1,233 +0,0 @@ - - - {C99EC61E-403B-44FB-A005-65E3F99CFB6B} - EmbeddedWebBrowser_Tokyo.dpk - True - Debug - 1 - Package - VCL - 18.2 - Win32 - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - false - false - false - false - false - 00400000 - true - true - EmbeddedWebBrowser_Tokyo - Internet Embedded Web Browser Components - Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace) - 3081 - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= - - - package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= - Debug - android-support-v4.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services.dex.jar - rtl;$(DCC_UsePackage) - - - rtl;$(DCC_UsePackage) - - - rtl;$(DCC_UsePackage) - - - rtl;$(DCC_UsePackage) - - - rtl;$(DCC_UsePackage) - - - Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - Debug - true - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) - 1033 - vclimg;vcl;rtl;EmbeddedWebBrowser_Tokyo;$(DCC_UsePackage) - - - vclimg;vcl;rtl;$(DCC_UsePackage) - - - RELEASE;$(DCC_Define) - 0 - false - 0 - - - DEBUG;$(DCC_Define) - false - true - - - true - 1033 - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) - 3 - - - - MainSource - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - Delphi.Personality.12 - Package - - - - EmbeddedWebBrowser_Tokyo.dpk - - - Microsoft Office 2000 Sample Automation Server Wrapper Components - Microsoft Office XP Sample Automation Server Wrapper Components - - - - False - False - False - False - False - True - False - - - 12 - - - - From 0ae71c62ef6a1257d603a77e1998af0845c848d0 Mon Sep 17 00:00:00 2001 From: Little Earth Solutions Date: Mon, 29 Nov 2021 17:08:36 +0800 Subject: [PATCH 15/15] Delphi Alexandria support --- Packages/10.4/EmbeddedWebBrowser.dpk | 76 ++ Packages/10.4/EmbeddedWebBrowser.dproj | 204 ++++ Packages/10.4/EmbeddedWebBrowser.dproj.local | 2 + Packages/10.4/EmbeddedWebBrowser.res | Bin 0 -> 700 bytes Packages/10.4/EmbeddedWebBrowserRuntime.dpk | 139 +++ Packages/10.4/EmbeddedWebBrowserRuntime.dproj | 306 ++++++ .../EmbeddedWebBrowserRuntime.dproj.local | 2 + Packages/10.4/EmbeddedWebBrowserRuntime.res | Bin 0 -> 736 bytes Packages/10.4/EmbeddedWebBrowser_Sydney.res | Bin 0 -> 724 bytes Packages/11.0/EmbeddedWebBrowser.dpk | 76 ++ Packages/11.0/EmbeddedWebBrowser.dproj | 864 ++++++++++++++++ Packages/11.0/EmbeddedWebBrowser.dproj.local | 2 + Packages/11.0/EmbeddedWebBrowser.res | Bin 0 -> 700 bytes Packages/11.0/EmbeddedWebBrowserRuntime.dpk | 139 +++ Packages/11.0/EmbeddedWebBrowserRuntime.dproj | 954 ++++++++++++++++++ .../EmbeddedWebBrowserRuntime.dproj.local | 2 + .../11.0/EmbeddedWebBrowserRuntime.identcache | Bin 0 -> 5889 bytes Packages/11.0/EmbeddedWebBrowserRuntime.res | Bin 0 -> 736 bytes Source/EWB_jedi.inc | 545 ++++++++-- Source/IEParser.pas | 2 +- Source/MenuContext.pas | 4 +- Source/Mshtml_Ewb.pas | 1 + Source/RichEditBrowser.pas | 2 +- 23 files changed, 3208 insertions(+), 112 deletions(-) create mode 100644 Packages/10.4/EmbeddedWebBrowser.dpk create mode 100644 Packages/10.4/EmbeddedWebBrowser.dproj create mode 100644 Packages/10.4/EmbeddedWebBrowser.dproj.local create mode 100644 Packages/10.4/EmbeddedWebBrowser.res create mode 100644 Packages/10.4/EmbeddedWebBrowserRuntime.dpk create mode 100644 Packages/10.4/EmbeddedWebBrowserRuntime.dproj create mode 100644 Packages/10.4/EmbeddedWebBrowserRuntime.dproj.local create mode 100644 Packages/10.4/EmbeddedWebBrowserRuntime.res create mode 100644 Packages/10.4/EmbeddedWebBrowser_Sydney.res create mode 100644 Packages/11.0/EmbeddedWebBrowser.dpk create mode 100644 Packages/11.0/EmbeddedWebBrowser.dproj create mode 100644 Packages/11.0/EmbeddedWebBrowser.dproj.local create mode 100644 Packages/11.0/EmbeddedWebBrowser.res create mode 100644 Packages/11.0/EmbeddedWebBrowserRuntime.dpk create mode 100644 Packages/11.0/EmbeddedWebBrowserRuntime.dproj create mode 100644 Packages/11.0/EmbeddedWebBrowserRuntime.dproj.local create mode 100644 Packages/11.0/EmbeddedWebBrowserRuntime.identcache create mode 100644 Packages/11.0/EmbeddedWebBrowserRuntime.res diff --git a/Packages/10.4/EmbeddedWebBrowser.dpk b/Packages/10.4/EmbeddedWebBrowser.dpk new file mode 100644 index 0000000..769fd78 --- /dev/null +++ b/Packages/10.4/EmbeddedWebBrowser.dpk @@ -0,0 +1,76 @@ +{*******************************************************} +{ Embedded Web Browser package Delphi Seattle } +{ } +{ For Delphi 5 - Seattle } +{ Freeware Components } +{ Please note our uses terms } +{ } +{ Enjoy! } +{ UPDATES: } +{ http://www.bsalsa.com } +{*******************************************************************************} +{LICENSE: +THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, +EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED +WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. +YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE +AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE +AND DOCUMENTATION. [YOUR NAME] DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE +OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED +OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, +INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR +OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, +AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. VSOFT SPECIFICALLY +DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. + +You may use, change or modify the component under 4 conditions: +1. In your website, add a link to "http://www.bsalsa.com" +2. In your application, add credits to "Embedded Web Browser" +3. Mail me (bsalsa@bsalsa.com) any code change in the unit + for the benefit of the other users. +4. Please, consider donation in our web site! +{*******************************************************************************} + +// JCL_DEBUG_EXPERT_GENERATEJDBG OFF +// JCL_DEBUG_EXPERT_INSERTJDBG OFF +// JCL_DEBUG_EXPERT_DELETEMAPFILE OFF +package EmbeddedWebBrowser; +{$R *.res} +{$R '..\..\Source\EWB.dcr'} +{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DEFINE RELEASE} +{$ENDIF IMPLICITBUILDING} +{$DESCRIPTION 'Internet Embedded Web Browser Components'} +{$LIBSUFFIX 'Sydney'} +{$IMPLICITBUILD ON} + +requires + designide, + EmbeddedWebBrowserRuntime; + +contains + EwbReg in '..\..\Source\EwbReg.pas', + EwbEditors in '..\..\Source\EwbEditors.pas'; + +end. diff --git a/Packages/10.4/EmbeddedWebBrowser.dproj b/Packages/10.4/EmbeddedWebBrowser.dproj new file mode 100644 index 0000000..1ca3011 --- /dev/null +++ b/Packages/10.4/EmbeddedWebBrowser.dproj @@ -0,0 +1,204 @@ + + + {5B98DC01-0DC6-40EE-B5FB-304407DA5FCE} + EmbeddedWebBrowser.dpk + True + Release + 1 + Package + VCL + 19.2 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + false + false + false + false + false + 00400000 + true + true + EmbeddedWebBrowser + Internet Embedded Web Browser Components + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace) + 3081 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + $(NUKEOBJECTS)\build\lib\$(Platform)\$(Config) + ..\source;$(DCC_UnitSearchPath) + $(NUKEOBJECTS)\build\dcp\$(Platform)\$(Config) + true + + + Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + vclimg;vcl;rtl;EmbeddedWebBrowserRuntime;$(DCC_UsePackage) + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + true + 1033 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 3 + Sydney + + + DEBUG;$(DCC_Define) + false + true + + + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + true + 1033 + 3 + + + + MainSource + + + + + + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + Package + + + + EmbeddedWebBrowser.dpk + + + + + True + False + + + + + EmbeddedWebBrowser.bpl + true + + + + + EmbeddedWebBrowser.bpl + true + + + + + 0 + + + + + 0 + + + + + 0 + + + + + 0 + .dll;.bpl + + + + + 0 + .bpl + + + + + 0 + + + + + 0 + + + + + 1 + + + + + Assets + 1 + + + + + Assets + 1 + + + + + + 12 + + + + + diff --git a/Packages/10.4/EmbeddedWebBrowser.dproj.local b/Packages/10.4/EmbeddedWebBrowser.dproj.local new file mode 100644 index 0000000..b3811b7 --- /dev/null +++ b/Packages/10.4/EmbeddedWebBrowser.dproj.local @@ -0,0 +1,2 @@ + + diff --git a/Packages/10.4/EmbeddedWebBrowser.res b/Packages/10.4/EmbeddedWebBrowser.res new file mode 100644 index 0000000000000000000000000000000000000000..17aca6a75803d3926b9bcafc8d7316c24e2b8349 GIT binary patch literal 700 zcmb7?!AiqG5QhJj9IPk77ZCJZBIF_zq|zz{ZKZ~KlqQX((57OmzKieT+j#d4jNfcr zO?%P}GdtOt`TyD3k)#8pC`!THSgpGE?-5gTzEF+82es-E=14cXLw7aA>S>@p|2_0M zwyn3|<5RNy62tGO&MO(9_k17em4h01YdvbFTvO0ynkxf2*S(emKD(GukwTpy5j9vv zeeIL$<2&T6lscRT@Mh%Zj;5=H61)>W)3@kEXGAXbLQaNdE7VQ}Z{*Hb6`W%=iSZ(s zjsM!=O!NfznwrM2W&h%h9PcL1Hv2YrqQf8VDHRxNPaVgba<2t-X71i&yeWRWyWO}+ z_x{!oL#y%PhTyyW`zq3rd(qgj=k#$-WVP>&;5}fp)Iy44mrh-(tr)BUGjxU3X1}1G Nm + + {CC40B5CF-1CCF-4EED-AA91-E21475D6D124} + EmbeddedWebBrowserRuntime.dpk + True + Release + 3 + Package + VCL + 19.2 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + false + false + false + false + false + 00400000 + true + true + EmbeddedWebBrowserRuntime + Internet Embedded Web Browser Components + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace) + 3081 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + $(NUKEOBJECTS)\build\lib\$(Platform)\$(Config) + ..\source;$(DCC_UnitSearchPath) + $(NUKEOBJECTS)\build\dcp\$(Platform)\$(Config) + true + + + Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + vclimg;vcl;rtl;$(DCC_UsePackage) + + + Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + true + 1033 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 3 + Sydney + Internet Embedded Web Browser + + + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + + + DEBUG;$(DCC_Define) + false + true + + + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + true + 1033 + 3 + + + + MainSource + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + Package + + + + EmbeddedWebBrowserRuntime.dpk + + + + + True + True + + + + + EmbeddedWebBrowserRuntime.bpl + true + + + + + EmbeddedWebBrowserRuntime.bpl + true + + + + + EmbeddedWebBrowserRuntime.bpl + true + + + + + 0 + + + + + 0 + + + + + 0 + + + + + 0 + .dll;.bpl + + + + + 0 + .bpl + + + + + 0 + + + + + 0 + + + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + + + 12 + + + + + diff --git a/Packages/10.4/EmbeddedWebBrowserRuntime.dproj.local b/Packages/10.4/EmbeddedWebBrowserRuntime.dproj.local new file mode 100644 index 0000000..b3811b7 --- /dev/null +++ b/Packages/10.4/EmbeddedWebBrowserRuntime.dproj.local @@ -0,0 +1,2 @@ + + diff --git a/Packages/10.4/EmbeddedWebBrowserRuntime.res b/Packages/10.4/EmbeddedWebBrowserRuntime.res new file mode 100644 index 0000000000000000000000000000000000000000..c254df8c0c0e4f081d556bb925ad634a6983df79 GIT binary patch literal 736 zcmbV~K}!Nr5Xb-89w=)-jH8?^o2 zY>!rN^<>7`H~;z1%$t#!THry$YKS?|jqcHH^|3m-R+sM% z`W)Mxx8UOn1(_%bc}@5 z;3~S)9?z8LA$7wZ;@rY#62*~ zs>FGuIv6j~QitGs#yLZe;OVGk`D5~=V5e5c2ycwv)#56s)6L)Oi>&t|--Oy@YVTTB zSH1ql8CuWloSU6*_U$^XuobQ=KZ)PTNe4Fd$X+Dlt>+-iv#A9i0qds|B+qwv!Amt2 X*-rI!h1Fy>7xWXcCB-T4<`!4qqy}qB literal 0 HcmV?d00001 diff --git a/Packages/10.4/EmbeddedWebBrowser_Sydney.res b/Packages/10.4/EmbeddedWebBrowser_Sydney.res new file mode 100644 index 0000000000000000000000000000000000000000..d2b4b297fb89b5c0bad35edf5c47f862c211e63a GIT binary patch literal 724 zcmbV~%}T>i5QR@l7S@$Jw=M*CB|H{*H!%I~ z#H(p{dc)jI?#!GyId>#!4=ak&aMxB^^YI;W0*ghehdwE-#kgJFs>j||2QSgJuJ}&a z&+y%P4?n*oS6^cI_lZR%2k0Z;M|$HR0B@-$O_Xa4+C)=jAm_T*oWxhli4-f+5f;Ot zWVB1I&u>w)(9m!m!JAN+x5v!mUVK72K}H7Ztoi zHOTQM6mUFl3~!`oI4n8q(>427|JeGk<889ovKm#@ZrjJ7nm;{I9)&IRMY2R)-H5NJgPRXp^M?L%q895zeMX`-?7iucCIqK*V SugPtk!z*Pn%2l05H$y9UyJqMB literal 0 HcmV?d00001 diff --git a/Packages/11.0/EmbeddedWebBrowser.dpk b/Packages/11.0/EmbeddedWebBrowser.dpk new file mode 100644 index 0000000..7173c19 --- /dev/null +++ b/Packages/11.0/EmbeddedWebBrowser.dpk @@ -0,0 +1,76 @@ +{*******************************************************} +{ Embedded Web Browser package Delphi Seattle } +{ } +{ For Delphi 5 - Seattle } +{ Freeware Components } +{ Please note our uses terms } +{ } +{ Enjoy! } +{ UPDATES: } +{ http://www.bsalsa.com } +{*******************************************************************************} +{LICENSE: +THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND, +EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED +WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. +YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE +AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE +AND DOCUMENTATION. [YOUR NAME] DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE +OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED +OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS, +INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR +OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SYSTEMS, +AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SYSTEMS. VSOFT SPECIFICALLY +DISCLAIMS ANY EXPRESS OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE. + +You may use, change or modify the component under 4 conditions: +1. In your website, add a link to "http://www.bsalsa.com" +2. In your application, add credits to "Embedded Web Browser" +3. Mail me (bsalsa@bsalsa.com) any code change in the unit + for the benefit of the other users. +4. Please, consider donation in our web site! +{*******************************************************************************} + +// JCL_DEBUG_EXPERT_GENERATEJDBG OFF +// JCL_DEBUG_EXPERT_INSERTJDBG OFF +// JCL_DEBUG_EXPERT_DELETEMAPFILE OFF +package EmbeddedWebBrowser; +{$R *.res} +{$R '..\..\Source\EWB.dcr'} +{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DEFINE RELEASE} +{$ENDIF IMPLICITBUILDING} +{$DESCRIPTION 'Internet Embedded Web Browser Components'} +{$LIBSUFFIX 'Alexandria'} +{$IMPLICITBUILD ON} + +requires + designide, + EmbeddedWebBrowserRuntime; + +contains + EwbReg in '..\..\Source\EwbReg.pas', + EwbEditors in '..\..\Source\EwbEditors.pas'; + +end. diff --git a/Packages/11.0/EmbeddedWebBrowser.dproj b/Packages/11.0/EmbeddedWebBrowser.dproj new file mode 100644 index 0000000..0227d20 --- /dev/null +++ b/Packages/11.0/EmbeddedWebBrowser.dproj @@ -0,0 +1,864 @@ + + + {5B98DC01-0DC6-40EE-B5FB-304407DA5FCE} + EmbeddedWebBrowser.dpk + True + Release + 1 + Package + VCL + 19.3 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + false + false + false + false + false + 00400000 + true + true + EmbeddedWebBrowser + Internet Embedded Web Browser Components + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace) + 3081 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + $(NUKEOBJECTS)\build\lib\$(Platform)\$(Config) + ..\source;$(DCC_UnitSearchPath) + $(NUKEOBJECTS)\build\dcp\$(Platform)\$(Config) + true + + + Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + vclimg;vcl;rtl;EmbeddedWebBrowserRuntime;$(DCC_UsePackage) + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + true + 1033 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 3 + Alexandria + + + DEBUG;$(DCC_Define) + false + true + + + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + true + 1033 + 3 + + + + MainSource + + + + + + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + Package + + + + EmbeddedWebBrowser.dpk + + + + + True + False + + + + + EmbeddedWebBrowser.bpl + true + + + + + EmbeddedWebBrowser.bpl + true + + + + + 1 + + + 0 + + + + + classes + 64 + + + classes + 64 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + 1 + + + 1 + + + 0 + + + + + 1 + .framework + + + 1 + .framework + + + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + + + + 1 + + + 1 + + + 1 + + + + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + + + + + + + + + + + + 12 + + + + + diff --git a/Packages/11.0/EmbeddedWebBrowser.dproj.local b/Packages/11.0/EmbeddedWebBrowser.dproj.local new file mode 100644 index 0000000..b3811b7 --- /dev/null +++ b/Packages/11.0/EmbeddedWebBrowser.dproj.local @@ -0,0 +1,2 @@ + + diff --git a/Packages/11.0/EmbeddedWebBrowser.res b/Packages/11.0/EmbeddedWebBrowser.res new file mode 100644 index 0000000000000000000000000000000000000000..17aca6a75803d3926b9bcafc8d7316c24e2b8349 GIT binary patch literal 700 zcmb7?!AiqG5QhJj9IPk77ZCJZBIF_zq|zz{ZKZ~KlqQX((57OmzKieT+j#d4jNfcr zO?%P}GdtOt`TyD3k)#8pC`!THSgpGE?-5gTzEF+82es-E=14cXLw7aA>S>@p|2_0M zwyn3|<5RNy62tGO&MO(9_k17em4h01YdvbFTvO0ynkxf2*S(emKD(GukwTpy5j9vv zeeIL$<2&T6lscRT@Mh%Zj;5=H61)>W)3@kEXGAXbLQaNdE7VQ}Z{*Hb6`W%=iSZ(s zjsM!=O!NfznwrM2W&h%h9PcL1Hv2YrqQf8VDHRxNPaVgba<2t-X71i&yeWRWyWO}+ z_x{!oL#y%PhTyyW`zq3rd(qgj=k#$-WVP>&;5}fp)Iy44mrh-(tr)BUGjxU3X1}1G Nm + + {CC40B5CF-1CCF-4EED-AA91-E21475D6D124} + EmbeddedWebBrowserRuntime.dpk + True + Release + 3 + Package + VCL + 19.3 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + false + false + false + false + false + 00400000 + true + true + EmbeddedWebBrowserRuntime + Internet Embedded Web Browser Components + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace) + 3081 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + $(NUKEOBJECTS)\build\lib\$(Platform)\$(Config) + ..\source;$(DCC_UnitSearchPath) + $(NUKEOBJECTS)\build\dcp\$(Platform)\$(Config) + true + + + Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + vclimg;vcl;rtl;$(DCC_UsePackage) + + + Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + true + 1033 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 3 + Alexandria + Internet Embedded Web Browser + + + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + + + DEBUG;$(DCC_Define) + false + true + + + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + true + 1033 + 3 + + + + MainSource + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + Package + + + + EmbeddedWebBrowserRuntime.dpk + + + + + True + True + + + + + EmbeddedWebBrowserRuntime.bpl + true + + + + + EmbeddedWebBrowserRuntime.bpl + true + + + + + EmbeddedWebBrowserRuntime.bpl + true + + + + + 1 + + + 0 + + + + + classes + 64 + + + classes + 64 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + 1 + + + 1 + + + 0 + + + + + 1 + .framework + + + 1 + .framework + + + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + + + + 1 + + + 1 + + + 1 + + + + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + + + + + + + + + + + + 12 + + + + + diff --git a/Packages/11.0/EmbeddedWebBrowserRuntime.dproj.local b/Packages/11.0/EmbeddedWebBrowserRuntime.dproj.local new file mode 100644 index 0000000..b3811b7 --- /dev/null +++ b/Packages/11.0/EmbeddedWebBrowserRuntime.dproj.local @@ -0,0 +1,2 @@ + + diff --git a/Packages/11.0/EmbeddedWebBrowserRuntime.identcache b/Packages/11.0/EmbeddedWebBrowserRuntime.identcache new file mode 100644 index 0000000000000000000000000000000000000000..67a508a3537c2691177ee6b49e663ee1abaf272e GIT binary patch literal 5889 zcmcIo%Wm5+5X=uXhoYw*3fLB13y_*Lvf~tRVNlY-VncHUlJev4yGl|UAeCISHDJKL z3|BMD*&Thmxw(0qecdE*0FCV)jNi;~-=d*kZezM<_=M#jsOS%zJXj<3M(j(dYpB=L zO@W=QU^7=5#K}*b!%9gHx2<%9eEIwwf5e@JnYY@_)hR^(H6C3Y%NZJPQD2@uJmtsu zQ!-_q-Bj8TdNm$8CC#j#%L7{F!G$Lj<4>5h?HbBeTa&)g6J+D@NrIKtVc`tGsrcTh zIs|5rlPX>!>WFNH3q{aVXyiemb$v&M)jy2qyVrA7c&p4VdV+jBd@5$LY9c3KXvBru zH5q;VVwqoM4IRt08sYFPUh!B{e*NKxHI|mEI=MbKuBU6#!(P)(Qq^d%E21$!Wg4N@3+e;fv zRt|Fd*=J$U%9i6hhD6O&`LutTtkIofV1H`y=-|s7bsY~T4t{Fo6L4y0Vt9thElwX! zZU!qR1$u$Q)?sMOH!H}&bRjweGY_h21d;zLaI|wUxY_mMhUGJmlZvI4v{q-h3(*-$ z??u(pxp>!O0MA|H_j+hRF|^|<-Dcn-Ctz5}QgJV>`!Bcjt7<)G)`YqiyviMui74JVl~xjz-b$5rQ)`B_*dJ7yHf0&&vw3 zZUFQ^h-Dz?C0=H-geXNZB;?E1-MeyeHeNpF>|@*g*=YI(nmW z&ZUvNc(Sa=`@@C!_ht*jD$-k9Z_M-xFXV`!GxMTP;=`GlL4xa&HW*QOa_2yBW6<_m u`a3UL80aC(e9c$GyAOkD_B(ik@#_SJ;!}}#+N*!@Ic!db6NsLV_L9G$3DgY$ literal 0 HcmV?d00001 diff --git a/Packages/11.0/EmbeddedWebBrowserRuntime.res b/Packages/11.0/EmbeddedWebBrowserRuntime.res new file mode 100644 index 0000000000000000000000000000000000000000..c254df8c0c0e4f081d556bb925ad634a6983df79 GIT binary patch literal 736 zcmbV~K}!Nr5Xb-89w=)-jH8?^o2 zY>!rN^<>7`H~;z1%$t#!THry$YKS?|jqcHH^|3m-R+sM% z`W)Mxx8UOn1(_%bc}@5 z;3~S)9?z8LA$7wZ;@rY#62*~ zs>FGuIv6j~QitGs#yLZe;OVGk`D5~=V5e5c2ycwv)#56s)6L)Oi>&t|--Oy@YVTTB zSH1ql8CuWloSU6*_U$^XuobQ=KZ)PTNe4Fd$X+Dlt>+-iv#A9i0qds|B+qwv!Amt2 X*-rI!h1Fy>7xWXcCB-T4<`!4qqy}qB literal 0 HcmV?d00001 diff --git a/Source/EWB_jedi.inc b/Source/EWB_jedi.inc index 2ed1ace..67611f9 100644 --- a/Source/EWB_jedi.inc +++ b/Source/EWB_jedi.inc @@ -122,78 +122,98 @@ Directive Description ------------------------------------------------------------------------------ - DELPHI1 Defined when compiling with Delphi 1 (Codename WASABI/MANGO) - DELPHI2 Defined when compiling with Delphi 2 (Codename POLARIS) - DELPHI3 Defined when compiling with Delphi 3 (Codename IVORY) - DELPHI4 Defined when compiling with Delphi 4 (Codename ALLEGRO) - DELPHI5 Defined when compiling with Delphi 5 (Codename ARGUS) - DELPHI6 Defined when compiling with Delphi 6 (Codename ILLIAD) - DELPHI7 Defined when compiling with Delphi 7 (Codename AURORA) - DELPHI8 Defined when compiling with Delphi 8 (Codename OCTANE) - DELPHI2005 Defined when compiling with Delphi 2005 (Codename DIAMONDBACK) - DELPHI9 Alias for DELPHI2005 - DELPHI10 Defined when compiling with Delphi 2006 (Codename DEXTER) - DELPHI2006 Alias for DELPHI10 - DELPHI11 Defined when compiling with Delphi 2007 for Win32 (Codename SPACELY) - DELPHI2007 Alias for DELPHI11 - DELPHI12 Defined when compiling with Delphi 2009 for Win32 (Codename TIBURON) - DELPHI2009 Alias for DELPHI12 - DELPHI14 Defined when compiling with Delphi 2010 for Win32 (Codename WEAVER) - DELPHI2010 Alias for DELPHI14 - DELPHI15 Defined when compiling with Delphi XE for Win32 (Codename FULCRUM) - DELPHIXE Alias for DELPHI15 - DELPHI16 Defined when compiling with Delphi XE2 for Win32 (Codename PULSAR) - DELPHIXE2 Alias for DELPHI16 - DELPHI17 Defined when compiling with Delphi XE3 for Win32 (Codename WATERDRAGON) - DELPHIXE3 Alias for DELPHI17 - DELPHI18 Defined when compiling with Delphi XE4 for Win32 (Codename QUINTESSENCE) - DELPHIXE4 Alias for DELPHI18 - DELPHI19 Defined when compiling with Delphi XE5 for Win32 (Codename ZEPHYR) - DELPHIXE5 Alias for DELPHI19 - DELPHI20 Defined when compiling with Delphi XE6 for Win32 (Codename PROTEUS) - DELPHIXE6 Alias for DELPHI20 - DELPHI21 Defined when compiling with Delphi XE7 for Win32 (Codename CARPATHIA) - DELPHIXE7 Alias for DELPHI21 - DELPHI22 Defined when compiling with Delphi XE8 for Win32 (Codename ELBRUS) - DELPHIXE8 Alias for DELPHI22 - DELPHI23 Defined when compiling with Delphi 10 for Win32 (Codename AITANA) - DELPHIX_SEATTLE Alias for DELPHI23 - DELPHI1_UP Defined when compiling with Delphi 1 or higher - DELPHI2_UP Defined when compiling with Delphi 2 or higher - DELPHI3_UP Defined when compiling with Delphi 3 or higher - DELPHI4_UP Defined when compiling with Delphi 4 or higher - DELPHI5_UP Defined when compiling with Delphi 5 or higher - DELPHI6_UP Defined when compiling with Delphi 6 or higher - DELPHI7_UP Defined when compiling with Delphi 7 or higher - DELPHI8_UP Defined when compiling with Delphi 8 or higher - DELPHI2005_UP Defined when compiling with Delphi 2005 or higher - DELPHI9_UP Alias for DELPHI2005_UP - DELPHI10_UP Defined when compiling with Delphi 2006 or higher - DELPHI2006_UP Alias for DELPHI10_UP - DELPHI11_UP Defined when compiling with Delphi 2007 for Win32 or higher - DELPHI2007_UP Alias for DELPHI11_UP - DELPHI12_UP Defined when compiling with Delphi 2009 for Win32 or higher - DELPHI2009_UP Alias for DELPHI12_UP - DELPHI14_UP Defined when compiling with Delphi 2010 for Win32 or higher - DELPHI2010_UP Alias for DELPHI14_UP - DELPHI15_UP Defined when compiling with Delphi XE for Win32 or higher - DELPHIXE_UP Alias for DELPHI15_UP - DELPHI16_UP Defined when compiling with Delphi XE2 for Win32 or higher - DELPHIXE2_UP Alias for DELPHI16_UP - DELPHI17_UP Defined when compiling with Delphi XE3 for Win32 or higher - DELPHIXE3_UP Alias for DELPHI17_UP - DELPHI18_UP Defined when compiling with Delphi XE4 for Win32 or higher - DELPHIXE4_UP Alias for DELPHI18_UP - DELPHI19_UP Defined when compiling with Delphi XE5 for Win32 or higher - DELPHIXE5_UP Alias for DELPHI19_UP - DELPHI20_UP Defined when compiling with Delphi XE6 for Win32 or higher - DELPHIXE6_UP Alias for DELPHI20_UP - DELPHI21_UP Defined when compiling with Delphi XE7 for Win32 or higher - DELPHIXE7_UP Alias for DELPHI21_UP - DELPHI22_UP Defined when compiling with Delphi XE8 for Win32 or higher - DELPHIXE8_UP Alias for DELPHI22_UP - DELPHI23_UP Defined when compiling with Delphi 10 for Win32 or higher - DELPHIX_SEATTLE_UP Alias for DELPHI23_UP + DELPHI1 Defined when compiling with Delphi 1 (Codename WASABI/MANGO) + DELPHI2 Defined when compiling with Delphi 2 (Codename POLARIS) + DELPHI3 Defined when compiling with Delphi 3 (Codename IVORY) + DELPHI4 Defined when compiling with Delphi 4 (Codename ALLEGRO) + DELPHI5 Defined when compiling with Delphi 5 (Codename ARGUS) + DELPHI6 Defined when compiling with Delphi 6 (Codename ILLIAD) + DELPHI7 Defined when compiling with Delphi 7 (Codename AURORA) + DELPHI8 Defined when compiling with Delphi 8 (Codename OCTANE) + DELPHI2005 Defined when compiling with Delphi 2005 (Codename DIAMONDBACK) + DELPHI9 Alias for DELPHI2005 + DELPHI10 Defined when compiling with Delphi 2006 (Codename DEXTER) + DELPHI2006 Alias for DELPHI10 + DELPHI11 Defined when compiling with Delphi 2007 for Win32 (Codename SPACELY) + DELPHI2007 Alias for DELPHI11 + DELPHI12 Defined when compiling with Delphi 2009 for Win32 (Codename TIBURON) + DELPHI2009 Alias for DELPHI12 + DELPHI14 Defined when compiling with Delphi 2010 for Win32 (Codename WEAVER) + DELPHI2010 Alias for DELPHI14 + DELPHI15 Defined when compiling with Delphi XE for Win32 (Codename FULCRUM) + DELPHIXE Alias for DELPHI15 + DELPHI16 Defined when compiling with Delphi XE2 for Win32 (Codename PULSAR) + DELPHIXE2 Alias for DELPHI16 + DELPHI17 Defined when compiling with Delphi XE3 for Win32 (Codename WATERDRAGON) + DELPHIXE3 Alias for DELPHI17 + DELPHI18 Defined when compiling with Delphi XE4 for Win32 (Codename QUINTESSENCE) + DELPHIXE4 Alias for DELPHI18 + DELPHI19 Defined when compiling with Delphi XE5 for Win32 (Codename ZEPHYR) + DELPHIXE5 Alias for DELPHI19 + DELPHI20 Defined when compiling with Delphi XE6 for Win32 (Codename PROTEUS) + DELPHIXE6 Alias for DELPHI20 + DELPHI21 Defined when compiling with Delphi XE7 for Win32 (Codename CARPATHIA) + DELPHIXE7 Alias for DELPHI21 + DELPHI22 Defined when compiling with Delphi XE8 for Win32 (Codename ELBRUS) + DELPHIXE8 Alias for DELPHI22 + DELPHI23 Defined when compiling with Delphi 10 for Win32 (Codename AITANA) + DELPHIX_SEATTLE Alias for DELPHI23 + DELPHI24 Defined when compiling with Delphi 10.1 for Win32 (Codename BIGBEN) + DELPHIX_BERLIN Alias for DELPHI24 + DELPHI25 Defined when compiling with Delphi 10.2 for Win32 (Codename GODZILLA) + DELPHIX_TOKYO Alias for DELPHI25 + DELPHI26 Defined when compiling with Delphi 10.3 for Win32 (Codename CARNIVAL) + DELPHIX_RIO Alias for DELPHI26 + DELPHI27 Defined when compiling with Delphi 10.4 for Win32 (Codename DENALI) + DELPHIX_SYDNEY Alias for DELPHI27 + DELPHI28 Defined when compiling with Delphi 11 for Win32 (Codename OLYMPUS) + DELPHIX_ALEXANDRIA Alias for DELPHI28 + DELPHI1_UP Defined when compiling with Delphi 1 or higher + DELPHI2_UP Defined when compiling with Delphi 2 or higher + DELPHI3_UP Defined when compiling with Delphi 3 or higher + DELPHI4_UP Defined when compiling with Delphi 4 or higher + DELPHI5_UP Defined when compiling with Delphi 5 or higher + DELPHI6_UP Defined when compiling with Delphi 6 or higher + DELPHI7_UP Defined when compiling with Delphi 7 or higher + DELPHI8_UP Defined when compiling with Delphi 8 or higher + DELPHI2005_UP Defined when compiling with Delphi 2005 or higher + DELPHI9_UP Alias for DELPHI2005_UP + DELPHI10_UP Defined when compiling with Delphi 2006 or higher + DELPHI2006_UP Alias for DELPHI10_UP + DELPHI11_UP Defined when compiling with Delphi 2007 for Win32 or higher + DELPHI2007_UP Alias for DELPHI11_UP + DELPHI12_UP Defined when compiling with Delphi 2009 for Win32 or higher + DELPHI2009_UP Alias for DELPHI12_UP + DELPHI14_UP Defined when compiling with Delphi 2010 for Win32 or higher + DELPHI2010_UP Alias for DELPHI14_UP + DELPHI15_UP Defined when compiling with Delphi XE for Win32 or higher + DELPHIXE_UP Alias for DELPHI15_UP + DELPHI16_UP Defined when compiling with Delphi XE2 for Win32 or higher + DELPHIXE2_UP Alias for DELPHI16_UP + DELPHI17_UP Defined when compiling with Delphi XE3 for Win32 or higher + DELPHIXE3_UP Alias for DELPHI17_UP + DELPHI18_UP Defined when compiling with Delphi XE4 for Win32 or higher + DELPHIXE4_UP Alias for DELPHI18_UP + DELPHI19_UP Defined when compiling with Delphi XE5 for Win32 or higher + DELPHIXE5_UP Alias for DELPHI19_UP + DELPHI20_UP Defined when compiling with Delphi XE6 for Win32 or higher + DELPHIXE6_UP Alias for DELPHI20_UP + DELPHI21_UP Defined when compiling with Delphi XE7 for Win32 or higher + DELPHIXE7_UP Alias for DELPHI21_UP + DELPHI22_UP Defined when compiling with Delphi XE8 for Win32 or higher + DELPHIXE8_UP Alias for DELPHI22_UP + DELPHI23_UP Defined when compiling with Delphi 10 for Win32 or higher + DELPHIX_SEATTLE_UP Alias for DELPHI23_UP + DELPHI24_UP Defined when compiling with Delphi 10.1 for Win32 or higher + DELPHIX_BERLIN_UP Alias for DELPHI24_UP + DELPHI25_UP Defined when compiling with Delphi 10.2 for Win32 or higher + DELPHIX_TOKYO_UP Alias for DELPHI25_UP + DELPHI26_UP Defined when compiling with Delphi 10.3 for Win32 or higher + DELPHIX_RIO_UP Alias for DELPHI26_UP + DELPHI27_UP Defined when compiling with Delphi 10.4 for Win32 or higher + DELPHIX_SYDNEY_UP Alias for DELPHI27_UP + DELPHI28_UP Defined when compiling with Delphi 11 for Win32 or higher + DELPHIX_ALEXANDRIA_UP Alias for DELPHI28_UP - Kylix Versions @@ -238,6 +258,11 @@ DELPHICOMPILER21 Defined when compiling with Delphi Personality of BDS 15.0 DELPHICOMPILER22 Defined when compiling with Delphi Personality of BDS 16.0 DELPHICOMPILER23 Defined when compiling with Delphi Personality of BDS 17.0 + DELPHICOMPILER24 Defined when compiling with Delphi Personality of BDS 18.0 + DELPHICOMPILER25 Defined when compiling with Delphi Personality of BDS 19.0 + DELPHICOMPILER26 Defined when compiling with Delphi Personality of BDS 20.0 + DELPHICOMPILER27 Defined when compiling with Delphi Personality of BDS 21.0 + DELPHICOMPILER28 Defined when compiling with Delphi Personality of BDS 22.0 DELPHICOMPILER1_UP Defined when compiling with Delphi 1 or higher DELPHICOMPILER2_UP Defined when compiling with Delphi 2 or higher DELPHICOMPILER3_UP Defined when compiling with Delphi 3 or higher @@ -260,6 +285,11 @@ DELPHICOMPILER21_UP Defined when compiling with Delphi XE7 for Win32 or higher DELPHICOMPILER22_UP Defined when compiling with Delphi XE8 for Win32 or higher DELPHICOMPILER23_UP Defined when compiling with Delphi 10 for Win32 or higher + DELPHICOMPILER24_UP Defined when compiling with Delphi 10.1 for Win32 or higher + DELPHICOMPILER25_UP Defined when compiling with Delphi 10.2 for Win32 or higher + DELPHICOMPILER26_UP Defined when compiling with Delphi 10.3 for Win32 or higher + DELPHICOMPILER27_UP Defined when compiling with Delphi 10.4 for Win32 or higher + DELPHICOMPILER28_UP Defined when compiling with Delphi 11 for Win32 or higher - C++Builder Versions @@ -288,6 +318,11 @@ BCB21 Defined when compiling with C++Builder Personality of RAD Studio XE7 (also known as C++Builder XE7) (Codename CARPATHIA) BCB22 Defined when compiling with C++Builder Personality of RAD Studio XE8 (also known as C++Builder XE8) (Codename ELBRUS) BCB23 Defined when compiling with C++Builder Personality of RAD Studio 10 Seattle (also known as C++Builder 10 Seattle) (Codename AITANA) + BCB24 Defined when compiling with C++Builder Personality of RAD Studio 10.1 Berlin (also known as C++Builder 10.1 Berlin) (Codename BIGBEN) + BCB25 Defined when compiling with C++Builder Personality of RAD Studio 10.2 Tokyo (also known as C++Builder 10.2 Tokyo) (Codename GODZILLA) + BCB26 Defined when compiling with C++Builder Personality of RAD Studio 10.3 Rio (also known as C++Builder 10.3) (Codename CARNIVAL) + BCB27 Defined when compiling with C++Builder Personality of RAD Studio 10.4 Rio (also known as C++Builder 10.4) (Codename DENALI) + BCB28 Defined when compiling with C++Builder Personality of RAD Studio 11 (also known as C++Builder 11) (Codename OLYMPUS) BCB1_UP Defined when compiling with C++Builder 1 or higher BCB3_UP Defined when compiling with C++Builder 3 or higher BCB4_UP Defined when compiling with C++Builder 4 or higher @@ -306,6 +341,11 @@ BCB21_UP Defined when compiling with C++Builder Personality of RAD Studio XE7 or higher BCB22_UP Defined when compiling with C++Builder Personality of RAD Studio XE8 or higher BCB23_UP Defined when compiling with C++Builder Personality of RAD Studio 10 or higher + BCB24_UP Defined when compiling with C++Builder Personality of RAD Studio 10.1 or higher + BCB25_UP Defined when compiling with C++Builder Personality of RAD Studio 10.2 or higher + BCB26_UP Defined when compiling with C++Builder Personality of RAD Studio 10.3 or higher + BCB27_UP Defined when compiling with C++Builder Personality of RAD Studio 10.4 or higher + BCB28_UP Defined when compiling with C++Builder Personality of RAD Studio 11 or higher - RAD Studio / Borland Developer Studio Versions @@ -335,6 +375,11 @@ BDS15 Defined when compiling with BDS 15.0 (Embarcadero RAD Studio XE7) (Codename CARPATHIA) BDS16 Defined when compiling with BDS 16.0 (Embarcadero RAD Studio XE8) (Codename ELBRUS) BDS17 Defined when compiling with BDS 17.0 (Embarcadero RAD Studio 10) (Codename AITANA) + BDS18 Defined when compiling with BDS 18.0 (Embarcadero RAD Studio 10.1) (Codename BIGBEN) + BDS19 Defined when compiling with BDS 19.0 (Embarcadero RAD Studio 10.2) (Codename GODZILLA) + BDS20 Defined when compiling with BDS 20.0 (Embarcadero RAD Studio 10.3) (Codename CARNIVAL) + BDS21 Defined when compiling with BDS 21.0 (Embarcadero RAD Studio 10.4) (Codename DENALI) + BDS22 Defined when compiling with BDS 22.0 (Embarcadero RAD Studio 11) (Codename OLYMPUS) BDS2_UP Defined when compiling with BDS 2.0 or higher BDS3_UP Defined when compiling with BDS 3.0 or higher BDS4_UP Defined when compiling with BDS 4.0 or higher @@ -350,6 +395,11 @@ BDS15_UP Defined when compiling with BDS 15.0 or higher BDS16_UP Defined when compiling with BDS 16.0 or higher BDS17_UP Defined when compiling with BDS 17.0 or higher + BDS18_UP Defined when compiling with BDS 18.0 or higher + BDS19_UP Defined when compiling with BDS 19.0 or higher + BDS20_UP Defined when compiling with BDS 20.0 or higher + BDS21_UP Defined when compiling with BDS 21.0 or higher + BDS22_UP Defined when compiling with BDS 22.0 or higher - Compiler Versions @@ -384,6 +434,11 @@ COMPILER21 Defined when compiling with Delphi or C++Builder Personalities of BDS 15.0 COMPILER22 Defined when compiling with Delphi or C++Builder Personalities of BDS 16.0 COMPILER23 Defined when compiling with Delphi or C++Builder Personalities of BDS 17.0 + COMPILER24 Defined when compiling with Delphi or C++Builder Personalities of BDS 18.0 + COMPILER25 Defined when compiling with Delphi or C++Builder Personalities of BDS 19.0 + COMPILER26 Defined when compiling with Delphi or C++Builder Personalities of BDS 20.0 + COMPILER27 Defined when compiling with Delphi or C++Builder Personalities of BDS 21.0 + COMPILER28 Defined when compiling with Delphi or C++Builder Personalities of BDS 22.0 COMPILER1_UP Defined when compiling with Delphi 1 or higher COMPILER2_UP Defined when compiling with Delphi 2 or C++Builder 1 or higher COMPILER3_UP Defined when compiling with Delphi 3 or higher @@ -407,6 +462,11 @@ COMPILER21_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 15.0 or higher COMPILER22_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 16.0 or higher COMPILER23_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 17.0 or higher + COMPILER24_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 18.0 or higher + COMPILER25_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 19.0 or higher + COMPILER26_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 20.0 or higher + COMPILER27_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 21.0 or higher + COMPILER28_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 22.0 or higher - RTL Versions @@ -447,6 +507,11 @@ RTL280_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 15.0 or higher RTL290_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 16.0 or higher RTL300_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 17.0 or higher + RTL310_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 18.0 or higher + RTL320_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 19.0 or higher + RTL330_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 20.0 or higher + RTL340_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 21.0 or higher + RTL350_UP Defined when compiling with Delphi or C++Builder Personalities of BDS 22.0 or higher - CLR Versions @@ -514,6 +579,9 @@ SUPPORTS_FINAL Compiler supports final keyword (D9.NET, D10+) SUPPORTS_METHODINFO Compiler supports the METHODINFO directives (D10+) SUPPORTS_GENERICS Compiler supports generic implementations (D11.NET, D12+) + SUPPORTS_GENERIC_TYPES Compiler supports generic implementations of types (D11.NET, D12+, FPC) + SUPPORTS_GENERIC_METHODS Compiler supports generic implementations of methods (D11.NET, D12+, FPC) + SUPPORTS_GENERIC_ROUTINES Compiler supports generic implementations of global functions/procedures (FPC) SUPPORTS_DEPRECATED_DETAILS Compiler supports additional text for the deprecated directive (D11.NET, D12+) ACCEPT_DEPRECATED Compiler supports or ignores the deprecated directive (D6+/BCB6+/FPC) ACCEPT_PLATFORM Compiler supports or ignores the platform directive (D6+/BCB6+/FPC) @@ -558,6 +626,9 @@ HAS_UNIT_VCL_THEMES Unit Vcl.Themes is available (D16+) HAS_UNIT_UXTHEME Unit (Vcl.)UxTheme is available (D7+) HAS_EXCEPTION_STACKTRACE Exception class has the StackTrace propery (D12+) + SUPPORTS_LEGACYIFEND Compiler supports the LEGACYIFEND directive (D17+) + DEPRECATED_TCHARACTER TCharacter is deprecated and replaced by a record helper on Char (D18+) + HAS_PROPERTY_OLDCREATEORDER The OldCreateOrder property is available (D5 - D27) - Compiler Settings @@ -603,23 +674,28 @@ {$IFDEF BORLAND} {$IFDEF LINUX} + {$IFDEF VER140} // Only under Delphi 6, LINUX implies Kylix {$DEFINE KYLIX} + {$ENDIF} {$ENDIF LINUX} {$IFNDEF CLR} {$IFNDEF CPUX86} + // CPUX86 is not defined, which means it most likely is a 64 bits compiler. + // However, this is only the case if either of two other symbols are defined: + // http://docwiki.embarcadero.com/RADStudio/Seattle/en/Conditional_compilation_%28Delphi%29 + {$DEFINE CPU64} + {$DEFINE DELPHI64_TEMPORARY} {$IFNDEF CPUX64} - {$DEFINE CPU386} // For Borland compilers select the x86 compat assembler by default - {$DEFINE CPU32} // Assume Borland compilers are 32-bit (rather than 64-bit) - {$DEFINE CPUASM} - {$ELSE ~CPUX64} - {$DEFINE CPU64} - {$DEFINE CPUASM} - {$DEFINE DELPHI64_TEMPORARY} + {$IFNDEF CPU64BITS} + {$DEFINE CPU386} // None of the two 64-bits symbols are defined, assume this is 32-bit + {$DEFINE CPU32} + {$UNDEF CPU64} + {$UNDEF DELPHI64_TEMPORARY} + {$ENDIF ~CPU64BITS} {$ENDIF ~CPUX64} {$ELSE ~CPUX86} {$DEFINE CPU386} {$DEFINE CPU32} - {$DEFINE CPUASM} {$ENDIF ~CPUX86} {$ENDIF ~CLR} {$ENDIF BORLAND} @@ -965,20 +1041,94 @@ {$ENDIF BCB} {$DEFINE RTL300_UP} {$UNDEF UNKNOWN_COMPILER_VERSION} - {$ENDIF VER290} + {$ENDIF VER300} + + {$IFDEF VER310} // RAD Studio 10.1 + {$DEFINE BDS} + {$DEFINE BDS18} + {$DEFINE COMPILER24} + {$IFDEF BCB} + {$DEFINE BCB24} + {$ELSE} + {$DEFINE DELPHI24} + {$DEFINE DELPHIX_BERLIN} // synonym to DELPHI24 + {$DEFINE DELPHICOMPILER24} + {$ENDIF BCB} + {$DEFINE RTL310_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER310} + + {$IFDEF VER320} // RAD Studio 10.2 + {$DEFINE BDS} + {$DEFINE BDS19} + {$DEFINE COMPILER25} + {$IFDEF BCB} + {$DEFINE BCB25} + {$ELSE} + {$DEFINE DELPHI25} + {$DEFINE DELPHIX_TOKYO} // synonym to DELPHI25 + {$DEFINE DELPHICOMPILER25} + {$ENDIF BCB} + {$DEFINE RTL320_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER320} + + {$IFDEF VER330} // RAD Studio 10.3 + {$DEFINE BDS} + {$DEFINE BDS20} + {$DEFINE COMPILER26} + {$IFDEF BCB} + {$DEFINE BCB26} + {$ELSE} + {$DEFINE DELPHI26} + {$DEFINE DELPHIX_RIO} // synonym to DELPHI26 + {$DEFINE DELPHICOMPILER26} + {$ENDIF BCB} + {$DEFINE RTL330_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER330} + + {$IFDEF VER340} // RAD Studio 10.4 + {$DEFINE BDS} + {$DEFINE BDS21} + {$DEFINE COMPILER27} + {$IFDEF BCB} + {$DEFINE BCB27} + {$ELSE} + {$DEFINE DELPHI27} + {$DEFINE DELPHIX_SYDNEY} // synonym to DELPHI27 + {$DEFINE DELPHICOMPILER27} + {$ENDIF BCB} + {$DEFINE RTL340_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER340} + + {$IFDEF VER350} // RAD Studio 11 + {$DEFINE BDS} + {$DEFINE BDS22} + {$DEFINE COMPILER28} + {$IFDEF BCB} + {$DEFINE BCB28} + {$ELSE} + {$DEFINE DELPHI28} + {$DEFINE DELPHIX_ALEXANDRIA} // synonym to DELPHI28 + {$DEFINE DELPHICOMPILER28} + {$ENDIF BCB} + {$DEFINE RTL350_UP} + {$UNDEF UNKNOWN_COMPILER_VERSION} + {$ENDIF VER350} {$IFDEF UNKNOWN_COMPILER_VERSION} // adjust for newer version (always use latest version) {$DEFINE BDS} - {$DEFINE BDS17} - {$DEFINE COMPILER23} + {$DEFINE BDS22} + {$DEFINE COMPILER28} {$IFDEF BCB} - {$DEFINE BCB23} + {$DEFINE BCB28} {$ELSE} - {$DEFINE DELPHI23} - {$DEFINE DELPHIX_SEATTLE} // synonym to DELPHI23 - {$DEFINE DELPHICOMPILER23} + {$DEFINE DELPHI28} + {$DEFINE DELPHICOMPILER28} {$ENDIF BCB} - {$DEFINE RTL300_UP} + {$DEFINE RTL350_UP} {$UNDEF UNKNOWN_COMPILER_VERSION} {$ENDIF} @@ -998,6 +1148,11 @@ { DELPHIX_UP from DELPHIX mappings } {------------------------------------------------------------------------------} +{$IFDEF DELPHI28} {$DEFINE DELPHI28_UP} {$ENDIF} +{$IFDEF DELPHI27} {$DEFINE DELPHI27_UP} {$ENDIF} +{$IFDEF DELPHI26} {$DEFINE DELPHI26_UP} {$ENDIF} +{$IFDEF DELPHI25} {$DEFINE DELPHI25_UP} {$ENDIF} +{$IFDEF DELPHI24} {$DEFINE DELPHI24_UP} {$ENDIF} {$IFDEF DELPHI23} {$DEFINE DELPHI23_UP} {$ENDIF} {$IFDEF DELPHI22} {$DEFINE DELPHI22_UP} {$ENDIF} {$IFDEF DELPHI21} {$DEFINE DELPHI21_UP} {$ENDIF} @@ -1025,6 +1180,31 @@ { DELPHIX_UP from DELPHIX_UP mappings } {------------------------------------------------------------------------------} +{$IFDEF DELPHI28_UP} + {$DEFINE DELPHIX_ALEXANDRIA_UP} // synonym to DELPHI28_UP + {$DEFINE DELPHI27_UP} +{$ENDIF} + +{$IFDEF DELPHI27_UP} + {$DEFINE DELPHIX_SYDNEY_UP} // synonym to DELPHI27_UP + {$DEFINE DELPHI26_UP} +{$ENDIF} + +{$IFDEF DELPHI26_UP} + {$DEFINE DELPHIX_RIO_UP} // synonym to DELPHI26_UP + {$DEFINE DELPHI25_UP} +{$ENDIF} + +{$IFDEF DELPHI25_UP} + {$DEFINE DELPHIX_TOKYO_UP} // synonym to DELPHI25_UP + {$DEFINE DELPHI24_UP} +{$ENDIF} + +{$IFDEF DELPHI24_UP} + {$DEFINE DELPHIX_BERLIN_UP} // synonym to DELPHI24_UP + {$DEFINE DELPHI23_UP} +{$ENDIF} + {$IFDEF DELPHI23_UP} {$DEFINE DELPHIX_SEATTLE_UP} // synonym to DELPHI23_UP {$DEFINE DELPHI22_UP} @@ -1107,6 +1287,11 @@ { BCBX_UP from BCBX mappings } {------------------------------------------------------------------------------} +{$IFDEF BCB28} {$DEFINE BCB28_UP} {$ENDIF} +{$IFDEF BCB27} {$DEFINE BCB27_UP} {$ENDIF} +{$IFDEF BCB26} {$DEFINE BCB26_UP} {$ENDIF} +{$IFDEF BCB25} {$DEFINE BCB25_UP} {$ENDIF} +{$IFDEF BCB24} {$DEFINE BCB24_UP} {$ENDIF} {$IFDEF BCB23} {$DEFINE BCB23_UP} {$ENDIF} {$IFDEF BCB22} {$DEFINE BCB22_UP} {$ENDIF} {$IFDEF BCB21} {$DEFINE BCB21_UP} {$ENDIF} @@ -1130,6 +1315,11 @@ { BCBX_UP from BCBX_UP mappings } {------------------------------------------------------------------------------} +{$IFDEF BCB28_UP} {$DEFINE BCB27_UP} {$ENDIF} +{$IFDEF BCB27_UP} {$DEFINE BCB26_UP} {$ENDIF} +{$IFDEF BCB26_UP} {$DEFINE BCB25_UP} {$ENDIF} +{$IFDEF BCB25_UP} {$DEFINE BCB24_UP} {$ENDIF} +{$IFDEF BCB24_UP} {$DEFINE BCB23_UP} {$ENDIF} {$IFDEF BCB23_UP} {$DEFINE BCB22_UP} {$ENDIF} {$IFDEF BCB22_UP} {$DEFINE BCB21_UP} {$ENDIF} {$IFDEF BCB21_UP} {$DEFINE BCB20_UP} {$ENDIF} @@ -1152,6 +1342,11 @@ { BDSX_UP from BDSX mappings } {------------------------------------------------------------------------------} +{$IFDEF BDS22} {$DEFINE BDS22_UP} {$ENDIF} +{$IFDEF BDS21} {$DEFINE BDS21_UP} {$ENDIF} +{$IFDEF BDS20} {$DEFINE BDS20_UP} {$ENDIF} +{$IFDEF BDS19} {$DEFINE BDS19_UP} {$ENDIF} +{$IFDEF BDS18} {$DEFINE BDS18_UP} {$ENDIF} {$IFDEF BDS17} {$DEFINE BDS17_UP} {$ENDIF} {$IFDEF BDS16} {$DEFINE BDS16_UP} {$ENDIF} {$IFDEF BDS15} {$DEFINE BDS15_UP} {$ENDIF} @@ -1172,6 +1367,11 @@ { BDSX_UP from BDSX_UP mappings } {------------------------------------------------------------------------------} +{$IFDEF BDS22_UP} {$DEFINE BDS21_UP} {$ENDIF} +{$IFDEF BDS21_UP} {$DEFINE BDS20_UP} {$ENDIF} +{$IFDEF BDS20_UP} {$DEFINE BDS19_UP} {$ENDIF} +{$IFDEF BDS19_UP} {$DEFINE BDS18_UP} {$ENDIF} +{$IFDEF BDS18_UP} {$DEFINE BDS17_UP} {$ENDIF} {$IFDEF BDS17_UP} {$DEFINE BDS16_UP} {$ENDIF} {$IFDEF BDS16_UP} {$DEFINE BDS15_UP} {$ENDIF} {$IFDEF BDS15_UP} {$DEFINE BDS14_UP} {$ENDIF} @@ -1191,6 +1391,11 @@ { DELPHICOMPILERX_UP from DELPHICOMPILERX mappings } {------------------------------------------------------------------------------} +{$IFDEF DELPHICOMPILER28} {$DEFINE DELPHICOMPILER28_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER27} {$DEFINE DELPHICOMPILER27_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER26} {$DEFINE DELPHICOMPILER26_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER25} {$DEFINE DELPHICOMPILER25_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER24} {$DEFINE DELPHICOMPILER24_UP} {$ENDIF} {$IFDEF DELPHICOMPILER23} {$DEFINE DELPHICOMPILER23_UP} {$ENDIF} {$IFDEF DELPHICOMPILER22} {$DEFINE DELPHICOMPILER22_UP} {$ENDIF} {$IFDEF DELPHICOMPILER21} {$DEFINE DELPHICOMPILER21_UP} {$ENDIF} @@ -1218,6 +1423,11 @@ { DELPHICOMPILERX_UP from DELPHICOMPILERX_UP mappings } {------------------------------------------------------------------------------} +{$IFDEF DELPHICOMPILER28_UP} {$DEFINE DELPHICOMPILER27_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER27_UP} {$DEFINE DELPHICOMPILER26_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER26_UP} {$DEFINE DELPHICOMPILER25_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER25_UP} {$DEFINE DELPHICOMPILER24_UP} {$ENDIF} +{$IFDEF DELPHICOMPILER24_UP} {$DEFINE DELPHICOMPILER23_UP} {$ENDIF} {$IFDEF DELPHICOMPILER23_UP} {$DEFINE DELPHICOMPILER22_UP} {$ENDIF} {$IFDEF DELPHICOMPILER22_UP} {$DEFINE DELPHICOMPILER21_UP} {$ENDIF} {$IFDEF DELPHICOMPILER21_UP} {$DEFINE DELPHICOMPILER20_UP} {$ENDIF} @@ -1245,6 +1455,11 @@ { COMPILERX_UP from COMPILERX mappings } {------------------------------------------------------------------------------} +{$IFDEF COMPILER28} {$DEFINE COMPILER28_UP} {$ENDIF} +{$IFDEF COMPILER27} {$DEFINE COMPILER27_UP} {$ENDIF} +{$IFDEF COMPILER26} {$DEFINE COMPILER26_UP} {$ENDIF} +{$IFDEF COMPILER25} {$DEFINE COMPILER25_UP} {$ENDIF} +{$IFDEF COMPILER24} {$DEFINE COMPILER24_UP} {$ENDIF} {$IFDEF COMPILER23} {$DEFINE COMPILER23_UP} {$ENDIF} {$IFDEF COMPILER22} {$DEFINE COMPILER22_UP} {$ENDIF} {$IFDEF COMPILER21} {$DEFINE COMPILER21_UP} {$ENDIF} @@ -1273,6 +1488,11 @@ { COMPILERX_UP from COMPILERX_UP mappings } {------------------------------------------------------------------------------} +{$IFDEF COMPILER28_UP} {$DEFINE COMPILER27_UP} {$ENDIF} +{$IFDEF COMPILER27_UP} {$DEFINE COMPILER26_UP} {$ENDIF} +{$IFDEF COMPILER26_UP} {$DEFINE COMPILER25_UP} {$ENDIF} +{$IFDEF COMPILER25_UP} {$DEFINE COMPILER24_UP} {$ENDIF} +{$IFDEF COMPILER24_UP} {$DEFINE COMPILER23_UP} {$ENDIF} {$IFDEF COMPILER23_UP} {$DEFINE COMPILER22_UP} {$ENDIF} {$IFDEF COMPILER22_UP} {$DEFINE COMPILER21_UP} {$ENDIF} {$IFDEF COMPILER21_UP} {$DEFINE COMPILER20_UP} {$ENDIF} @@ -1300,6 +1520,11 @@ { RTLX_UP from RTLX_UP mappings } {------------------------------------------------------------------------------} +{$IFDEF RTL350_UP} {$DEFINE RTL340_UP} {$ENDIF} +{$IFDEF RTL340_UP} {$DEFINE RTL330_UP} {$ENDIF} +{$IFDEF RTL330_UP} {$DEFINE RTL320_UP} {$ENDIF} +{$IFDEF RTL320_UP} {$DEFINE RTL310_UP} {$ENDIF} +{$IFDEF RTL310_UP} {$DEFINE RTL300_UP} {$ENDIF} {$IFDEF RTL300_UP} {$DEFINE RTL290_UP} {$ENDIF} {$IFDEF RTL290_UP} {$DEFINE RTL280_UP} {$ENDIF} {$IFDEF RTL280_UP} {$DEFINE RTL270_UP} {$ENDIF} @@ -1400,15 +1625,26 @@ {$IFDEF VER1_0} Please use FPC 2.0 or higher to compile this. {$ELSE} + { FPC_FULLVERSION is available from 2.2.4 on } + {$DEFINE SUPPORTS_OUTPARAMS} {$DEFINE SUPPORTS_WIDECHAR} {$DEFINE SUPPORTS_WIDESTRING} - {$IFDEF HASINTF} + {$IF DEFINED(VER2_0) OR DEFINED(VER2_1)} + {$IFDEF HASINTF} + {$DEFINE SUPPORTS_INTERFACE} + {$ENDIF} + {$IFDEF HASVARIANT} + {$DEFINE SUPPORTS_VARIANT} + {$ENDIF} + {$IFDEF HASCURRENCY} + {$DEFINE SUPPORTS_CURRENCY} + {$ENDIF} + {$ELSE} {$DEFINE SUPPORTS_INTERFACE} - {$ENDIF} - {$IFDEF HASVARIANT} {$DEFINE SUPPORTS_VARIANT} - {$ENDIF} + {$DEFINE SUPPORTS_CURRENCY} + {$IFEND} {$IFDEF FPC_HAS_TYPE_SINGLE} {$DEFINE SUPPORTS_SINGLE} {$ENDIF} @@ -1418,9 +1654,6 @@ {$IFDEF FPC_HAS_TYPE_EXTENDED} {$DEFINE SUPPORTS_EXTENDED} {$ENDIF} - {$IFDEF HASCURRENCY} - {$DEFINE SUPPORTS_CURRENCY} - {$ENDIF} {$DEFINE SUPPORTS_THREADVAR} {$DEFINE SUPPORTS_CONSTPARAMS} {$DEFINE SUPPORTS_LONGWORD} @@ -1431,15 +1664,26 @@ {$DEFINE ACCEPT_DEPRECATED} // 2.2 also gives warnings {$DEFINE ACCEPT_PLATFORM} // 2.2 also gives warnings {$DEFINE ACCEPT_LIBRARY} + {$DEFINE SUPPORTS_DEPRECATED} + {$DEFINE SUPPORTS_PLATFORM} + {$DEFINE SUPPORTS_LIBRARY} + {$DEFINE SUPPORTS_DEPRECATED_WARNINGS} + {$DEFINE SUPPORTS_PLATFORM_WARNINGS} {$DEFINE SUPPORTS_EXTSYM} {$DEFINE SUPPORTS_NODEFINE} + {$DEFINE SUPPORTS_DISPINTERFACE} + {$DEFINE SUPPORTS_IMPLEMENTS} + {$DEFINE SUPPORTS_DISPID} + {$DEFINE SUPPORTS_INLINE} + {$DEFINE SUPPORTS_STATIC} + {$DEFINE SUPPORTS_COMPILETIME_MESSAGES} {$DEFINE SUPPORTS_CUSTOMVARIANTS} {$DEFINE SUPPORTS_VARARGS} {$DEFINE SUPPORTS_ENUMVALUE} - {$IFDEF LINUX} + {$IF DEFINED(LINUX) AND DEFINED(CPU386)} {$DEFINE HAS_UNIT_LIBC} - {$ENDIF LINUX} + {$IFEND} {$DEFINE HAS_UNIT_CONTNRS} {$DEFINE HAS_UNIT_TYPES} {$DEFINE HAS_UNIT_VARIANTS} @@ -1449,15 +1693,68 @@ {$DEFINE XPLATFORM_RTL} - {$IFDEF VER2_2} - {$DEFINE SUPPORTS_DISPINTERFACE} - {$DEFINE SUPPORTS_IMPLEMENTS} - {$DEFINE SUPPORTS_DISPID} + {$IF DEFINED(FPC_FULLVERSION)} + { 2.2.4 or newer } + + {$DEFINE SUPPORTS_SETPEFLAGS} + {$DEFINE SUPPORTS_STRICT} + + {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 20400)} + {$DEFINE SUPPORTS_UINT64} + {$DEFINE SUPPORTS_EXPERIMENTAL_WARNINGS} + {$DEFINE SUPPORTS_REGION} + {$DEFINE SUPPORTS_UNICODE_STRING} + {$IFEND} + + {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 20402)} + {$DEFINE SUPPORTS_FOR_IN} + {$IFEND} + + {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 20600)} + {$DEFINE SUPPORTS_LIBRARY_WARNINGS} + {$DEFINE SUPPORTS_DEPRECATED_DETAILS} + {$DEFINE SUPPORTS_NESTED_TYPES} + {$DEFINE SUPPORTS_NESTED_CONSTANTS} + {$DEFINE SUPPORTS_ENHANCED_RECORDS} // called Advanced Records in FPC + {$DEFINE SUPPORTS_CLASS_FIELDS} + {$DEFINE SUPPORTS_CLASS_HELPERS} + {$DEFINE SUPPORTS_CLASS_OPERATORS} + {$DEFINE SUPPORTS_CLASS_CTORDTORS} + {$DEFINE SUPPORTS_FINAL} + {$DEFINE SUPPORTS_CAST_INTERFACE_TO_OBJ} + + {$DEFINE HAS_ENOTIMPLEMENTED} + {$IFEND} + + {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 20602)} + {$DEFINE SUPPORTS_INT_ALIASES} + + {$DEFINE HAS_EARGUMENTEXCEPTION} + {$IFEND} + + {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 30000)} + {$DEFINE SUPPORTS_GENERICS} + {$DEFINE SUPPORTS_GENERIC_TYPES} + + {$DEFINE HAS_UNIT_CHARACTER} + {$IFEND} + + {$IF defined(FPC_FULLVERSION) and (FPC_FULLVERSION >= 30200)} + {$DEFINE SUPPORTS_GENERIC_METHODS} + {$DEFINE SUPPORTS_GENERIC_ROUTINES} + {$DEFINE SUPPORTS_WEAKPACKAGEUNIT} + + {$DEFINE HAS_UNIT_RTTI} + {$DEFINE HAS_UNIT_SYSTEM_UITYPES} + {$IFEND} {$ELSE} - {$UNDEF SUPPORTS_DISPINTERFACE} - {$UNDEF SUPPORTS_IMPLEMENTS} - {$endif} - {$UNDEF SUPPORTS_UNSAFE_WARNINGS} + { older than 2.2.4 } + + {$IFDEF VER2_2} + {$SUPPORTS_SETPEFLAGS} + {$SUPPORTS_STRICT} + {$ENDIF} + {$IFEND} {$ENDIF} {$ENDIF FPC} @@ -1465,12 +1762,25 @@ {$DEFINE SUPPORTS_UNICODE} {$ENDIF CLR} +{$IFDEF BORLAND} + {$IFNDEF CLR} + // The ASSEMBLER symbol appeared with Delphi 7 + {$IFNDEF COMPILER7_UP} + {$DEFINE CPUASM} + {$ELSE} + {$IFDEF ASSEMBLER} + {$DEFINE CPUASM} + {$ENDIF ASSEMBLER} + {$ENDIF ~COMPILER7_UP} + {$ENDIF ~CLR} +{$ENDIF BORLAND} + {$IFDEF COMPILER1_UP} {$DEFINE SUPPORTS_CONSTPARAMS} {$DEFINE SUPPORTS_SINGLE} {$DEFINE SUPPORTS_DOUBLE} {$DEFINE SUPPORTS_EXTENDED} - {$DEFINE SUPPORTS_PACKAGES} + {$DEFINE SUPPORTS_PACKAGES} {$ENDIF COMPILER1_UP} {$IFDEF COMPILER2_UP} @@ -1558,12 +1868,16 @@ {$IFDEF COMPILER11_UP} {$IFDEF CLR} {$DEFINE SUPPORTS_GENERICS} + {$DEFINE SUPPORTS_GENERIC_TYPES} + {$DEFINE SUPPORTS_GENERIC_METHODS} {$DEFINE SUPPORTS_DEPRECATED_DETAILS} {$ENDIF CLR} {$ENDIF COMPILER11_UP} {$IFDEF COMPILER12_UP} {$DEFINE SUPPORTS_GENERICS} + {$DEFINE SUPPORTS_GENERIC_TYPES} + {$DEFINE SUPPORTS_GENERIC_METHODS} {$DEFINE SUPPORTS_DEPRECATED_DETAILS} {$DEFINE SUPPORTS_INT_ALIASES} {$IFNDEF CLR} @@ -1583,8 +1897,13 @@ {$DEFINE USE_64BIT_TYPES} {$ENDIF COMPILER16_UP} +{$IFDEF COMPILER17_UP} + {$DEFINE SUPPORTS_LEGACYIFEND} +{$ENDIF COMPILER17_UP} + {$IFDEF RTL130_UP} {$DEFINE HAS_UNIT_CONTNRS} + {$DEFINE HAS_PROPERTY_OLDCREATEORDER} {$ENDIF RTL130_UP} {$IFDEF RTL140_UP} @@ -1620,7 +1939,7 @@ {$IFDEF RTL210_UP} {$DEFINE HAS_EARGUMENTEXCEPTION} -{$ENDIF RTL210_UP} +{$ENDIF RTL210_UP} {$IFDEF RTL220_UP} {$DEFINE HAS_UNIT_REGULAREXPRESSIONSAPI} @@ -1640,12 +1959,21 @@ {$IFDEF RTL250_UP} {$DEFINE DEPRECATED_SYSUTILS_ANSISTRINGS} + {$DEFINE DEPRECATED_TCHARACTER} {$ENDIF RTL250_UP} {$IFDEF RTL270_UP} {$DEFINE HAS_AUTOMATIC_DB_FIELDS} {$ENDIF RTL270_UP} +{$IFDEF RTL320_UP} + {$UNDEF HAS_UNIT_LIBC} +{$ENDIF RTL320_UP} + +{$IFDEF RTL350_UP} + {$UNDEF HAS_PROPERTY_OLDCREATEORDER} +{$ENDIF} + {------------------------------------------------------------------------------} { Cross-platform related defines } {------------------------------------------------------------------------------} @@ -1713,4 +2041,5 @@ // for Delphi/BCB trial versions remove the point from the line below {.$UNDEF SUPPORTS_WEAKPACKAGEUNIT} -{$ENDIF ~JEDI_INC} \ No newline at end of file +{$ENDIF ~JEDI_INC} + diff --git a/Source/IEParser.pas b/Source/IEParser.pas index 7870e5f..b10c87a 100644 --- a/Source/IEParser.pas +++ b/Source/IEParser.pas @@ -626,7 +626,7 @@ procedure TIEParser.Stop; Doc := nil; if Assigned(All) then All := nil; - FreeAndNil(Element); + //FreeAndNil(Element); FUrl := EmptyStr; FBusy := False; Finalize; diff --git a/Source/MenuContext.pas b/Source/MenuContext.pas index d9b7a6b..aff6706 100644 --- a/Source/MenuContext.pas +++ b/Source/MenuContext.pas @@ -95,12 +95,12 @@ function MenuCallbackProc(Wnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): if IsCM3 then begin CM3 := IContextMenu3(PCreateStruct(lParam).lpCreateParams); - SetWindowLong(Wnd, GWL_USERDATA, LongInt(CM3)); + SetWindowLong(Wnd, GWL_USERDATA, NativeInt(CM3)); end else begin CM2 := IContextMenu2(PCreateStruct(lParam).lpCreateParams); - SetWindowLong(Wnd, GWL_USERDATA, LongInt(CM2)); + SetWindowLong(Wnd, GWL_USERDATA, NativeInt(CM2)); end; Result := DefWindowProc(Wnd, Msg, wParam, lParam); end; diff --git a/Source/Mshtml_Ewb.pas b/Source/Mshtml_Ewb.pas index 988cb3c..74e3ee4 100644 --- a/Source/Mshtml_Ewb.pas +++ b/Source/Mshtml_Ewb.pas @@ -31736,3 +31736,4 @@ interface implementation end. + diff --git a/Source/RichEditBrowser.pas b/Source/RichEditBrowser.pas index 8ed6b2a..ffd4d8b 100644 --- a/Source/RichEditBrowser.pas +++ b/Source/RichEditBrowser.pas @@ -1450,7 +1450,7 @@ procedure TRichEditWB.WMPaint(var Msg: TWMPaint); // R, R1: TRect; begin DC := GetDC(Handle); - if Transparent = 1 then + if Transparent = true then SetBkMode(DC, Windows.Transparent) else SetBkMode(DC, Windows.OPAQUE);