can you please help me with this issue? See description below.
#author Xavier Martinez (cadetill)
#version 1.5.4
Projekt MegaDemo
After clicking on button Search Direction nothing is happening.
Program cycles in unit GMDirection in procedure Execute:
ExecuteScript('GetDirections', Params);
repeat
TGMGenFunc.ProcessMessages;
until (GetIntegerField(DirectionsForm, DirectionsFormResponse) = 1);
GetRetournedData;!
I temporary solved this problem in GMMap.pas unit
function TGMObjects.ExecuteScript(NameFunct, Params: string): Boolean;
begin
Result := False;
Map.FDocLoaded := true; <<- new line
if (csDesigning in ComponentState) or not Assigned(FMap) or
not Map.Active or not Map.FDocLoaded then Exit;
Result := FMap.ExecuteScript(NameFunct, Params);
end;
Related
The map won't load anymore on the megademo.exe.
The problem start when i put: GMMap1.Active := True;
Thanks for the help.
try this
var
FMapLoaded: boolean;
procedure TMainForm.GMMapAfterPageLoaded(Sender: TObject;
First: Boolean);
begin
inherited;
if First and not FMapLoaded then
begin
GMMap.DoMap;
FMapLoaded := True;
end;
end;
To solve this problem, you must to change the method TGMMap.DocumentComplete from GMMapVCL unit with this
before
if (pDisp = CurDispatch) then
after
if not FDocLoaded and (pDisp = CurDispatch) then
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.
I have problem inserting sql results into TStringGrid.I have following code:
var i:Integer;
begin
SqlQuery1.SQL.Text:= 'SELECT * FROM `users`';
SqlQuery1.Open;
MySql55Connection1.Open;
i:= 0;
while not SQLQUERY1.EOF do
begin
i:= i+1;
StringGrid1.Cells[0,i]:= SqlQuery1.FieldByName('Username').AsString;
StringGrid1.Cells[1,i]:= SqlQuery1.FieldByName('Password').AsString;
StringGrid1.Cells[2,i]:= SqlQuery1.FieldByName('id').AsString;
end;
end;
So in my database only one line. But program adding a lot of copies of this line in StringGrid and it causes error(Index out of bounds).
Danger
It appears you are storing passwords in plain text form in a database.
This is an extremely bad idea.
Never store passwords in a database.
Use salted hashes instead.
See: How do I hash a string with Delphi?
There are a couple of other problems in your code:
You don't ensure that the stringgrid has enough rows to hold your data.
You're not moving to the next line in the query.
You're opening the query before the connection is open.
You're using FieldByName inside a loop, this is going to be very slow.
Simple solution
Use a DBGrid.
If you insist on using a StringGrid
I suggest refactoring the code like so:
var
i,a:Integer;
FUsername, FPasswordHash, Fid, FSalt: TField;
begin
if not(MySQl55Connection.Active) then MySql55Connection1.Open;
SqlQuery1.SQL.Text:= 'SELECT * FROM users'; //only use backticks on reserved words.
SqlQuery1.Open;
FUsername:= SqlQuery1.FieldByName('Username');
//do not use plain text passwords!!
FPasswordHash:= SQLQuery1.FieldByName('SaltedPasswordHashUsingSHA256');
FId:= SqlQuery1.FieldByName('id');
FSalt:= SQLQuery1.FieldByName('SaltUsingCryptoRandomFunction');
a:= StringGrid1.FixedRowCount;
if SQLQuery1.RecordCount = -1 then StringGrid1.RowCount = 100 //set it to something reasonable.
else StringGrid1.RowCount:= a + SQLQuery1.RecordCount;
//SQLQuery1.DisableControls
try
i:= StringGrid1.FixedRowCount;
while not(SQLQuery1.EOF) do begin
if i >= StringGrid1.RowCount then StringGrid1.RowCount:= i;
StringGrid1.Cells[0,i]:= FUserName.AsString;
StringGrid1.Cells[1,i]:= FPasswordHash.AsString;
StringGrid1,Cells[3,i]:= FSaltInHex.AsString;
StringGrid1.Cells[2,i]:= FId.AsString;
SQLQuery1.Next; //get next row.
Inc(i);
end; {while}
finally
//just in case you want to do endupdate or close the SQLQuery or do SQLQuery1.EnableControls
end;
end;
Basic security example
Here's how to hash a password:
Download Lockbox3.
Put a THash on your form and set the hash property to SHA-512.
Use the following code to produce a hash result.
function StringToHex(const input: string): AnsiString;
var
NumBytes, i: Integer;
B: Byte;
W: word;
Wa: array[0..1] of byte absolute W;
begin
NumBytes := input.length * SizeOf(Char);
SetLength(Result, NumBytes * 2);
for i := 1 to NumBytes do begin
if SizeOf(Char) = 1 then begin
B:= Byte(input[i]);
BinToHex(#B, #Result[(I*2)+1], 1);
end else begin
W:= Word(input[i]);
BinToHex(#Wa[0], #Result[(i*4+0)],1);
BinToHex(#Wa[1], #Result[(i*4+1)],1);
end; {else}
end;
end;
function TForm1.HashPassword(var Password: string; const Salt: string): string;
var
KillPassword: pbyte;
begin
Hash1.HashString(StringToHex(Password)+StringToHex(Salt));
KillPassword:= PByte(#Password[1]);
FillChar(KillPassword^, Length(Password)*SizeOf(Char), #0); //remove password from memory.
Password:= ''; //Now free password.
end;
function GenerateSalt( ByteCount: integer = 32): string;
var
Buffer: TMemoryStream;
begin
Buffer := TMemoryStream.Create;
try
Buffer.Size := ByteCount;
RandomFillStream( Buffer);
result := Stream_to_Base64( Buffer);
finally
Buffer.Free
end;
end;
This is the minimum amount of work you can get away with whilst still having things secure.
Do not think that your passwords are unimportant because you just have a toy database, because people reuse passwords and thus your toy passwords end up being the same passwords used for online banking and such.
People are lazy....
I have an issue on rewriting my .txt file, did I made some mistake? The program run smoothly though. This is a piece of my library.
//global variable
uses utheatre;
var loadUDT:TheatreUDT;
//utheatre library
type
TheatreUDT = record
Member:text;
end;
procedure load_main(var loadUDT : TheatreUDT);
begin
load_Member(loadUDT.Member);
end;
procedure load_Member(var Member:text);
begin
assign (Member,'Data/Member.txt');
end;
procedure regis(var loadUDT:TheatreUDT);
var
s:string;
begin
rewrite(loadUDT.Member);
write('> Input Username : ');
readln(s);
write(loadUDT.Member,s);
write(loadUDT.Member,' | ');
write('> Input Password : ');
readln(s);
write(loadUDT.Member,s);
writeln(loadUDT.Member,' | 100000');
writeln('> Registration Successful');
end;
procedure exit(var loadUDT:TheatreUDT; var bool_main:boolean);
begin
close(loadUDT.Member);
bool_main := False;
end;
I expected the output inside my notepad will be
username | password | 100000
but it seems that the Member.txt is not updated. Thanks before.
EDIT : This is My Main Program
begin
bool_main := True;
while(bool_main) do begin
write('> ');
readln(input_main);
case input_main of
'load' : load_main(loadUDT);
'register' : regis(loadUDT);
'exit' : exit();
end;
end;
end.
N.B. I found out that when I add "close(loadUDT.Member)" inside my "regis procedure", it worked, however it didn't work when i insert the "close(loadUDT.Member)" inside the "exit procedure". Any ideas why? Thanks again before.
Nevermind, I found the answer already. exit() is reserved. Sorry Guys.
N.B. Thanks to #gammatester
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;