How to call the OnChange event of "Select" ? (Delphi - WebBrowser) - html

I'm using Delphi and WebBrowser componenet to navigate a html page . the page have a Combobox . is there any way to call the OnChange event ?
The ComboBox is like this :
<select name="comboname" onchange="Some Javascript codes">
Also , i have used this code :
function TFrmMain.SetComboboxValue(WB: TEmbeddedWB;
SelectName, ItemName: string): Boolean;
var
iForms, iFormItems, iSelectItems: Word;
FormItem: OleVariant;
begin
Result := false;
for iForms := 0 to WB.OleObject.Document.Forms.length - 1 do
begin
FormItem := WB.OleObject.Document.Forms.item(iForms);
for iFormItems := 0 to FormItem.length - 1 do
begin
if (FormItem.item(iFormItems). type = 'select-one') and SameText
(FormItem.item(iFormItems).Name, SelectName) then
begin
for iSelectItems := 0 to FormItem.item(iFormItems).Options.length - 1 do
begin
if SameText(FormItem.item(iFormItems).Options.item(iSelectItems)
.Text, ItemName) then
begin
FormItem.item(iFormItems).SelectedIndex := iSelectItems;
Result := true;
Break;
end;
end;
end;
end;
end;
end;
But it change the value only.

to execute the onchange event you can use the execScript method
check this sample
uses
MSHTML;
var
Doc: IHTMLDocument2;
HTMLWindow: IHTMLWindow2;
begin
Doc := WebBrowser1.Document as IHTMLDocument2;
if not Assigned(Doc) then
Exit;
HTMLWindow := Doc.parentWindow;
if not Assigned(HTMLWindow) then
Exit;
HTMLWindow.execScript('yourfunctioname()', 'JavaScript');
end;
for more info check this excellent article
How to call JavaScript functions in a TWebBrowser from Delphi

Inspired by the response. NET have been using the structures below:
FrameSet Document Elements Item Name Value Change ;
EWB.OleObject.Document.Frames.Item('mainFrame').Document.Forms.Item('invoiceForm').Elements.Item('inputname').Value:= '123456';
or
FrameSet Document Elements Items Lenth;
EWB.OleObject.Document.Forms.Item('invoiceForm').Elements.Length;

Related

DSiWin32.DSiGetHtmlFormatFromClipboard not working?

