Finding correct handle for edit box with FindWindowEx() - freepascal

I'm trying to post some text to an edit box that is on 3rd level on the windows tree.
The following code works ok for notepad (vrr02) but not in another program (Var03).
procedure TEcr01.Button1Click(Sender: TObject);
var Var01, Var02, Var03, vrr01, vrr02: HWND;
MyTxt : string;
begin
Var01 := FindWindow('#32770', nil);
Var02 := FindWindowEx(Var01, 0, '#32770', nil);
Var03 := FindWindowEx(Var01, Var02, 'Edit', nil);
vrr01 := FindWindow('notepad', nil);
vrr02 := FindWindowEx(vrr01, 0, 'edit', nil);
MyTxt := 'This is some text.';
SendMessage(Var03, WM_SETTEXT, 0, integer(MyTxt));
SendMessage(vrr02, WM_SETTEXT, 0, integer(MyTxt));
end;
The following image has in blue the Edit I want to post to but nothing is showing there. What am I doing wrong here?
Thanks.

With your current code you can't be sure if you've got the window handle you want at any of the stages.
"#32770" is standard dialog class, there can be many window of this class at any given time in a user session. You're passing nil for lpWindowName parameter in your FindWindow call, documentation states:
lpWindowName [in, optional]
Type: LPCTSTR
The window name (the window's title). If this parameter is NULL, all window names match.
So there is a probability that you have an entirely different window's handle at Var01 which have the same class but different window title.
Or none at all. That's why you have to check if the function failed or not after every API call. Refer to the function's documentation for how.
Var01 := FindWindow('#32770', 'Object Properties');
Win32Check(Var01 <> 0);
The above call specifies both class name and the window title which as much as guarantees that the function will return the window handle that you want.
Var02 := FindWindowEx(Var01, 0, '#32770', nil);
Win32Check(Var02 <> 0);
The call for Var02 looks alright. But Var03's parent is Var02, so you've got the third call wrong again.
Var03 := FindWindowEx(Var02, 0, 'Edit', nil);
Win32Check(Var03 <> 0);
This will retrieve the first Edit, the hidden one. You must call FindWindowEx again to retrieve the child you want, specify the previous window as the ChildAfter parameter.
Var03 := FindWindowEx(Var02, Var03, 'Edit', nil);
Win32Check(Var03 <> 0);
Also note that SendMessage's fourth parameter is not an integer, always refer to documentation.
All in all:
Var01 := FindWindow('#32770', 'Object Properties');
Win32Check(Var01 <> 0);
Var02 := FindWindowEx(Var01, 0, '#32770', nil);
Win32Check(Var02 <> 0);
Var03 := FindWindowEx(Var02, 0, 'Edit', nil);
Win32Check(Var03 <> 0);
Var03 := FindWindowEx(Var02, Var03, 'Edit', nil);
Win32Check(Var03 <> 0);
MyTxt := 'This is some text.';
SendMessage(Var03, WM_SETTEXT, 0, LPARAM(MyTxt));
SendMessage(vrr02, WM_SETTEXT, 0, LPARAM(MyTxt));

Related

CSV to StringGrid Out of Memory

I am having issues with loading a CSV into a StringGrid. Occasionally, it runs out of memory, but also it seems to have blank columns after each value. I've not really read from a CSV as opposed to output to one, so I took a stock example online and modified it for my needs.
This is what I've currently got:
procedure x.LoadCSVtoGrid(ACSVFile : String; AStringGrid: TStringGrid)
var
LRowIndex, LColIndex: Integer;
LStrLine: string;
LFile: TStringList;
begin
AStringGrid.RowCount := 0;
AStringGrid.ColCount := 0;
if not FileExists(ACSVFile) then
exit;
LFile := TStringList.Create;
try
LFile.LoadFromFile(ACSVFile);
if LFile.Count = 0 then
exit;
AStringGrid.ColCount := Max(AStringGrid.ColCount, WordCount(LFile[0], [',', '"'], '"'));
AStringGrid.RowCount := LFile.Count;
for LRowIndex := 0 to LFile.Count - 1 do
begin
LStrLine := LFile[LRowIndex];
LColIndex := 0;
while LStrLine <> '' do
begin
if Pos('"', LStrLine) = 1 then
begin
Delete(LStrLine, 1, 1);
AStringGrid.Cells[LColIndex, LRowIndex] := Copy(LStrLine, 1, Pos('"', LStrLine) - 1);
Delete(LStrLine, 1, Pos('"', LStrLine));
end
else
begin
AStringGrid.Cells[LColIndex, LRowIndex] := Copy(LStrLine, 1, Pos(',', LStrLine) - 1);
Delete(LStrLine, 1, Pos(',', LStrLine));
end;
Inc(LColIndex);
end;
end;
finally
LFile.Free;
end;
For smaller CSV files, it does fine. I think it's reading up to 250-300 lines before. Some of the files it has to deal with now are 500+.
To be honest, I don't do much handling of the data of the CSV until it's been imported into the StringGrid, but once it's in the StringGrid, it's validated. I've got to make sure that commas within speech marks, ie "text, here", are ignored, as it's part of the value. Again, this appears to handle the reading fine.
Another issue I think I might run into is AStringGrid.RowCount := LFile.Count;, as some of the CSV files have blank lines. If there is a way to deal with this, I am happy to take suggestions.
There are a few versions of CSV files it should be able to read, ie the calculation of column counts and such. Code for WordCount:
function x.WordCount(const S: string; const WordDelims: TSysCharSet; const QuoteChar: Char) : Integer;
var
LInWord: Boolean;
LQuoteOpen: Boolean;
i: Integer;
begin
Result := 0;
LInWord := False;
LQuoteOpen := False;
for i := 1 to Length(S) do
begin
if S[i] in WordDelims then
begin
if not LInWord or LQuoteOpen then
LInWord := False
else
begin
LInWord := True;
Inc(Result);
end;
end
else
begin
if S[i] = QuoteChar then
LQuoteOpen := not LQuoteOpen;
LInWord := True;
end;
end;
if LInWord and (not LQuoteOpen) then
Inc(Result);
I've tried multiple files, for the most part this issue only happens with larger CSV files with more content. I've tried various versions of CSV-to-StringGrid procedures to see if there is something innately wrong with the example I took above. The example works, but only on smaller files.
Let me know if you need more information.
Memory issue
First you create a TStringList and then load it with data
LFile := TStringList.Create;
LFile.LoadFromFile(ACSVFile);
Because you load the whole file into the string list, you need that much of memory, plus equally much to hold the data in the TStringGrid.
Reduce memory requirement by reading the file in chunks of, say, 1000 lines at the time, which you then can throw away after they are moved to the string grid.
OTOH, your "Out of memory" problem might also be caused by the errors in your code. I experienced an "Out of memory" error with my very small test file when run with your unaltered code.
Issues with code
In my tests I used a simple file with a few records and a quoted field in different locations. The file content is:
one,two,"text, including comma",four,five
one,two,three,four,five
"text, including comma",two,three,four,five
one,two,three,four,"text, including comma"
You determine required number of columns in the TStringGrid, by calling the WordCount() function, to which you pass the first string from the string list.
WordCount(const S: string; const WordDelims: TSysCharSet; const QuoteChar: Char) : Integer;
When I pass in the first test string,
'one,two,three,four,five',
WordCount returns correctly 5
Then, control returns to LoadCSVtoGrid(), and after assigning AStringGrid.ColCount and RowCount the for LRowIndex loop starts to fill the grid with data for the current row. Pay attention to the second part, after else:
AStringGrid.Cells[LColIndex, LRowIndex] := Copy(LStrLine, 1, Pos(',', LStrLine) - 1);
Delete(LStrLine, 1, Pos(',', LStrLine));
The Delete() deletes from beginning of LStrLine to Pos(',', LStrLine). This works ok for items "one,", "two,", "three," and "four,", but not for "five" as there is no comma after the last item.
This is the major flaw in the code as it never deletes the last item. Instead, since the loop runs while LString <> '' it just continues incrementing LColIndex
On my machine it stops after a couple of minutes with an out-of-memory error.
Here is my take on WordCount (renamed WordCountNew) function:
function TForm50.WordCountNew(const s: string; const Delimiter: Char;
const QuoteChar: Char): Integer;
var
InWord, InQuote: boolean;
i: integer;
begin
if s = '' then // Just in case we are fed an empty string
Exit(0);
Result := 1; // Init, at least one data item
InWord := False; // Init
InQuote:= False; // Init
for i := 1 to Length(s) do
begin
if s[i] = QuoteChar then // The field is quoted
InQuote := not InQuote; // make note about it
if s[i] = Delimiter then // Delimiter found
begin
if not InQuote then // ... but only count it,
inc(Result); // if not within a quote
end;
end;
end;
Then the LoadCSVtoGrid procedure:
procedure TForm50.LoadCSVtoGrid(ACSVFile: String; AStringGrid: TStringGrid);
var
LRowIndex, LColIndex: Integer;
LStrLine: string;
LFile: TStringList;
CommaPos: integer; // added
begin
AStringGrid.RowCount := 0;
AStringGrid.ColCount := 0;
if not FileExists(ACSVFile) then
exit;
LFile := TStringList.Create;
try
LFile.LoadFromFile(ACSVFile);
if LFile.Count = 0 then
exit;
// When determining column count we should ONLY count the field separator, comma.
// A quote character is not an indication of a new column / field.
// Therefore we remove the array of chars, `[',', '"']` and replace with `','`
// AStringGrid.ColCount := Max(AStringGrid.ColCount, WordCount(LFile[0], [',', '"'], '"'));
AStringGrid.ColCount := Max(AStringGrid.ColCount, WordCountNew(LFile[0], ',', '"'));
AStringGrid.RowCount := LFile.Count;
for LRowIndex := 0 to LFile.Count - 1 do
begin
LStrLine := LFile[LRowIndex];
LColIndex := 0;
while LStrLine <> '' do
begin
if Pos('"', LStrLine) = 1 then
begin
Delete(LStrLine, 1, 1);
AStringGrid.Cells[LColIndex, LRowIndex] := Copy(LStrLine, 1, Pos('"', LStrLine) - 1);
AStringGrid.UpdateControlState;
Delete(LStrLine, 1, Pos('"', LStrLine));
Delete(LStrLine, 1, Pos(',', LStrLine));
end
else
begin
CommaPos := Pos(',', LStrLine);
if CommaPos = 0 then CommaPos := Length(LStrLine)+1;
AStringGrid.Cells[LColIndex, LRowIndex] := Copy(LStrLine, 1, CommaPos-1); //Pos(',', LStrLine) - 1);
AStringGrid.UpdateControlState;
Delete(LStrLine, 1, CommaPos); // Pos(',', LStrLine));
end;
Inc(LColIndex);
end;
end;
finally
LFile.Free;
end;
end;
I added the CommaPos variable, to make it easier to artificially simulate a comma at the end of the string.
With these changes the test file is properly read into the grid.

Exporting Array to CSV in CODESYS

I am taking over a project with code from another person. I have a PLC that currently has inputs in from pressure sensors and thermocouples. It then scales that data to PSI and temperature in fahrenheit. The way the data is set up from each of those sensors is to be formatted into an array. So, once the data is scaled it is in an array that is also in the Network Variable List of the program. I am trying to take each of these values from the array, record the value every certain amount of time (say 1 recording per second for sake of clarity), and then export each piece of data to a CSV file for every second. Not sure where to even go with this. This is the code I was left with, but I feel as if it it unnecessarily complicated?
//This is the support class for File_Handler
FUNCTION_BLOCK fileWrite
VAR_INPUT
xWrite : BOOL;
sData : STRING(200);
uiLineLength : INT := 200;
sDirectory : STRING := 'C:\ProgramData\CODESYS\CODESYSHMIWinV3\D5050FE1\PlcLogic\data';
//sDirectory : STRING := '/home/cds-apps/PlcLogic/data/';
sFilename : STRING;
END_VAR
VAR_OUTPUT
BytesWritten : __XWORD;
BytesWrittenTotal: DWORD;
xDone: BOOL;
END_VAR
VAR
hFile_: sysfile.RTS_IEC_HANDLE := sysfile.RTS_INVALID_HANDLE;
FileWriteResult: sysfile.RTS_IEC_RESULT;
FileOpenResult: sysfile.RTS_IEC_RESULT;
state: INT;
sys_Us_start: SYSTIME;
sys_Us_end: SYSTIME;
WriteTimeMS: ULINT;
END_VAR
sFilename := CONCAT(sDirectory, sFilename);
hFile_ := SysFileOpen(szFile:= sFilename, am:= ACCESS_MODE.AM_APPEND_PLUS, pResult:= ADR(FileOpenResult));
SysTimeGetUs(pUsTime:=sys_Us_start );
BytesWritten := SysFileWrite(hFile:= hfile_, pbyBuffer:= ADR(sData), ulSize:= uiLineLength, pResult:= ADR(FileWriteResult));
BytesWrittenTotal := BytesWrittenTotal + BytesWritten;
SysTimeGetUs(pUsTime:=sys_Us_end );
WriteTimeMS := (sys_Us_end - sys_Us_start)/1000;
SysFileClose(hFile:= hFile_);
I am not sure where to go with this code. It does create a CSV file, but I was looking to be able to create a CSV file for a piece of data every second? If anyone has any thoughts or resources I could check out that would be great.
A basic example of how to call this routine every second could be the following:
1)
You create a FuncBlock that takes care of calling your logger block.
Let's say you call it LoggerTask.
FUNCTION_BLOCK LoggerTask
VAR_INPUT
sData : STRING(200);
sFilename : STRING;
xExecute : BOOL;
END_VAR
VAR
fbRepeatTask : TON;
fbFileWrite : FileWrite;
uiStep : UINT;
END_VAR
2)
After that create a simple step chain:
(You can obviously extend and customize it as you like, you should add error handling in the case when FileWrite fails to write to file or writes less than expected for example.)
Implementation part:
fbRepeatTask(PT:=T#1S);
fbFileWrite(sData := sData, sFileName := sFileName);
IF xExecute
AND uiStep = 0
THEN
uiStep := 10;
ELSIF NOT xExecute
THEN
uiStep := 0;
fbFileWrite.xWrite := FALSE;
fbRepeatTask.IN := FALSE;
END_IF
CASE uiStep OF
10:
fbFileWrite.xWrite := TRUE;
IF fbFileWrite.xDone
THEN
fbFileWrite.xWrite := FALSE;
uiStep := 20;
END_IF
20:
fbRepeatTask.IN := TRUE;
IF fbRepeatTask.Q
THEN
fbRepeatTask.IN := FALSE;
uiStep := 10;
END_IF
END_CASE
3)
As you can see this block gets executed as soon as xExecute is set to true.
In order to reset the step chain set xExecute to false.
Just run this block cyclically for example like this fbLoggerTask(xExecute := TRUE);
I don't think you posted all the code of your FileWrite block because xDone is not set and xWrite is not checked anywhere.
So make sure that xDone is set to true for one cycle after the String is written to the file (if it's not already been implemented).

How can I add a timer within a function in codesys using structured text?

I'm having a problem with structured text in Codesys V3.5 SP9 Patch 5. What I want to do is to be able to use a timer within a function created by me, which is called in a POU. I've done the same without using function by putting timer directly into POU and it is working.
My function declaration:
FUNCTION AssignDOORStatus : USINT
VAR_INPUT
DDUC_ComSta_Dcux_x: BOOL; //No communication
DDUC_DCUxEmHdler_x: BOOL; //Emergency handler
END_VAR
VAR
Timer: TP; //Timer to do intermittence between current doors status and emergency handler
CurrentDoorStatus: USINT;
TONProcessTime: TIME := T#1S; //TONProcesTime
END_VAR
My function code:
IF DDUC_ComSta_Dcux_x THEN
CurrentDoorStatus := 0;
ELSE
CurrentDoorStatus := 1;
END_IF
IF DDUC_DCUxEmHdler_x THEN
Timer(IN := NOT Timer.Q, PT := TONProcessTime); //Timer starts
Timer();
IF Timer.Q THEN //When TONProcessTime has gone by
IF AssignDOORStatus <> CurrentDoorStatus THEN
AssignDOORStatus := CurrentDoorStatus;
ELSE AssignDOORStatus := 10;
END_IF
END_IF
ELSE
AssignDOORStatus := CurrentDoorStatus;
END_IF
My code in POU main:
testdoor := AssignDOORStatus(DDUC_ComSta_Dcu1_S1_T,DDUC_DCU1EmHdler_S1_T);
This code is used to assign to "AssignDOORStatus" 0 or 1 depending on variable "DDUC_ComSta_Dcux_x " and then, when "DDUC_DCUxEmHdler_x " is true, it flips "AssignDOORStatus" value from "0 or 1" to 10, using timer.
I have to call in POU many times this function.
Thanks in advance!
Functions have no memory. Therefore all variables declared inside VAR are temporary and are reset to their default for each new call.
FunctionBlocks/Programs have memory. Therefore all variables declared inside VAR remain their values between each call.
That's why you should not use a function, which will forget everything between each call from MAIN. For instance the timer will be reset from the previous call.
Instead you should write a function block (or FB), which can be re-used for the several doors you want to handle. Inside the function block will be a set of variables (especially the timer), which will be unique for each instance and also be remembered from call to call.
The above is a very short description so you should really look up the function block in your compilers help file to get a proper explanation, e.g. for input/output parameters.
Below is my suggestion for a program that uses the same FB for three different door instances:
(The FB, first the declaration and then it's code)
FUNCTION_BLOCK FB_AssignDOORStatus
VAR_INPUT
DDUC_ComSta_Dcux_x: BOOL; //No communication
DDUC_DCUxEmHdler_x: BOOL; //Emergency handler
END_VAR
VAR_OUTPUT
AssignDoorStatus: USINT;
END_VAR
VAR
Timer: TP; //Timer to do intermittence between current doors status and emergency handler
CurrentDoorStatus: USINT;
TONProcessTime: TIME := T#1S; //TONProcesTime
END_VAR
----------
IF DDUC_ComSta_Dcux_x THEN
CurrentDoorStatus := 0;
ELSE
CurrentDoorStatus := 1;
END_IF
IF DDUC_DCUxEmHdler_x THEN
Timer(IN := NOT Timer.Q, PT := TONProcessTime); //Timer starts
Timer();
IF Timer.Q THEN //When TONProcessTime has gone by
IF AssignDOORStatus <> CurrentDoorStatus THEN
AssignDOORStatus := CurrentDoorStatus;
ELSE
AssignDOORStatus := 10;
END_IF
END_IF
ELSE
AssignDOORStatus := CurrentDoorStatus;
END_IF
(MAIN, first the declaration and then it's code)
PROGRAM MAIN
VAR
// You must make an instance of your function block(s). This instance will live from call to call.
fbAssignDOORStatus_1: FB_AssignDOORStatus;
fbAssignDOORStatus_2: FB_AssignDOORStatus;
fbAssignDOORStatus_3: FB_AssignDOORStatus;
// ...
// Better to use an array to hold the many FB instances needed...
// You could use a for loop in the MAIN program to call all the instances.
// Test variables to hand to the fb's during runtime.
ComSta: BOOL;
EmHdler: BOOL;
TestDoor1, TestDoor2, TestDoor3: USINT;
// Here you could also use an array or re-use some common variable...
END_VAR
----------
fbAssignDOORStatus_1(
DDUC_ComSta_Dcux_x := ComSta,
DDUC_DCUxEmHdler_x := FALSE,
AssignDoorStatus => TestDoor1);
fbAssignDOORStatus_2(
DDUC_ComSta_Dcux_x := TRUE,
DDUC_DCUxEmHdler_x := EmHdler,
AssignDoorStatus => TestDoor2);
fbAssignDOORStatus_3(
DDUC_ComSta_Dcux_x := ComSta,
DDUC_DCUxEmHdler_x := EmHdler,
AssignDoorStatus => TestDoor3);

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;

How can I get IHtmlDocument2 in chrome browser?

In Internet Explorer, I can use IHtmlDocument2 to get the html document.
function GetCurrentBrowserDOM: WideString;
var
hr: HRESULT;
CurrentIE: IWebbrowser2;
Wnd: HWND;
WndChild:HWND;
document: IDispatch;
RootNode: IHTMLDocument2;
innerHtml: WideString;
begin
Result := '';
Wnd := GetForegroundWindow;
WndChild := FindWindowEx(Wnd, 0,'Frame Tab', nil);
WndChild := FindWindowEx(WndChild, 0,'TabWindowClass', nil);
WndChild := FindWindowEX(WndChild, 0, 'Shell DocObject View', nil);
WndChild := FindWindowEX(WndChild, 0, 'Internet Explorer_Server', nil);//find Internet
CoInitialize(nil);
try
hr := GetIEFromHWND(WndChild, CurrentIE);
if hr = S_OK then
begin
document := CurrentIE.Document;
document.QueryInterface(IID_IHTMLDocument2, RootNode);
innerHtml := RootNode.body.innerHTML;
end;
finally
CoUninitialize;
end;
end;
function GetIEFromHWND(WHandle: HWND; var IE: IWebbrowser2): HRESULT;
type
TObjectFromLResult = function(LRESULT: LRESULT; const IID: TGUID; wParam: WPARAM; out PObject): HRESULT; stdcall;
var
hInst: HWND;
lRes: Cardinal;
MSG: Integer;
pDoc: IHTMLDocument2;
ObjectFromLresult: TObjectFromLresult;
begin
hInst := LoadLibrary('Oleacc.dll');
#ObjectFromLresult := GetProcAddress(hInst, 'ObjectFromLresult');
if #ObjectFromLresult <> nil then begin
try
MSG := RegisterWindowMessage('WM_HTML_GETOBJECT');
SendMessageTimeOut(WHandle, MSG, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes);
Result := ObjectFromLresult(lRes, IHTMLDocument2, 0, pDoc);
Result := GetLastError;
if Result = S_OK then
(pDoc.parentWindow as IServiceprovider).QueryService(IWebbrowserApp, IWebbrowser2, IE);
finally
FreeLibrary(hInst);
end;
end;
I used spy++ to look for the chrome frame handle, and I found them.
Wnd := GetForegroundWindow;
WndChild := FindWindowEx(Wnd, 0, 'Chrome_WidgetWin_0', nil);
WndChild := FindWindowEx(WndChild, 0, 'Chrome_RenderWidgetHostHWND', nil);
WndChild := FindWindowEx(WndChild, 0, 'CompositorHostWindowClass', nil);
But it can't catch the result in function called ObjectFromLresult.
ObjectFromLresult(lRes, IHTMLDocument2, 0, pDoc);
The error code I got was 127.
Does it mean chrome browser not support this way to fetch its html document?
If the answer is yes, is there another way to catch it?
thanks a lot.
PS: I have tried to use MSAA tree, but it didn't work too.(Can only fetch the title)
This is not possible, IHtmlDocument2 is interface supported only in IE hosting objects, WebKit engine used in Chrome doesn't support it. You can however use MSAA to access elements, but you need to enable accessibility feature first: http://www.chromium.org/developers/design-documents/accessibility
Or alternatively you can access DOM via remote debugging protocol: https://developers.google.com/chrome-developer-tools/docs/protocol/1.0/index