//Delphi:

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls, jpeg;

//Retreive cursor position

procedure TForm1.Button1Click(Sender: TObject);
var
MausPos: TPoint;
begin
GetCursorPos(MausPos);
label1.Caption := IntToStr(MausPos.x);
label2.Caption := IntToStr(MausPos.y);
end;

//---------------->

//Set cursor position

procedure TForm1.Button2Click(Sender: TObject);
begin
SetCursorPos(1800, 900);

// Simulate the right mouse button down
// Rechte Maustaste simulieren
mouse_event(MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0);
mouse_event(MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0);

end;

//---------------->

procedure TForm1.Timer1Timer(Sender: TObject);
var
MausPos: TPoint;
var W,M:Word;
S:String;
begin
W:=GetAsyncKeyState(VK_LBUTTON);
M:=GetAsyncKeyState(VK_RBUTTON);

GetCursorPos(MausPos);
label1.Caption := IntToStr(MausPos.x);
label2.Caption := IntToStr(MausPos.y);

{
if W = $8001 then S := 'slobodna' else
if W = $0001 then S := 'pritisnuta' else
if W = $8000 then S := 'davno pritisnuta' else
if W = $0000 then S := 'davno slobodna' else
S := 'uci';
}

if W = $0001 then S := 'Left';
if M = $0001 then S := 'Right';

Label3.Caption:=Format('%s %.4x',[S , W] );
end;

//THE REAL POWER OF LAZARUS-IDE:

//Drop the rest, Lazarus is the best !

//Lazarus-IDE: //---------------->

MouseAndKeyInput

│ English (en) │ français (fr) │

[hide]

About

MouseAndKeyInput package is a tool for cross-platform manipulation with mouse and key input. You can move mouse cursor to specified location, send clicks and do key presses. It is suitable for GUI testing or program control demonstration.

Location

lazarusdir/components/mouseandkeyinput

Author

Tom Gregorovic

License

GPL

Change Log

Version 0.1

Restrictions

it is not recommended calling mouse and key input directly from events like OnClick, use Application.QueueAsyncCall instead
do not forget to set back mouse button and key state after Down method with Up method

Carbon

pressing alpha chars is not supported

Gtk1/2

needs Xtst library
ALT key pressing is not supported

How to

With your project open: Go to the Lazarus install directory -> components -> mouseandkeyinput. There you will find: lazmouseandkeyinput.lpk. Open and compile the .lpk.

In your unit.pas add in Uses: MouseAndKeyInput ,LCLType

To simulate press of F1 from a button:

procedure TForm1.HelpButtonClick(Sender: TObject); begin

 KeyInput.Apply([ssCtrl]);
 KeyInput.Press(VK_F1);                // This will simulate press of F1 function key.
 KeyInput.Unapply([ssCtrl]);

end;

VK- def's is found here: http://lazarus-ccr.sourceforge.net/docs/lcl/lcltype/index-2.html

Mouse control:

 MouseInput.Click(mbLeft,[],300,300);   // Left click on X:=300 , Y:=300
 MouseInput.Click(mbRight,[],1365,2);   // Right click on X:=1365 , Y:=2

https://forum.lazarus.freepascal.org/index.php?topic=39806.0

function ReadURL(url:string):string;
begin
with TFPHTTPClient.Create(nil) do
try
ReadURL:= Get('https://api.bitfinex.com/v1/ticker/btcusd');
finally
Free;
end;
end;

//------------------>

with TFPHTTPClient.Create(nil) do
try
SimplePost(); // or Post();
finally
Free;
end;

https://svn.freepascal.org/svn/fpc/tags/release_3_0_0/packages/fcl-web/src/base/fphttpclient.pp

//------------------>

Procedure Post(const URL: string; const Response: TStream);
Procedure Post(const URL: string; Response : TStrings);
Procedure Post(const URL: string; const LocalFileName: String);
function Post(const URL: string) : String;

Class Procedure SimplePost(const URL: string; const Response: TStream);
Class Procedure SimplePost(const URL: string; Response : TStrings);
Class Procedure SimplePost(const URL: string; const LocalFileName: String);
Class function SimplePost(const URL: string) : String;