I am trying to use the DSiGetHtmlFormatFromClipboard function from the well known DSiWin32 library.
Edit: There is a much newer version of DSIWin32.pas 1.94 from 2016-10-19 which is contained in the current version of OmniThreadLibrary_3.07.1. The one I've linked to in the first line of my question is much older: 1.66 from 2012-04-20. However, also in this newer version of DSIWin32.pas the function DSiGetHtmlFormatFromClipboard does not work although I've made sure that no other clipboard programs are running.
So I put some text on the clipboard which includes the HTML format e.g. by copying some text from Chrome web-browser.
And then I use this code to get the HTML format from the clipboard:
if DSiWin32.DSiIsHtmlFormatOnClipboard then
begin
CodeSite.Send('HTML-Format string:', DSiWin32.DSiGetHtmlFormatFromClipboard);
end;
While the DSiIsHtmlFormatOnClipboard function does work (it gives back True if there is HTML Format on the clipboard and gives back False if there is no HTML Format on the clipboard), the DSiGetHtmlFormatFromClipboard function always gives back an empty string although there is HTML Format in the clipboard:
So I debugged function DSiGetHtmlFormatFromClipboard: string; in DSiWin32.pas:
On this line:
hClipData := GetClipboardData(GCF_HTML);
hClipData is always 0, so the following code is not executed.
GetClipboardData is a function from Winapi.Windows and according to MSDN documentation:
Retrieves data from the clipboard in a specified format. The clipboard
must have been opened previously.
Which is the case in the DSiWin32 code.
So why does the DSiGetHtmlFormatFromClipboard always give back an empty string?
OS: Windows 7 x64
GetLastError retrieved immediately after the line hClipData := GetClipboardData(GCF_HTML);:
ERROR_CLIPBOARD_NOT_OPEN 1418 (0x58A) Thread does not have a
clipboard open.
This is strange because the preceding line is: Win32Check(OpenClipboard(0)); and it does not fail.
Here is the relevant parts of the MCVE:
var
GCF_HTML: UINT;
function DSiIsHtmlFormatOnClipboard: boolean;
begin
Result := IsClipboardFormatAvailable(GCF_HTML);
end; { DSiIsHtmlFormatOnClipboard }
function DSiGetHtmlFormatFromClipboard: string;
var
hClipData : THandle;
idxEndFragment : integer;
idxStartFragment: integer;
pClipData : PChar;
begin
Result := '';
if DSiIsHtmlFormatOnClipboard then
begin
Win32Check(OpenClipboard(0));
try
hClipData := GetClipboardData(GCF_HTML);
if hClipData = 0 then
RaiseLastOSError;
pClipData := GlobalLock(hClipData);
Win32Check(assigned(pClipData));
try
idxStartFragment := Pos('<!--StartFragment-->', pClipData); // len = 20
idxEndFragment := Pos('<!--EndFragment-->', pClipData);
if (idxStartFragment >= 0) and (idxEndFragment >= idxStartFragment) then
Result := Copy(pClipData, idxStartFragment + 20, idxEndFragment - idxStartFragment - 20);
finally GlobalUnlock(hClipData); end;
finally Win32Check(CloseClipboard); end;
end;
end; { DSiGetHtmlFormatFromClipboard }
procedure TForm1.Button1Click(Sender: TObject);
begin
if DSiIsHtmlFormatOnClipboard then
ShowMessage(DSiGetHtmlFormatFromClipboard)
else
ShowMessage('No HTML Format on Clipboard');
end;
initialization
GCF_HTML := RegisterClipboardFormat('HTML Format');
end.

Insert STYLEs into TWebBrowser

