BpcDBEmbeddedWB
DB Aware Embedded Browser
Language: Delphi 7 - 2007
This is a BPC modification to the TEmbeddedWB from Balsa http://www.bsalsa.com/. The standard component implements an advanced wrapper for the IE browser API. This version from BPC adds DB Aware functionality to the component including drag/drop and MHTML display, and enables reading and writing of the HTML content to display from a database blob field. Think of it like a DB aware RichView memo, only for HTML content instead of RTF content.
This version is exclusive to BPC, and is available on request with source from BPC. You will need the Balsa freeware components as well.
It registers two components - a URL Registry and the DBAware embedded browser.
Works with IE 6,7 and 8.
uses
{$IFDEF DELPHI_6_UP}Variants, {$ENDIF}
SysUtils, Classes, Windows, Types, Controls, OleCtrls, SHDocVw_EWB, EwbCore, EmbeddedWB, DBCtrls,
DB, Messages, ComObj, ActiveX, UrlMon;
const
Class_bpcEWBDBNSHandler: TGUID = '{7D0847DC-7367-4EA0-AC30-2F39BFD9C862}';
EWNameSpace = 'ewbdbfield';
type
TbpcEWBGetMimeExtProc= procedure ( sender : TObject; Var MimeExt : string; var bShowBlank : boolean ) of object;
TbpcEWBGetDocName= procedure ( sender : TObject; Var DocName : string ) of object;
TbpcEWBGetDocURL= procedure ( sender : TObject; Var URL : string ) of object;
EDBEWBEditError = class(Exception);
TbpcDBEmbeddedWB = class(TEmbeddedWB)
private
{ Private declarations }
FDataLink: TFieldDataLink;
FReadOnly: boolean;
FFocused: Boolean;
FDefMimeExt : string;
FOnGetMimeExt : TbpcEWBGetMimeExtProc;
FOnGetDocName : TbpcEWBGetDocName;
FOnGetDocURL : TbpcEWBGetDocURL;
FDBConnected : boolean;
procedure ActiveChange(Sender: TObject);
procedure DataChange(Sender: TObject);
procedure EditingChange(Sender: TObject);
function GetDataField: string;
function GetDataSource: TDataSource;
function GetField: TField;
function GetFieldText: string;
procedure SetDataField(const Value: string);
procedure SetDataSource(const Value: TDataSource);
procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
function GetReadOnly: Boolean;
procedure SetReadOnly(const Value: Boolean);
function GetDBConnected: Boolean;
procedure SetDBConnected(const Value: Boolean);
procedure UpdateData(Sender: TObject);
protected
{ Protected declarations }
function GetLabelText: string; //##JB Delete?
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure ValidateEdit;
procedure ValidateError;
public
{ Public declarations }
LastURL : string;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetFocused(Value: Boolean);
procedure Loaded; override;
function ExecuteAction(Action: TBasicAction): Boolean; override;
function UpdateAction(Action: TBasicAction): Boolean; override;
Procedure DataRefresh;
property Field: TField read GetField;
// From EmbeddedWB
property Modified;
{$IFDEF USE_EwbTools}
property SelLength; // By M.Grusha
property SelText; // By M.Grusha
property SelTextHTML; // By M.Grusha
{$ENDIF}
// End From EmbeddedWB
published
{ Published declarations }
property DataField: string read GetDataField write SetDataField;
property DataSource: TDataSource read GetDataSource write SetDataSource;
property ReadOnly: Boolean read GetReadOnly write SetReadOnly default True;
property DBConnected: boolean read GetDBConnected write SetDBConnected default True;
// From EmbeddedWB
property About;
property HostCSS;
property HostNS;
property EnableMessageHandler;
property DisabledPopupMenuItems;
property DisableErrors;
property DialogBoxes;
property OnCloseQuery;
property OnShowDialog;
property PrintOptions;
property ProxySettings;
property ShortCuts;
property UserAgent;
property VisualEffects;
// End From EmbeddedWB
property DefMimeExt : string read FDefMimeExt write FDefMimeExt ; // the default mime extension '.html'
property OnGetMimeExt : TbpcEWBGetMimeExtProc read FOnGetMimeExt write FOnGetMimeExt; // Allow override of the default DefMimeExt
property OnGetDocName : TbpcEWBGetDocName read FOnGetDocName write FOnGetDocName; // Allow override of the default generated document name
property OnGetDocURL : TbpcEWBGetDocURL read FOnGetDocURL write FOnGetDocURL; // Allow override of db field retrieval with an URL
end;
// Name space handler - required so that MHT files can be read and converted
TbpcEWBDBNSHandler = class(TComObject, IInternetProtocol)
private
Url: string;
Written, TotalSize: Integer;
ProtSink: IInternetProtocolSink;
DataStream: IStream;
DataField : TField;
RegisterURLIndex : Integer;
protected
// IInternetProtocol Methods
function Start(szUrl: PWideChar;
OIProtSink: IInternetProtocolSink;
OIBindInfo: IInternetBindInfo;
grfPI, dwReserved: DWORD): HResult; stdcall;
function Continue(const ProtocolData:
TProtocolData): HResult; stdcall;
function Abort(hrReason: HResult;
dwOptions: DWORD): HResult; stdcall;
function Terminate(dwOptions: DWORD): HResult; stdcall;
function Suspend: HResult; stdcall;
function Resume: HResult; stdcall;
function Read(pv: Pointer; cb: ULONG;
out cbRead: ULONG): HResult; stdcall;
function Seek(dlibMove: LARGE_INTEGER;
dwOrigin: DWORD; out libNewPosition: ULARGE_INTEGER): HResult; stdcall;
function LockRequest(dwOptions: DWORD): HResult; stdcall;
function UnlockRequest: HResult; stdcall;
// Helper functions
procedure GetDataFromDataField(Url: string);
public
end;
// The EWB - URL registry is needed to allow he namespace handler to find which field
// is supplying the data for a given URL. As the namespace handle is a run time factory
// made object there is no direct way to pass the identity of the initiating EWB to the factory
// object..so the namespace handler does not know which field to use to get the data requested.
// This resgistry object holds the global registry of URLs and Fields. It will be most reliable when
// the EWBDB is allowed to manufacture the URL without inerference by the user, other than by
// setting the mime extension through the call back function.
// This should be placed on the mainform. Only one of these should exist in the application
TbpcEWBDBURLRegistry = class(TComponent)
public
Registry : TStringlist;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure RegisterURL( URL : string; Field : TField);
procedure UnRegisterURL( URL : string ); overload;
procedure UnRegisterURL( Index : integer ); overload;
procedure ClearRegistry;
function FindField( URL : string; var Index: Integer ) : TField;
end;
// Return a pointer to the global URL registry
function bpcEWBURLRegistry : TbpcEWBDBURLRegistry;
// Make a global URL registry and return a pointer to it
function bpcEWBURLRegistryInit : TbpcEWBDBURLRegistry;
// Dstroy the global URL Registry
procedure bpcEWBURLRegistryFree;
// Assign a URL Register to the global registry variable for future use
// WARNING: All Accesses from this point will be directed to the new registry
// WARNING: DOES NOT destroy the previous registry - this must be done manually
procedure bpcEWBURLRegistryAssign( value : TbpcEWBDBURLRegistry);