//------------------>

uses
Windows, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,IdHTTP;

function StringToHex(S: String): string;
var I: Integer;
begin
Result:= '';
for I := 1 to length (S) do
Result:= Result+IntToHex(ord(S[i]),2);
end;

function HexToString(H: String): String;
var I: Integer;
begin
Result:= '';
for I := 1 to length (H) div 2 do
Result:= Result+Char(StrToInt('$'+Copy(H,(I-1)*2+1,2)));
end;

function GetDosOutput(CommandLine: string; Work: string = 'C:\Windows\System32'): string;
var
SA: TSecurityAttributes;
SI: TStartupInfo;
PI: TProcessInformation;
StdOutPipeRead, StdOutPipeWrite: THandle;
WasOK: Boolean;
Buffer: array[0..255] of AnsiChar;
BytesRead: Cardinal;
WorkDir: string;
Handle: Boolean;
begin
Result := '';
with SA do begin
nLength := SizeOf(SA);
bInheritHandle := True;
lpSecurityDescriptor := nil;
end;
CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
try
with SI do
begin
FillChar(SI, SizeOf(SI), 0);
cb := SizeOf(SI);
dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
wShowWindow := SW_HIDE;
hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
hStdOutput := StdOutPipeWrite;
hStdError := StdOutPipeWrite;
end;
WorkDir := Work;
Handle := CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
nil, nil, True, 0, nil,
PChar(WorkDir), SI, PI);
CloseHandle(StdOutPipeWrite);
if Handle then
try
repeat
WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
if BytesRead > 0 then
begin
Buffer[BytesRead] := #0;
Result := Result + Buffer;
end;
until not WasOK or (BytesRead = 0);
WaitForSingleObject(PI.hProcess, INFINITE);
finally
CloseHandle(PI.hThread);
CloseHandle(PI.hProcess);
end;
finally
CloseHandle(StdOutPipeRead);
end;
end;

//------------------>

unit main;{$mode objfpc}{$H+}interfaceuses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  fphttpclient, regexpr;type{ TForm1 }TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure downloadBook(bookname: String);
  privatepublicend;var
  Form1: TForm1;implementation{$R *.lfm}{ TForm1 }const
  baseUrl = 'https://books.goalkicker.com/';var
    targetDirectory: AnsiString;procedure TForm1.Button1Click(Sender: TObject);
var
  page, bookname: AnsiString;
  re: TRegExpr;
begin
  targetDirectory := GetUserDir + 'downloads' + DirectorySeparator + 'GoalKickerBooks' + DirectorySeparator;if Not DirectoryExists(targetDirectory) then
    CreateDir(targetDirectory);// Grab the base page
  page := TFPHTTPClient.SimpleGet(baseUrl);// Find all book urls
  re := TRegExpr.Create('<a href="([\w]+)/"');
  try
    if re.Exec(page) then begin
      bookname := re.Match[1];
      downloadBook(bookname);
      while re.ExecNext do begin
        bookname := re.Match[1];
        downloadBook(bookname);
        Application.ProcessMessages;
      end;
    end;Memo1.Append('');
    Memo1.Append('All books downloaded');
  finally
    re.Free;
  end;
end;procedure TForm1.downloadBook(bookname: String);
var
  page: AnsiString;
  re: TRegExpr;
begin
  // Get page
  page := TFPHTTPClient.SimpleGet(baseUrl + bookname + '/index.html');// Grab PDF url
  re := TRegExpr.Create('location.href=''([\w]+.pdf)''');
  try
    if re.Exec(page) then begin
      Memo1.Append('Downloading ' + baseUrl + bookname + '/' + re.Match[1]);
      TFPHTTPClient.SimpleGet(baseUrl + bookname + '/' + re.Match[1], targetDirectory + re.Match[1]);
    end;
  finally
    re.Free;
  end;
end;end.

https://medium.com/@marcusfernstrm/create-a-web-scraper-with-freepascal-lazarus-ffe644f8c34