I am using TWebBrowser as editor GUI for users. I want to be able to insert web controls into the document. A simple example would be a check box. (I can elaborate why if needed). I have all this working when I first assemble the HTML document (with its STYLE and SCRIPTS sections) and then pass it en-block to the TWebBrowser. But now I want to be able to insert my elements into an existing document.
I have this code, below, but it is causing and OLE error (see in comments in code):
procedure THTMLTemplateDocument.EnsureStylesInWebDOM;
var StyleBlock : IHTMLElement;
StyleText: string;
begin
StyleBlock := FWebBrowser.GetDocStyle;
if not assigned(StyleBlock) then
raise Exception.Create('Unable to access <STYLE> block in web document');
StyleText := FCumulativeStyleCodes.Text;
StyleBlock.InnerText := StyleText; <--- generates "OLE ERROR 800A0258"
end;
The called functions from the above code are as follows:
function THtmlObj.GetDocStyle: IHTMLElement;
//Return pointer to <STYLE> block, creating this if it was not already present.
var
Document: IHTMLDocument2; // IHTMLDocument2 interface of Doc
Elements: IHTMLElementCollection; // all tags in document body
AElement: IHTMLElement; // a tag in document body
Style, Head: IHTMLElement;
I: Integer; // loops thru Elements in document body
begin
Result := nil;
if not Supports(Doc, IHTMLDocument2, Document) then
raise Exception.Create('Invalid HTML document');
Elements := Document.all;
for I := 0 to Pred(Elements.length) do begin
AElement := Elements.item(I, EmptyParam) as IHTMLElement;
if UpperCase(AElement.tagName) <> 'STYLE' then continue;
result := AElement;
break;
end;
if not assigned(Result) then begin
Head := GetDocHead;
if assigned(Head) then begin
Style := Document.CreateElement('STYLE');
(Head as IHTMLDOMNode).AppendChild(Style as IHTMLDOMNode);
Result := Style;
end;
end;
end;
and
function THtmlObj.GetDocHead: IHTMLElement;
//Return pointer to <HEAD> block, creating this if it was not already present.
var
Document: IHTMLDocument2; // IHTMLDocument2 interface of Doc
Elements: IHTMLElementCollection; // all tags in document body
AElement: IHTMLElement; // a tag in document body
Body: IHTMLElement2; // document body element
Head: IHTMLElement;
I: Integer; // loops thru Elements in document body
begin
Result := nil;
if not Supports(Doc, IHTMLDocument2, Document) then
raise Exception.Create('Invalid HTML document');
if not Supports(Document.body, IHTMLElement2, Body) then
raise Exception.Create('Can''t find <body> element');
Elements := Document.all;
for I := 0 to Pred(Elements.length) do begin
AElement := Elements.item(I, EmptyParam) as IHTMLElement;
if UpperCase(AElement.tagName) <> 'HEAD' then continue;
Result := AElement;
break;
end;
if not assigned(Result) then begin
Head := Document.CreateElement('HEAD');
(Body as IHTMLDOMNode).insertBefore(Head as IHTMLDOMNode, Body as IHTMLDOMNode);
//now look for it again
Elements := Document.all;
for I := 0 to Pred(Elements.length) do begin
AElement := Elements.item(I, EmptyParam) as IHTMLElement;
if UpperCase(AElement.tagName) <> 'HEAD' then continue;
Result := AElement;
break;
end;
end;
end;
When I run this, StyleText =
'.selected {'#$D#$A' font-weight : bold;'#$D#$A' //background-color : yellow;'#$D#$A'}'#$D#$A'.unselected {'#$D#$A' font-weight : normal;'#$D#$A' //background-color : white;'#$D#$A'}'#$D#$A#$D#$A
But I tried making StyleText to be something simple like 'hello', and it still crashed.
A Google search for "OLE ERROR 800A0258" reveals several other people who have had similar problems, such as here and here -- this later user seems to indicate he fixed the problem by using .OuterHTML, but I tried this with similar error generated. This thread seems to indicate the .InnerText is read only. But in the interface declaration (see below), it seems to have a method for setting (i.e. not read-only).
// *********************************************************************//
// Interface: IHTMLElement
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {3050F1FF-98B5-11CF-BB82-00AA00BDCE0B}
// *********************************************************************//
IHTMLElement = interface(IDispatch)
['{3050F1FF-98B5-11CF-BB82-00AA00BDCE0B}']
...
procedure Set_innerHTML(const p: WideString); safecall;
function Get_innerHTML: WideString; safecall;
procedure Set_innerText(const p: WideString); safecall;
function Get_innerText: WideString; safecall;
procedure Set_outerHTML(const p: WideString); safecall;
function Get_outerHTML: WideString; safecall;
procedure Set_outerText(const p: WideString); safecall;
function Get_outerText: WideString; safecall;
...
property innerHTML: WideString read Get_innerHTML write Set_innerHTML;
property innerText: WideString read Get_innerText write Set_innerText;
property outerHTML: WideString read Get_outerHTML write Set_outerHTML;
property outerText: WideString read Get_outerText write Set_outerText;
...
end;
Can anyone help be figure out how to set up STYLES in the <STYLE> section of an existing HTML document in a TWebBrowser?
If you have valid IHTMLDocument2, then you can call its createStyleSheet(). It will return IHTMLStyleSheet instance. You can use its cssText property to set style.
Make sure you take account of document's character encoding.
Based on guidance from #Zamrony P. Juhara, I came up with the following code. I am posting in case it can help anyone else in the future.
procedure THtmlObj.AddStylesToExistingStyleSheet(StyleSheet: IHTMLStyleSheet; SelectorSL, CSSLineSL : TStringList);
//NOTE: There must be a 1:1 correlation between SelectorSL and CSSLineSL
// The first SL will contain the selector text
// the second SL will contain all the CSS in one line (divided by ";"'s)
var
SLIdx, RuleIdx, p: integer;
SelectorText, CSSText, OneCSSEntry : string;
begin
if not assigned(StyleSheet) then begin
raise Exception.Create('Invalid StyleSheet');
end;
for SLIdx := 0 to SelectorSL.Count - 1 do begin
SelectorText := SelectorSL.Strings[SLIdx];
if SlIdx > (CSSLineSL.Count - 1) then break;
CSSText := CSSLineSL.Strings[SLIdx];
while CSSText <> '' do begin
p := Pos(';', CSSText);
if p > 0 then begin
OneCSSEntry := MidStr(CSSText, 1, p);
CSSText := MidStr(CSSText, p+1, Length(CSSText));
end else begin
OneCSSEntry := CSSText;
CSSText := '';
end;
RuleIdx := StyleSheet.Rules.length;
StyleSheet.addRule(SelectorText, OneCSSEntry, RuleIdx);
end;
end;
end;
function THtmlObj.AddStyles(SelectorSL, CSSLineSL : TStringList) : IHTMLStyleSheet;
//NOTE: There must be a 1:1 correlation between SelectorSL and CSSLineSL
// The first SL will contain the selector text
// the second SL will contain all the CSS in one line (divided by ";"'s)
var
Document: IHTMLDocument2; // IHTMLDocument2 interface of Doc
StyleSheets: IHTMLStyleSheetsCollection; // document's style sheets
StyleSheet: IHTMLStyleSheet; // reference to a style sheet
OVStyleSheet: OleVariant; // variant ref to style sheet
Idx: integer;
begin
Result := nil;
if not Supports(Doc, IHTMLDocument2, Document) then begin
raise Exception.Create('Invalid HTML document');
end;
StyleSheets := Document.styleSheets;
Idx := Document.StyleSheets.length;
OVStyleSheet := Document.createStyleSheet('',Idx);
if not VarSupports(OVStyleSheet, IHTMLStyleSheet, StyleSheet) then begin
raise Exception.Create('Unable to create valid style sheet');
end;
Result := StyleSheet;
AddStylesToExistingStyleSheet(StyleSheet, SelectorSL, CSSLineSL);
end; //AddStyles

