davornik

Maybe you can check if file is signed with this:

uses Winapi.ImageHlp;

function IsFileDigitallySigned(const FileName: string): Boolean;
var
  FileHandle: THandle;
  CertHeader: TWinCertificate;
begin
  Result := False;
  FileHandle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
  if FileHandle <> INVALID_HANDLE_VALUE then
    try
      FillChar(CertHeader, SizeOf(CertHeader), 0);
      Result := ImageGetCertificateHeader(FileHandle, 0, CertHeader);
    finally
      CloseHandle(FileHandle);
    end;
end;

This is great.

How can you set (background or font) color of particular date in TMonthCalendar?

2 minutes ago, Remy Lebeau said:

And yet, that is the way Microsoft wants you to use it.

If you really want to detect a mouse click, you will likely have to subclass the TDateTimePicker's window to handle WM_MOUSE(DOWN|UP) messages directly.

How to subclass TDateTimePicker's window on WM_MOUSE(DOWN|UP) messages?

4 hours ago, Lajos Juhász said:

You are setting the date to today thus after the user clicks to reset the value will remain. Change the code to:

 

procedure TForm1.btnResetClick(Sender: TObject);
begin
  DateTimePicker1.Format:=' ';
  DateTimePicker1.Date:=0;
end;

Now it will change when the user clicks on the today.

Yes, but it will then show something like 1899 year. DateTimePicker1.Date must be :=Date; is because it needs to be on today's date for user convinience, when calendar drops down - it is user frendly to have view of current month.

4 hours ago, PeterBelow said:

The control (a Windows common control under the VCL surtace) has no real concept of an "empty" state. The usual way to use it is to set the shown date to Today (it does that by default if memory serves) and accept that if the user does not change it. If your requirements really need a way to detect that the user has entered a date you can use an additional TCheckbox that disables the picker unless it is checked.

I dont want to use checkbox, because it is not user frendly. Main problem is that OnChange event does not fire on every click on calendar but only if Date <> Today.

I am using DateTimePicker1.Format as ' ' to set the value to an empty string in TDateTimePicker (using it as dtkDate).

procedure TForm1.FormCreate(Sender: TObject);
begin
  DateTimePicker1.Format:=' ';
end;

procedure TForm1.DateTimePicker1Change(Sender: TObject);
begin
  DateTimePicker1.Format:='';
end;

procedure TForm1.btnResetClick(Sender: TObject);
begin
  DateTimePicker1.Format:=' '; //set as Empty
  DateTimePicker1.Date:=Date;
end;

Change event does not fire if I select today's date. How can I detect a click on the calendar if today's date is selected or clicked somewhere in the calendar itself?

After searching myself for way to populate ComboBoxEx with items from TListView in order to be able to filter data I have made recursive function which iterates through all ListView data. It may be usefull.

procedure TForm1.btnPopulateClick(Sender: TObject);
var
  lvl: Integer;
  mNode: TTreeNode;
//--
procedure PlaceTreeItem(nTree: TTreeNode; nLvl: Integer);
var
  nIndent, nImg: Integer;
  NextNode, LastNode: TTreeNode;
begin
  nIndent:=nLvl * 2;
  if nTree.HasChildren then nImg:=0 else nImg:=1;
  ComboBoxEx1.ItemsEx.AddItem(nTree.Text, nImg, nImg, nImg, nIndent, nTree.Data);
  if nTree.HasChildren then
    begin
      Inc(lvl);
      NextNode := nTree.getFirstChild;
      LastNode := nTree.GetLastChild;
      while NextNode <> nil do begin
        PlaceTreeItem(NextNode, lvl);
        if NextNode = LastNode then Dec(lvl);
        NextNode := NextNode.getNextSibling;
      end;
    end;
end;
//--
begin
  ComboBoxEx1.Clear;
  lvl:=0;
  mNode := TreeView1.Items.GetFirstNode;
  while Assigned(mNode) do begin
    PlaceTreeItem(mNode, 0);
    mNode := mNode.getNextSibling;
  end;
end;

I am trying to connect with web-browser to Indy HTTP server runing on https://127.0.0.1:4567.