fphttpclient

[hide]

Overview

fphttpclient is supplied with FPC as part of the fcl-web package, and can be used by itself as well.

HTTPS (TLS/SSL)

Since April 2014, the trunk/development fphttpclient supports SSL/TLS connections using the OpenSSL library (will ship with version 2.8.0 and above). This requires the OpenSSL .so/.dll/.dylib library/libraries to be installed (e.g. present in your application or system directory on Windows).

If you do not use client side certificates, just specifying the proper port (e.g. 443 for https) is enough to enable TLS/SSL as long as you have OpenSSL libraries installed (or e.g. in the application directory)
If you want to use e.g. a client side certificate, do something like this:

uses ...ssockets, sslsockets..
// Callback for setting up SSL client certificate
procedure TSSLHelper.SSLClientCertSetup(Sender: TObject; const UseSSL: Boolean;
  out AHandler: TSocketHandler);
begin
  AHandler := nil;
  if UseSSL and (FClientCertificate <> '') then
  begin
    // Only set up client certificate if needed.
    // If not, let normal fphttpclient flow create
    // required socket handler
    AHandler := TSSLSocketHandler.Create;
    // Example: use your own client certificate when communicating with the server:
    (AHandler as TSSLSocketHandler).Certificate.FileName := FClientCertificate;
  end;
end;

//... and in your TFPHTTPClient creation:
myclient := TFPHTTPClient.Create(nil);
if FClientCertificate <> '' then
  myclient.OnGetSocketHandler := @SSLClientCertSetup;

Examples

Examples are included in your FPC directory: packages/fcl-web/examples/

Apart from those, please see below:

Get body of a web page via HTTP protocol

uses fphttpclient;

Var
  S : String;

begin
  With TFPHttpClient.Create(Nil) do
    try
      S := Get(ParamStr(1));
    finally
      Free;
    end;
  Writeln('Got : ',S);
end.

If you want to write even fewer lines of code, in FPC 2.7.1 you can use the class method:

s := TFPCustomHTTPClient.SimpleGet('http://a_site/a_page');

Download a file via HTTP protocol

Let's show you the simplest example using HTTP only. This example retrieves just an html page and writes it to the screen.

It uses one of the class Get methods of TfpHttpClient. You don't need to create and free the class. There are several overloads for e.g. TStrings or TStream (file) as well:

program dl_fphttp_a;
{$mode delphi}{$ifdef windows}{$apptype console}{$endif}
uses 
  fphttpclient;
begin  
  writeln(TFPHttpClient.SimpleGet('http://example.com')); 
end.

That's all! For simple purposes this will suffice. You can even use it for HTTPS, which needs just the inclusion of two units:

program dl_fphttp_b;

{$mode delphi}{$ifdef windows}{$apptype console}{$endif}

uses 
  fphttpclient,
 fpopenssl,
 openssl;

begin  
  writeln(TFPHttpClient.SimpleGet('https://freepascal.org')); 
end.

This really is all there is to do in simple scenarios, usually if you have enough control.

But there are some caveats with this code. The foremost one being that this code does not allow for redirects. Let me demo that:

program dl_fphttp_redirect_error;
{$mode delphi}{$ifdef windows}{$apptype console}{$endif}
uses 
  sysutils, fphttpclient, fpopenssl, openssl;
begin  
  try
    writeln(TFPHttpClient.SimpleGet('https://google.com')); 
  except on E:EHttpClient do
    writeln(e.message) else raise;
  end;
end.

Because the Google URL uses redirects, there is an exception: "Unexpected response status code: 301". In such a case we need more control, which I will show you in the next example:

program dl_fphttp_c;

{$mode delphi}{$ifdef windows}{$apptype console}{$endif}

uses
  classes, 
  fphttpclient,
  fpopenssl,
  openssl;

var
  Client: TFPHttpClient;

begin

  { SSL initialization has to be done by hand here }
  InitSSLInterface;

  Client := TFPHttpClient.Create(nil);
  try
    { Allow redirections }
    Client.AllowRedirect := true;
    writeln(Client.Get('https://google.com/')); 
  finally
    Client.Free;
  end;
