Jump to content

Leaderboard


Popular Content

Showing content with the highest reputation on 04/26/24 in Posts

  1. Alexander Sviridenkov

    WebUI framework: Technical preview. Part 1.

    Yes, it will be available for free for customers with active subscription (at release date) on Bundle mentioned above (HTML Component Library + HTML Editor Library + HTML Report Library)
  2. Alexander Sviridenkov

    WebUI framework: Technical preview. Part 1.

    Small example of using custom HTML/JS inside Report control. JS code send pallet and boxes params to Server (Delphi), receive calculated pallet loading and display it. pallet.mp4
  3. Clément

    TCP Port Check with timeout

    I while back I was researching "TCP ping" for my application. I ended up encapsulating the calls in a class. I'm using vanilla sockets for this. unit dhs.tcpPing; interface uses WinSock, Winsock2; type TNotifyPingRequest = procedure( aSender : TObject; const apcHost : String; aPort : Integer; aConnected : Boolean; aResponseTime : Double ) of object; TdhsTCPping = class private fWSAStartup : Integer; fWSAData : TWSAData; fHints : TAddrInfoW; fAddrInfo : TAddrinfoW; fCurrentAI : PAddrInfoW; private fOnNotifyPingRequest: TNotifyPingRequest; function EstablishConnection( address : TAddrInfoW; ping_timeout : integer; var errorcode : integer; blocking : Boolean ):TSocket; function CheckAddrInfo( const pcHost : String; port : integer; ipv : integer ) : Boolean; function DoWinsock( const pcHost : String; port : Integer; times_to_ping : integer; ping_interval : double; ping_timeout : integer; blocking : boolean ) : Integer; function DoWinSock_Single( const apcHost : String; aPort : Integer; times_to_ping : integer; ping_interval : double; ping_timeout : integer; blocking : boolean ) : Integer; procedure DoNotifyPingRequest( const apcHost : String; aPort : Integer; aConnected : Boolean; aResponseTime : Double ); public constructor Create; destructor Destroy; override; function ping( const pcHost : String; port : Integer; times_to_ping : integer; ping_interval : double; ping_timeout : integer ) : Integer; property OnPingRequest : TNotifyPingRequest read fOnNotifyPingRequest write fOnNotifyPingRequest ; end; function ioctlsocket(s: TSocket; cmd: u_long; var argp: u_long): Integer; stdcall; implementation uses Winapi.Windows, System.SysUtils; constructor TdhsTCPping.Create; begin fWSAStartup := WSAStartup(MakeWord(1,1), fWSAData);; end; destructor TdhsTCPping.Destroy; begin if fWSAStartup=0 then WSACleanup; inherited; end; const ws2_32 = 'ws2_32.dll'; function ioctlsocket; external ws2_32 name 'ioctlsocket'; function TdhsTCPping.CheckAddrInfo( const pcHost : String; port : integer; ipv : integer ) : Boolean; var lPort : Array[0..5] of Char; lHostName : Array[0..255] of Char; lpAddrInfo : PaddrinfoW; r : integer; begin ZeroMemory(@fHints, sizeof(TAddrInfoW)); fHints.ai_family:= PF_UNSPEC; fHints.ai_socktype := SOCK_STREAM; StrCopy(@lHostName, PCHar( pcHost ) ); StrCopy(@lPort, PChar(Format('%d',[Port]))); lpAddrInfo := @fAddrInfo; r := getaddrinfoW(@lHostName[0],@lPort[0], fHints, lpAddrInfo ); fCurrentAI := lpAddrInfo; result := false; while Assigned(fCurrentAI) do begin if ((fCurrentAI.ai_family = AF_UNSPEC) and (ipv = 0)) or ((fCurrentAI.ai_family = AF_INET) and (ipv <> 6)) or ((fCurrentAI.ai_family = AF_INET6) and (ipv <> 4)) then begin Result := true; break; end; fCurrentAI := fCurrentAI^.ai_next; end; end; procedure TdhsTCPping.DoNotifyPingRequest(const apcHost: String; aPort: Integer; aConnected : Boolean; aResponseTime : Double ); begin if Assigned( fOnNotifyPingRequest ) then fOnNotifyPingRequest( self, apcHost, aPort, aConnected, aResponseTime ); end; function TdhsTCPping.DoWinsock( const pcHost: String; port: Integer; times_to_ping : integer; ping_interval : double; ping_timeout : integer; blocking : boolean ): Integer; var lAI : TAddrInfoW; lErrorCode , lLoopCount : Integer; cpu_frequency : int64; response_timer1 , response_timer2 : int64; response_time : Double; sd : TSocket; begin lLoopCount := 0; if CheckAddrInfo( pcHost, port, 4 ) then begin while (lLoopCount<times_to_ping) or ( times_to_ping = -1) do begin // QueryPerformanceCounter isn't thread safe unless we do this SetThreadAffinityMask(GetCurrentThread(), 1); // start the timer right before we do the connection QueryPerformanceFrequency(cpu_frequency); QueryPerformanceCounter(response_timer1); sd := EstablishConnection( fCurrentAI^, ping_timeout, lErrorCode, blocking ); // grab the timeout as early as possible QueryPerformanceCounter(response_timer2); response_time := (response_timer2 - response_timer1) * 1000.0 / cpu_frequency; inc( lLoopCount ); DoNotifyPingRequest( pcHost, port, sd<>INVALID_SOCKET, response_time ); if sd<>INVALID_SOCKET then begin shutdown( sd, SD_BOTH ); closesocket(sd); end; end; end; end; function TdhsTCPping.DoWinSock_Single( const apcHost : String; aPort : Integer; times_to_ping : integer; ping_interval : double; ping_timeout : integer; blocking : boolean ) : integer ; begin result := DoWinsock( aPCHost, aPort, times_to_ping, ping_interval, ping_timeout, blocking ); end; function TdhsTCPping.EstablishConnection( address : TaddrinfoW; ping_timeout : Integer; var errorcode: integer; blocking: Boolean): TSocket; (*-------------------------------------------------------------------------- Set the socket I/O mode: Blocking -> iMode = 0 !Blocking -> iMode <>0 https://learn.microsoft.com/pt-br/windows/win32/api/winsock/nf-winsock-ioctlsocket //------------------------- // Set the socket I/O mode: In this case FIONBIO // enables or disables the blocking mode for the // socket based on the numerical value of iMode. // If iMode = 0, blocking is enabled; // If iMode != 0, non-blocking mode is enabled. -------------------------------------------------------------------------- *) var timer1 : Int64 ; timer2 : Int64 ; cpu_freq : Int64 ; time_so_far : double; sd : TSocket; iMode : u_long; conResult : integer; sendstatus : integer; done : Boolean; begin // Create a stream socket sd := socket(address.ai_family, address.ai_socktype, address.ai_protocol); iMode := 1; if blocking then iMode := 0; ioctlsocket(sd, DWord( FIONBIO ), iMode); QueryPerformanceCounter( Timer1); QueryPerformanceFrequency( cpu_freq ); conResult := -999; conResult := connect(sd, address.ai_addr^, NativeUint(address.ai_addrlen) ); if (conResult = SOCKET_ERROR) and (iMode = 0) then begin errorcode := WSAGetLastError(); closesocket(sd); exit( INVALID_SOCKET ); end; sendstatus := 1000; done := false; while (not done) do begin sendstatus := send(sd, '', 0, 0); if (sendstatus = 0) then done := true; QueryPerformanceCounter(timer2); time_so_far := ((timer2 - timer1) * 1000.0) / (cpu_freq *1.0) ; if (time_so_far >= ping_timeout) then done := true else begin // Todo: Get rid of this sleep! if (time_so_far < 200) then Sleep(0) else Sleep(1); end; end; closesocket(sd); errorcode := WSAGetLastError(); if sendstatus = 0 then exit( sd ) else exit( INVALID_SOCKET ); end; function TdhsTCPping.ping(const pcHost: String; port, times_to_ping: integer; ping_interval: double; ping_timeout: integer): Integer; begin result := DoWinSock_Single(pcHost,port, times_to_ping, ping_interval,ping_timeout, false); end; end. And the example procedure TForm143.event_PingRequest(aSender: TObject; const apcHost: String; aPort: Integer; aConnected: Boolean; aResponseTime: Double); const _Conn : Array[ Boolean ] of String = ('','Connected'); begin Memo1.lines.add( Format('%s:%d %3.4f (%s)', [apcHost, aPort, aResponseTime, _Conn[aConnected]]) ); end; procedure TForm143.FormCreate(Sender: TObject); begin with TdhsTCPping.create do begin OnPingRequest := event_PingRequest; ping('192.168.0.5',80,5,1000,1000); free; end; end; In a TMemo the output looks like: 192.168.0.5:80 17.2611 (Connected) 192.168.0.5:80 0.5438 (Connected) 192.168.0.5:80 0.5148 (Connected) 192.168.0.5:80 0.3728 (Connected) 192.168.0.5:80 0.4739 (Connected) HTH
  4. Hello, I have a DispInterface imported from an external library: ITelescopeV3 = dispinterface ['{A007D146-AE3D-4754-98CA-199FEC03CF68}'] . . end; I would like to create a class of the type: TTelescope = class(TAutoObject, ITelescopeV3) But it doesn't work, 'Interface type required'. I'm pedalling a bit here! Thanks for your help Michel
  5. Dllama, a simple and easy to use library for doing local LLM inference directly from Delphi (any language with bindings). It can load GGUF formatted LLMs into CPU or GPU memory. Uses Vulkan back end for acceleration. Simple Example uses System.SysUtils, Dllama, Dllama.Ext; var LResponse: string; LTokenInputSpeed: Single; LTokenOutputSpeed: Single; LInputTokens: Integer; LOutputTokens: Integer; LTotalTokens: Integer; begin // init config Dllama_InitConfig('C:\LLM\gguf', -1, False, VK_ESCAPE); // add model Dllama_AddModel('Meta-Llama-3-8B-Instruct-Q6_K', 'llama3', 1024*8, '<|start_header_id|>%s %s<|end_header_id|>', '\n assistant:\n', ['<|eot_id|>', 'assistant']); // add messages Dllama_AddMessage(ROLE_SYSTEM, 'you are Dllama, a helpful AI assistant.'); Dllama_AddMessage(ROLE_USER, 'who are you?'); // display the user prompt Dllama_Console_PrintLn(Dllama_GetLastUserMessage(), [], DARKGREEN); // do inference if Dllama_Inference('llama3', LResponse) then begin // display usage Dllama_Console_PrintLn(CRLF, [], WHITE); Dllama_GetInferenceUsage(@LTokenInputSpeed, @LTokenOutputSpeed, @LInputTokens, @LOutputTokens, @LTotalTokens); Dllama_Console_PrintLn('Tokens :: Input: %d, Output: %d, Total: %d, Speed: %3.1f t/s', [LInputTokens, LOutputTokens, LTotalTokens, LTokenOutputSpeed], BRIGHTYELLOW); end else begin Dllama_Console_PrintLn('Error: %s', [Dllama_GetError()], RED); end; Dllama_UnloadModel(); end.
  6. Sherlock

    Work for Embarcadero Sales!

    Done @David Millington https://www.delphipraxis.net/214805-arbeite-fuer-den-embarcadero-vertrieb.html
×