I have read many tutorials and some of them are interesting, like:
1. https://mikejustin.wordpress.com/2019/06/14/how-to-lets-encrypt-certificates-with-indy-http-server/
2. https://synaptica.info/en/2016/09/21/build-your-own-https-server-with-delphi/

I have created self signed certificates with help of this example tutorial:
https://github.com/glenkleidon/DelphiCertAuth
As a passphrase for testing I used "123456".
After that I have installed newly generated file root_cert.crt in Trusted Root CA in Windows (using "WinKey+R" and certmgr.msc)

In my code I have set:

...  
  // create IOHandler for OpenSSL
  IdServerIOHandlerSSLOpenSSL1.SSLOptions.CertFile := 'mycomputerCertificate.pem';
  IdServerIOHandlerSSLOpenSSL1.SSLOptions.KeyFile := 'mycomputerPrivateKey.pem';
  IdServerIOHandlerSSLOpenSSL1.SSLOptions.RootCertFile := 'certificateAuthorityCertificate.pem';
  IdServerIOHandlerSSLOpenSSL1.SSLOptions.Mode := sslmServer;
  IdServerIOHandlerSSLOpenSSL1.SSLOptions.SSLVersions := [sslvTLSv1, sslvTLSv1_1, sslvTLSv1_2];
...
procedure TForm1.IdServerIOHandlerSSLOpenSSL1GetPassword(var Password: string);
begin
  Password := '123456';
end;
...
procedure TForm1.IdHTTPServer1QuerySSLPort(APort: Word; var VUseSSL: Boolean);
// This will not be called when the request is a HTTPS request
// It facilitates the use of the server for testing via HTTP://localhost:8080 (i.e. without SSL)
begin
  VUseSSL := (APort <> 8080);
end;
...
function TForm1.IdServerIOHandlerSSLOpenSSL1VerifyPeer(Certificate: TIdX509;
  AOk: Boolean; ADepth, AError: Integer): Boolean;
begin
  if ADepth = 0 then
    Result := AOk
  else
    Result := True;
end;
...

Unfortunately, when I try to connect to https://127.0.0.1:4567 I get an warning (check image).

In application I can see messages and exception raised:
IdServerIOHandlerSSLOpenSSL1StatusInfo(const AMsg: string);
AMsg := SSL status: "before/accept initialization";
AMsg := SSL status: "before/accept initialization";
AMsg := SSL status: "SSLv3 read client hello A";
AMsg := SSL status: "SSLv3 write server hello A";
AMsg := SSL status: "SSLv3 write certificate A";
AMsg := SSL status: "SSLv3 write server done A";
AMsg := SSL status: "SSLv3 flush data";
AMsg := SSL status: "SSLv3 read client certificate A";
AMsg := SSL status: "SSLv3 read client key exchange A";
AMsg := SSL status: "error";
127.0.0.1:55810 Stat Disconnected.

IdHTTPServer1Exception(AContext: TIdContext; AException: Exception);
EIdOSSLUnderlyingCryptoError: Error accepting connection with SSL.
error:14094416:SSL routines:ssl3_read_bytes:sslv3 alert certificate unknown

Am I doing something wrong or I am missing something?

Why I can't connect to IP address without warning?

On 2/25/2022 at 6:10 PM, Rollo62 said:

Why ? If you want to igore a key you could abort operation, and also do other oprtation.

Do you want to determine where the key is sended from, to do differentiate operations depending on sended from hardware or virtual keyboard ?

Yes, I want to determine from where key is sent.

I would like to intercept Key from external keyboard before it reaches TEdit or Form. Is this possible?

That is not good solution, has some issues. However, OnFormKeyUp is better choice (key is possible to receive only once according to Android docs), but if TEdit is focused TForm doesn't get key.

Then, again, if I type Key in external keyboard and I am in TEdit control, key is shown in TEdit (I would like to Intercept it before it reaches any Control on Form or Form itself).

Is it possible to differentiate Key origin?

Is it received from Virtual Keyboard or HID device?

Is it posible in Android to intercept keyboard presses from hardware keyboard attached to device? I can detect is HID Device present, but how to get key input from HID before form does?