Delphi: Simulating a drag and drop from the clipboard to EmbeddedWB’s IHTMLElement

I have a Delphi XE2 application with a TEmbeddedWB that I use to simulate user actions. The application navigates to a URL, populates the relevant form fields with data and submits the data. The problem is that there is an <input type=file /> field which accepts files that are uploaded.
Having done a lot of reading on the matter I understand there is a security issue doing this programmatically but also found someone making a suggestion that the files could be ‘dragged’ from the clipboard and ‘dropped’ in place. I have since been successful in loading the relevant files (jpeg images) into the clipboard (thanks to CCR.Clipboard) and drop them onto my EmbeddedWB. However, as you are most likely aware, dropping an image on a TWebBrowser resorts to the image being displayed.
My issue is that the web page I’m accessing has a specific DIV element that accepts files to be dropped. Although I have successfully obtained the coordinates of that DIV as an IHTMLElement and even moved the mouse cursor into position (for visual confirmation), dropping an image there still opens it for display instead of uploading it. It’s as though the drop area doesn’t detect the drop, only the web browser does.
Any guidance on this matter will be greatly appreciated. Following is the relevant code.
Methods:
type
TElementsArray = array of IHTMLElement;
...
function TSiteRobot.FindElementByTagAttributeValue(const Document: IHTMLDocument2; TagName, Attribute, AttributeValue: String; out Info: String): IHTMLElement;
var i: integer;
HTMLElem: IHTMLElement;
ElementCount: integer;
OleElem: OleVariant;
ElementsArray: TElementsArray;
begin
Result := nil; //initialise
ElementsArray := GetElementsByTagName(Document, TagName);
if Length(ElementsArray) = 0 then
begin
Info := 'No elements with "'+TagName+'" tag found.';
Exit
end;
Info := 'No element found for tag "'+TagName+'" and attribute "'+Attribute+'" with Value "'+AttributeValue+'"';
for i := Low(ElementsArray) to High(ElementsArray) do
begin
HTMLElem := ElementsArray[i];
try
OleElem := HTMLElem.getAttribute(Attribute,0);
if (not varIsClear(OleElem)) and (OleElem <> null) then
begin
if (String(OleElem) = AttributeValue) then
begin
if HTMLElem <> nil then Result := HTMLElem;
Break;
end;
end;
except raise; end;
end;
end;
function TSiteRobot.GetElementScreenPos(WebBrowser: TEmbeddedWB; HTMLElement: IHTMLElement): TPoint;
var WinRect: TRect;
elTop, elLeft: integer;
HTMLElem2: IHTMLElement2;
begin
HTMLElement.scrollIntoView(True);
Application.ProcessMessages; //let the coordinates get updated since the page moved
GetWindowRect(WebBrowser.Handle, WinRect);
HTMLElem2 := (HTMLElement as IHTMLElement2);
elLeft := HTMLElem2.getBoundingClientRect.left + WinRect.Left;
elTop := HTMLElem2.getBoundingClientRect.top + WinRect.Top;
Result := Point(elLeft, elTop);
end;
procedure TfrmMain.DropFilesAtPoint(Area: TPoint; Wnd: HWND);
var DropTarget: IDropTarget;
DataObj: IDataObject;
DropFiles: PDropFiles;
StgMed: TSTGMEDIUM;
FormatEtc: TFORMATETC;
EnumFormatEtc: IEnumFORMATETC;
dwEffect: integer;
begin
DropTarget := IDropTarget(GetProp(Wnd, 'OleDropTargetInterface'));
OleGetClipboard(dataObj);
DataObj.EnumFormatEtc(DATADIR_GET, EnumFormatEtc);
while (EnumFormatEtc.Next(1, FormatEtc, nil) <> S_FALSE) do
begin
if (FormatEtc.cfFormat = CF_HDROP) and (DataObj.QueryGetData(FormatEtc) = S_OK) then
begin
DataObj.GetData(FormatEtc, StgMed);
DropFiles := GlobalLock(StgMed.hGlobal);
dwEffect := DROPEFFECT_COPY;
DropTarget.Drop(DataObj, Integer(DropFiles), Area, dwEffect); // This is where the image opens in the web browser
GlobalFree(StgMed.hGlobal);
ReleaseStgMedium(StgMed);
end;
end; //while
DataObj._Release;
end;
Calling Code:
var HTMLElem: IHTMLElement;
dndArea: TPoint;
…
HTMLElem := SiteRobot.FindElementByTagAttributeValue(Document, 'SPAN', 'id', 'dndArea', Info);
dndArea := SiteRobot.GetElementScreenPos(WebBrowser, HTMLElem);
dndArea.X := dndArea.X+24; //go ‘deeper’ into the drop area
dndArea.Y := dndArea.Y+24;
SetCursorPos(dndArea.X, dndArea.Y); //cursor moves onto the correct spot in the website every time
(HTMLElem as IHTMLElement2).focus;
DropFilesAtPoint(dndArea, webBrowser.Handle);
I have come to a solution regarding this problem. Rather than using the clipboard, I piggy-backed on Melander’s drag-and-drop PIDLDemo. Adding a TListView component to the form and giving it the ability to drag-and-drop files to the shell does the trick. Using Windows' MOUSE_EVENT I am able to (programmatically) drag the files from the TListView and drop them onto the TEmbeddedWB at the correct location. Presto! The files are accepted and uploaded to the website.
The calling code now looks as follows:
function TfrmMain.GetMickey(val: TPoint): TPoint;
begin
{
http://delphi.xcjc.net/viewthread.php?tid=43193
Mouse Coordinates given are in "Mickeys", where their are 65535 "Mickeys"
to a screen's width.
}
Result.X := Round(val.X * (65535 / Screen.Width));
Result.Y := Round(val.Y * (65535 / Screen.Height));
end;
procedure TfrmMain.DropFilesAtPoint(const Area: TPoint; Wnd: HWND);
var Rect: TRect;
DropPoint,
ListViewPoint,
ListViewItemPoint: TPoint;
begin
GetWindowRect(ListView1.Handle, Rect);
ListViewItemPoint := ListView1.Items.Item[0].GetPosition;
ListViewPoint := Point(Rect.Left + ListViewItemPoint.X+10,
Rect.Top + ListViewItemPoint.Y+10);
ListView1.SelectAll; //ensures all files are dragged together
SetCursorPos(ListViewPoint.X, ListViewPoint.Y);
ListViewPoint := GetMickey(ListViewPoint);
MOUSE_EVENT(MOUSEEVENTF_LEFTDOWN,
ListViewPoint.X, ListViewPoint.Y, 0, 0); //left mouse button down
Sleep(500);
DropPoint := ClientToScreen(Area);
DropPoint := GetMickey(DropPoint);
MOUSE_EVENT(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE or
MOUSEEVENTF_LEFTDOWN or MOUSEEVENTF_LEFTUP,
DropPoint.X, DropPoint.Y, 0, 0); //move and drop
Application.ProcessMessages;
end;