end.

You see this requires slightly more code, but it is still a very small program. Well, now we go to the last example, which downloads any file and saves it to disk. You can use it as a template for your own code, it demonstrates almost everything you need.

program dl_fphttp_d;

{$mode delphi}{$ifdef windows}{$apptype console}{$endif}

uses
  sysutils, 
  classes, 
  fphttpclient, 
  fpopenssl, 
  openssl;

const
  Filename = 'testdownload.txt';

var
  Client: TFPHttpClient;
  FS: TStream;
  SL: TStringList;

begin

  { SSL initialization has to be done by hand here }
  InitSSLInterface;

  Client := TFPHttpClient.Create(nil);
  FS := TFileStream.Create(Filename,fmCreate or fmOpenWrite);
  try
    try
      { Allow redirections }
      Client.AllowRedirect := true;
      Client.Get('https://google.com/',FS); 
    except
      on E: EHttpClient do
        writeln(E.Message)
      else
        raise;
    end;
  finally
    FS.Free;
    Client.Free;
  end;
  
  { Test our file }
  if FileExists(Filename) then
  try
    SL := TStringList.Create;
    SL.LoadFromFile(Filename);
    writeln(SL.Text);
  finally
    SL.Free;
  end;      
end.

Upload a file using POST

Use TFPHTTPClient.FileFormPost()

uses fphttpclient;

Var
  Respo: TStringStream;
  S : String;

begin
  With TFPHttpClient.Create(Nil) do
    try
      Respo := TStringStream.Create('');
      FileFormPost('http://example.com/upload.php','PostFilenameParam (ex. 'file')',edtSourceFile.Text,Respo);
      S := Respo.DataString;
      Respo.Destroy;
    finally
      Free;
    end;
end.

Form data and encoding

 FormPost(const URL: string; FormData: TStrings; const Response: TStream);

 FormPost(const URL, FormData: string; const Response: TStream);

If you pass FormData as TStrings the FormPost procedure performs EncodeURLElement but if you pass FormData as simple string to FormPost, then EncodeURLElement is not performed.

There is no difference in the behaviour if the data in FormData does not need to be encoded, but there is different behaviour for strings which include characters which are not allowed (eg '@', '=', etc).

Get external IP address

If your computer is connected to the internet via a LAN (cabled or wireless), the IP address of your network card most probably is not your external IP address.

You can retrieve your external IP address from e.g. your router or an external site. The code below tries to get it from an external site (thanks to JoStudio on the forum for the inspiration: [1]):

{$mode objfpc}{$H+}

uses
  Classes, SysUtils, fphttpclient, RegexPr;

function GetExternalIPAddress: string;
var
  HTTPClient: TFPHTTPClient;
  IPRegex: TRegExpr;
  RawData: string;
begin
  try
    HTTPClient := TFPHTTPClient.Create(nil);
    IPRegex := TRegExpr.Create;
    try
      //returns something like:
      {
<html><head><title>Current IP Check</title></head><body>Current IP Address: 44.151.191.44</body></html>        
      }
      RawData:=HTTPClient.Get('http://checkip.dyndns.org');
      // adjust for expected output; we just capture the first IP address now:
      IPRegex.Expression := RegExprString('\b\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\b');
      //or
      //\b(?:\d{1,3}\.){3}\d{1,3}\b
      if IPRegex.Exec(RawData) then
      begin
        result := IPRegex.Match[0];
      end
      else
      begin
        result := 'Got invalid results getting external IP address. Details:'+LineEnding+
          RawData;
      end;
    except
      on E: Exception do
      begin
        result := 'Error retrieving external IP address: '+E.Message;
      end;
    end;
  finally
    HTTPClient.Free;
    IPRegex.Free;
  end;
end;

begin
  writeln('External IP address:');
  writeln(GetExternalIPAddress);
end.

Beogradsko programiranje

beogradsko programiranje

Wednesday, April 15, 2020

Create AnyDesk or TeamViewer similar apps by self