function TForm1.AttachedHIDDevice: Boolean;
var
  i: Jiterator;
  JavaObject: JObject;
  DeviceList: JHashMap;
  USBDevice: JUSBDevice;
  UsbManager: JUSBManager;
begin
  //Device discovery
  Result := False;
  //Get pointer to UsbManager
  JavaObject := TAndroidHelper.Context.getSystemService(TJContext.JavaClass.USB_SERVICE);
  UsbManager := TJUsbManager.Wrap((JavaObject as ILocalObject).GetObjectID);
  if not Assigned(UsbManager) then Exit;
  //Get a list of connected devices
  DeviceList := UsbManager.getDeviceList;
  i := DeviceList.values.iterator;
  while i.hasNext do begin
    USBDevice := TJUsbDevice.Wrap((i.next as ILocalObject).GetObjectID);
    if (USBDevice.getInterfaceCount > 0) then
      begin
        Result := USBDevice.getInterface(0).getInterfaceClass = TJUsbConstantsUSB_CLASS_HID;
        if Result then Break;
      end;
  end;
end;

Perhaps you can use this thread:

https://en.delphipraxis.net/topic/5883-delphi-1042-ce-support-android-api-30/

Thank you for yours post, this also helped me to upload app to Google store. Just to make things clearer to download android-30 you must:

- run cmd.exe

- type cd [path] to go to location where sdkmanager.bat is (usually it is: C:\Users\Public\Documents\Embarcadero\Studio\21.0\PlatformSDKs\android-sdk-windows\tools\bin or C:\Users\Public\Documents\Embarcadero\Studio\21.0\CatalogRepository\AndroidSDK-2525-21.0.40680.4203\tools\bin)

- type sdkmanager "platforms;android-30"

- answer y on question, and wait until it says "done"

Everything else is straightforward...

Code can be made compatible with 64-bit, i have posted probable solution here:

https://stackoverflow.com/a/61874765/3225668

NOTE: in FastcodeCPUID.pas there is an error with position of registers when returning value. Registers in code goes like Move...EBX...EDX...ECX... Proper way should be EBX...ECX...EDX...!

I have finally found solution and posted it here:

https://stackoverflow.com/a/61874765/3225668

procedure ChkVMware;
asm
  push rdx;
  push rcx;
  push rbx;

  mov rax, 'VMXh';
  mov rbx, 0;
  mov rcx, 10;
  mov rdx, 'VX';

  in rax, dx;  <-- here is error: operand size mismatch

  cmp rbx, 'VMXh';
  setz [Result];

  pop rbx;
  pop rcx;
  pop rdx;
end;

Thank you. In that link registers are like eax, edx, ecx and rbx for 32-bit, but if you change them to 64-bit (rax, rdx, rcx, rbx) then I get error: operand size mismatch.

I even dont know if this is proper way to change registers?

// VMware detection as described by Elias Bachaalany
function IsInsideVMware: Boolean;
//------------------------------
procedure ChkVMware;
asm
  push edx;
  push ecx;
  push ebx;

  mov eax, 'VMXh';
  mov ebx, 0;
  mov ecx, 10;
  mov edx, 'VX';

  in eax, dx;

  cmp ebx, 'VMXh';
  setz [Result];

  pop ebx;
  pop ecx;
  pop edx;
end;
//------------------------------
begin
  Result := True;
  try
    ChkVMware;
  except
    Result := False;
  end;
end;


function IsRunningUnderHyperV: BOOL; stdcall;
var
  VMBranding: array[0..12] of AnsiChar;
//------------------------------
procedure GetVMBrand;
asm
  mov eax, $40000000;
  cpuid;
  mov dword ptr [VMBranding+0], ebx;  // Get the VM branding string
  mov dword ptr [VMBranding+4], ecx;
  mov dword ptr [VMBranding+8], edx;
end;
//------------------------------
begin
  GetVMBrand;
  VMBranding[12] := #0;
  Result := CompareText(String(VMBranding), 'Microsoft Hv') = 0;
end;

How can thiese function be done in 64-bit? On compile I get

[dcc64 Error] Unit1.pas(33): E2116 Invalid combination of opcode and operands

Registers need to be changed. Which to use?