Delphi XE2 HTML PAGE how can i input value and press a button [duplicate]

i have a html page that it have 3 forms with 3 submit buttons . buttons have no name but they have value :
<input type="submit" VALUE="Login">
How can i find this button with its value and click on it ?
Thanks
procedure TForm1.Button1Click(Sender: TObject);
var
ovElements: OleVariant;
i: Integer;
begin
ovElements := WebBrowser1.OleObject.Document.forms.item(0).elements;
for i := 0 to (ovElements.Length - 1) do
if (ovElements.item(i).tagName = 'INPUT') and
(ovElements.item(i).type = 'SUBMIT') and
(ovElements.item(i).Value = 'Login') then
ovElements.item(i).Click;
end;
I use in this case my Procedure WB_send_Click_by_Value:
procedure WB_send_Click_by_Value(WB: TWebbrowser;form_nr:nativeint;tag,typ,val: string);
var ovElements: OleVariant;
i: Integer;
begin
ovElements := WB.OleObject.Document.forms.item(form_nr).elements;
for i := 0 to (ovElements.Length - 1) do
begin
if AnsiSameText(ovElements.item(i).tagName,tag) and
AnsiSameText(ovElements.item(i).type,typ) and
AnsiSameText(ovElements.item(i).value,val) then
ovElements.item(i).Click;
end;
end;
I use this Procedure for Buttons in WebPage Formular 1 like:
WB_send_Click_by_Value(Webbrowser1,0,'input','submit','ok');
or e.g. for RadioButtons in Form 2 like:
WB_send_Click_by_Value(Webbrowser1,1,'input','radio','dns');

How to find a button with "value" in html page (Webbrowser - Delphi)

i have a html page that it have 3 forms with 3 submit buttons . buttons have no name but they have value :
<input type="submit" VALUE="Login">
How can i find this button with its value and click on it ?
Thanks
procedure TForm1.Button1Click(Sender: TObject);
var
ovElements: OleVariant;
i: Integer;
begin
ovElements := WebBrowser1.OleObject.Document.forms.item(0).elements;
for i := 0 to (ovElements.Length - 1) do
if (ovElements.item(i).tagName = 'INPUT') and
(ovElements.item(i).type = 'SUBMIT') and
(ovElements.item(i).Value = 'Login') then
ovElements.item(i).Click;
end;
I use in this case my Procedure WB_send_Click_by_Value:
procedure WB_send_Click_by_Value(WB: TWebbrowser;form_nr:nativeint;tag,typ,val: string);
var ovElements: OleVariant;
i: Integer;
begin
ovElements := WB.OleObject.Document.forms.item(form_nr).elements;
for i := 0 to (ovElements.Length - 1) do
begin
if AnsiSameText(ovElements.item(i).tagName,tag) and
AnsiSameText(ovElements.item(i).type,typ) and
AnsiSameText(ovElements.item(i).value,val) then
ovElements.item(i).Click;
end;
end;
I use this Procedure for Buttons in WebPage Formular 1 like:
WB_send_Click_by_Value(Webbrowser1,0,'input','submit','ok');
or e.g. for RadioButtons in Form 2 like:
WB_send_Click_by_Value(Webbrowser1,1,'input','radio','dns');