Delphi/Lazarus/Pascal Collection

$> sudo apt-get install freetds-bin

#At Lazarus:
#Put TZConnection component (ZConnection1) and set LibraryLocation as shown:

#  ZConnect1.LibraryLocation:=libsybdb.so.5;

#  and we're done!
procedure TForm1.FormCreate(Sender: TObject);
var
  wplc: TWindowPlacement;
begin
  if not AutoScroll and (WindowState = wsMaximized) then begin
    wplc.length := SizeOf(wplc);
    GetWindowPlacement(Handle, @wplc);
    wplc.rcNormalPosition.Right := wplc.rcNormalPosition.Left + Width;
    wplc.rcNormalPosition.Bottom := wplc.rcNormalPosition.Top + Height;
    wplc.showCmd := SW_MAXIMIZE;
    SetWindowPlacement(Handle, @wplc);
  end;
end;
var
Form1: TForm1;
ms: TMemoryStream;

:

procedure PlayWaveStream(Stream: TMemoryStream);
begin
  if Stream = nil then
    sndPlaySound(nil, SND_ASYNC) //stop sound
  else
    sndPlaySound(Stream.Memory, (SND_ASYNC or SND_MEMORY));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ms.LoadFromFile('c:\Eddie\winner.wav');
  ms.Position := 0;
  PlayWaveStream(ms);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ms := TMemoryStream.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ms.Free;
end;
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdThreadMgr, IdThreadMgrDefault, IdIOHandlerSocket, IdIOHandler,
  IdIOHandlerStream, IdBaseComponent, IdComponent, IdTCPServer,
  IdServerIOHandler, IdServerIOHandlerSocket, StdCtrls, Winsock, ExtCtrls;

type
  PIXEL_FORMAT = packed record
    BitsPerPixel: byte;
    depth: byte;
    BigEndianFlag: byte;
    TrueColourFlag: byte;
    RedMax: Word;
    GreenMax: Word;
    BlueMax: Word;
    RedShift: byte;
    GreenBlue: byte;
    BlueShift: byte;
    Padding: Array[0..2] of byte;
  end;
  
  TForm1 = class(TForm)
    IdTCPServer1: TIdTCPServer;
    IdIOHandlerStream1: TIdIOHandlerStream;
    IdIOHandlerSocket1: TIdIOHandlerSocket;
    IdThreadMgrDefault1: TIdThreadMgrDefault;
    IdServerIOHandlerSocket1: TIdServerIOHandlerSocket;
    Label1: TLabel;
    Label2: TLabel;
    ListBox1: TListBox;
    Label3: TLabel;
    Image1: TImage;
    procedure IdTCPServer1Connect(AThread: TIdPeerThread);
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
  private
    { Private declarations }
    ServerPixelFormat: PIXEL_FORMAT;
    ClientPixelFormat: PIXEL_FORMAT;
    procedure writeProtocolVersionMsg(AThread: TIdPeerThread);
    procedure readProtocolVersionMsg(AThread: TIdPeerThread);
    function authenticate(AThread: TIdPeerThread):Boolean;
    procedure readClientInit(AThread: TIdPeerThread);
    procedure initServer(AThread: TIdPeerThread);
    procedure writeServerInit(AThread: TIdPeerThread);

    procedure readSetPixelFormat(AThread: TIdPeerThread);
    procedure readFixColourMapEntries(AThread: TIdPeerThread);
    procedure readSetEncodings(AThread: TIdPeerThread);
    procedure readFrameBufferUpdateRequest(AThread: TIdPeerThread);
    procedure readKeyEvent(AThread: TIdPeerThread);
    procedure readPointerEvent(AThread: TIdPeerThread);
    procedure readClientCutText(AThread: TIdPeerThread);
    procedure doFrameBufferUpdate(AThread: TIdPeerThread);

    procedure processRequest(AThread: TIdPeerThread);

  public
    { Public declarations }
  end;

const
	// Messages from client to server
  SetPixelFormat = 0;
	FixColourMapEntries = 1;
	SetEncodings = 2;
	FrameBufferUpdateRequest = 3;
	KeyEvent = 4;
	PointerEvent = 5;
	ClientCutText = 6;
var
  Form1: TForm1;

  updateIsAvailable: Boolean = False;

	// Authentication
	ConnFailed: byte = 0;
	NoAuth: byte = 1;
	VncAuth: byte = 2;
	VncAuthOK: Cardinal = 0;
	VncAuthFailed: Cardinal = 1;

	// Messages from server to client
	FrameBufferUpdate: byte = 0;
	SetColourMapEntries: byte = 1;
	Bell: byte = 2;
	ServerCutText: byte = 3;

  protocolVersion: String = 'RFB 003.008'+#10;
  
implementation

{$R *.dfm}

function Swap16(ASmallInt: Word): Word  ;
asm
  xchg al,ah
end;

function Swap32(value: Integer{dword}): Integer{dword} ; assembler ;
asm
  bswap eax
end;


procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
begin
  // 
end;

procedure TForm1.writeProtocolVersionMsg(AThread: TIdPeerThread);
begin
  AThread.Connection.Write(protocolVersion);
end;

procedure TForm1.readProtocolVersionMsg(AThread: TIdPeerThread);
var
  protocolVersionMsg: String;
begin
  protocolVersionMsg := AThread.Connection.ReadLn;
  Label2.Caption := protocolVersionMsg;
end;

procedure TForm1.readClientInit(AThread: TIdPeerThread);
var
isShared: Byte;
begin
  AThread.Connection.ReadBuffer(isShared,1);
end;

procedure TForm1.initServer(AThread: TIdPeerThread);
begin
        // We may already have a shared server
end;

procedure TForm1.readSetPixelFormat(AThread: TIdPeerThread);
var
  padding: byte;
begin
  AThread.Connection.ReadBuffer(padding,3);
  AThread.Connection.ReadBuffer(ClientPixelFormat,16);
end;

procedure TForm1.readFixColourMapEntries(AThread: TIdPeerThread);

begin
end;

procedure TForm1.readSetEncodings(AThread: TIdPeerThread);
var
  padding: byte;
  i, numEncodings: Word;
  encType: Longint;
begin
  AThread.Connection.ReadBuffer(padding,1);
  AThread.Connection.ReadBuffer( {U16} numEncodings,2);
  numEncodings := Swap(numEncodings);
  Listbox1.Items.Add('Sum of Encodings: '+IntToStr(numEncodings));
  for i := 1 to numEncodings do begin
    AThread.Connection.ReadBuffer(encType,4);
    //encType := ntohl(encType);
    encType := Swap32(encType);
    Listbox1.Items.Add('Read Encoding: '+IntToStr(encType));
  end;

//{ numEncodings *  AThread.Connection.ReadBuffer( S32 encType,4); }
end;

procedure TForm1.readFrameBufferUpdateRequest(AThread: TIdPeerThread);
var
  incremental: byte;
  xpos, ypos, width, height: Word;
begin
  AThread.Connection.ReadBuffer( {U8} incremental,1);
  AThread.Connection.ReadBuffer( {U16} xpos,2);
  AThread.Connection.ReadBuffer( {U16} ypos,2);
  AThread.Connection.ReadBuffer( {U16} width,2);
  AThread.Connection.ReadBuffer( {U16} height,2);
  xpos := Swap16(xpos);
  ypos := Swap16(ypos);
  width := Swap16(width);
  height := Swap16(height);
  Listbox1.Items.Add(IntToStr(xpos)+' '+IntToStr(ypos)+' '+IntToStr(width)+''+IntToStr(height));
  processRequest(AThread);
end;

procedure TForm1.processRequest(AThread: TIdPeerThread);
// take a screenshot
// (while testing, put it into Image1)
var
  Width,Height : Word;
  SrcWindow: THandle;
  SrcDC: HDC;
  Bitmap: TBitmap;
begin
  SrcWindow:= GetDesktopWindow;
  if SrcWindow <> 0 then
  begin
    SrcDC:= GetDC(SrcWindow);
    if SrcDC <> 0 then
    begin
      Bitmap:= TBitmap.Create;
      Width := GetSystemMetrics(SM_CXSCREEN);
      Height := GetSystemMetrics(SM_CYSCREEN);
      Bitmap.Width:= Width div 4;
      Bitmap.Height:= Height div 4;
      StretchBlt(Image1.Canvas.Handle,0,0,Bitmap.Width,Bitmap.Height,
        SrcDC,0,0,Width,Height,SRCCOPY);
    end;
    ReleaseDC(SrcWindow,SrcDC);
    updateIsAvailable := True;
  end;
end;

procedure TForm1.readKeyEvent(AThread: TIdPeerThread);
var
  downFlag: byte;
  padding: byte;
  keyCode: Cardinal;
begin
  AThread.Connection.ReadBuffer(downFlag,1);
  AThread.Connection.ReadBuffer(padding,2);
  AThread.Connection.ReadBuffer(keyCode,4);
end;

procedure TForm1.readPointerEvent(AThread: TIdPeerThread);
var
  buttonMask: byte;
  xpos, ypos: Word;
begin
  AThread.Connection.ReadBuffer(buttonMask,1);
  AThread.Connection.ReadBuffer(xpos,2);
  AThread.Connection.ReadBuffer(ypos,2);
  // swap bytes
  xpos := Swap16(xpos);
  ypos := Swap16(ypos);
  Listbox1.Items.Add('x:'+IntToStr(xpos)+' y:'+IntToStr(ypos))
end;

procedure TForm1.readClientCutText(AThread: TIdPeerThread);
var
  padding: byte;
  txtLength: Cardinal;
  text: String;
begin
  AThread.Connection.ReadBuffer(padding,3);
  AThread.Connection.ReadBuffer(txtLength,4);
  AThread.Connection.ReadBuffer( {U8Array} text,1);
end;

procedure TForm1.writeServerInit(AThread: TIdPeerThread);
var
  desktopName : String;
  var x,y : Word;
begin
  desktopName := 'Hello World';

  // get screen dimension and swap bytes, because client expect high byte first
  x := GetSystemMetrics(SM_CXSCREEN);
  y := GetSystemMetrics(SM_CYSCREEN);
  //  x := Swap(x);
  //  y := Swap(y);
  x := Swap16(x);
  y := Swap16(y);

  // send framebuffer dimensions
  AThread.Connection.WriteBuffer(x, 2, True);
  AThread.Connection.WriteBuffer(y, 2, True);

  // PreferredPixelFormat
  ServerPixelFormat.BitsPerPixel := 16;
  ServerPixelFormat.depth := 16;
  ServerPixelFormat.BigEndianFlag := 0;
  ServerPixelFormat.TrueColourFlag := 1;
  AThread.Connection.WriteBuffer(ServerPixelFormat, 16, True);

  // Desktopname Length
  AThread.Connection.WriteCardinal(length(desktopName));

  // Desktop Name
  AThread.Connection.Write(desktopName);
end;

function TForm1.authenticate(AThread: TIdPeerThread):Boolean;
var AUTH_NUM, ClientAuth: Byte;
challengeQuestion: array[1..16] of Byte;
challengeAnswer: array[1..16] of Byte;
begin
  // send 1 authentication (Version 3.8)
  AUTH_NUM := 1;
  AThread.Connection.WriteBuffer(AUTH_NUM,1, True);
  AThread.Connection.WriteBuffer(VncAuth,1, True);
  AThread.Connection.ReadBuffer(ClientAuth,1);
  Label1.Caption := 'VNC auth: ' + IntToStr(ClientAuth);
  If ClientAuth = 2 then
  begin
    AThread.Connection.WriteBuffer(challengeQuestion,16, True);
    AThread.Connection.ReadBuffer(challengeAnswer,16);
    // for now, we do not check
    AThread.Connection.WriteBuffer(VncAuthOK,4, True);
  end;
  Result := true;
end;

procedure TForm1.doFrameBufferUpdate(AThread: TIdPeerThread);
// we still have framebuffer data to send to a client...
// (to be implemented...)
//
begin
  Listbox1.Items.Add('have FrameBuffer ready here...');
// all data sent? then updateIsAvailable := False;
end;

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
input: Byte;
msgStr: String;
begin
  // Loop
  writeProtocolVersionMsg(AThread);
  readProtocolVersionMsg(AThread);
  if (authenticate(AThread)) then begin {} end;
  readClientInit(AThread);
  initServer(AThread);
  writeServerInit(AThread);
  // start loop while client connected
  while not AThread.Terminated do
  begin
    if updateIsAvailable then doFrameBufferUpdate(AThread);
    //
    AThread.Connection.ReadBuffer(input,1);
    case input of
    SetPixelFormat:
      begin
      msgStr := 'SetPixelFormat';
      readSetPixelFormat(AThread);
      end;

    FixColourMapEntries:
      begin
      msgStr := 'FixColourMapEntries';
      readFixColourMapEntries(AThread);
      end;

    SetEncodings:
      begin
      msgStr := 'SetEncodings';
      readSetEncodings(AThread);
      end;

    FrameBufferUpdateRequest:
      begin
      msgStr := 'FrameBufferUpdateRequest';
      readFrameBufferUpdateRequest(AThread);
      end;

    KeyEvent:
      begin
      msgStr := 'KeyEvent';
      readKeyEvent(AThread);
      end;

    PointerEvent:
      begin
      msgStr := 'PointerEvent';
      readPointerEvent(AThread);
      end;

    ClientCutText:
      begin
      msgStr := 'ClientCutText';
      readClientCutText(AThread);
      end;
      
    else
      msgStr := 'unknown message type'+IntToStr(input);
    end;

    Listbox1.Items.Add(msgStr);
  end;
end;

end.
procedure TForm1.Button1Click(Sender: TObject);
var
  fs: TFileStream;
  fn : string;
begin
  //frxReport1.LoadFromFile('c:\Proyectos\rep\reporte.fr3');

  fn := 'c:\Proyectos\reporte.fr3';
  frxReport1.Clear;
  fs := TFileStream.Create(fn, fmOpenReadWrite);
  try
    fs.Position := 0;

    frxReport1.FileName := fn; {<-- The trick using "filename path" }
    frxReport1.LoadFromStream(fs);

  finally
    fs.Free;
  end;
  frxReport1.PrepareReport;
  frxReport1.ShowPreparedReport;
end;
function DataRowToJSONObject(const AValue : TDataSet): TJSONObject;
var
  I: Integer;
  AString : String;
begin
  Result := TJSONObject.Create();
  for I := 0 to AValue.FieldDefs.Count-1 do
  begin
    case AValue.FieldDefs[I].DataType of
      ftString, ftWideString, ftMemo :
        begin
          if AValue.FieldByName(AValue.FieldDefs[I].Name).AsString <> '' then
            Result.AddPair(AValue.FieldDefs[I].Name, AValue.FieldByName(AValue.FieldDefs[I].Name).AsString)
          else
            Result.AddPair(AValue.FieldDefs[I].Name, ' ');
        end;
      ftSmallint, ftInteger, ftWord, ftLongWord, ftShortint :
        begin
          Result.AddPair(AValue.FieldDefs[I].Name, TJSONNumber.Create(AValue.FieldByName(AValue.FieldDefs[I].Name).AsInteger));
        end;
      ftFloat, ftCurrency :
        begin
          Result.AddPair(AValue.FieldDefs[I].Name, TJSONNumber.Create(AValue.FieldByName(AValue.FieldDefs[I].Name).AsFloat));
        end;
      ftBoolean :
        begin
          Result.AddPair(AValue.FieldDefs[I].Name, AValue.FieldByName(AValue.FieldDefs[I].Name).AsString)
        end;
    end;
  end;
end;
 
function JSONObjectToDataRow(const AJson : TJSONObject; const AValue : TDataSet): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to AValue.FieldDefs.Count - 1 do
  begin
    case AValue.FieldDefs[I].DataType of
      ftString, ftWideString, ftMemo :
        begin
          AValue.FieldByName(AValue.FieldDefs[I].Name).AsString :=
            AJson.Get(AValue.FieldDefs[I].Name).JsonValue.Value;
        end;
      ftSmallint, ftInteger, ftWord, ftLongWord, ftShortint :
        begin
          AValue.FieldByName(AValue.FieldDefs[I].Name).AsInteger :=
            (AJson.Get(AValue.FieldDefs[I].Name).JsonValue as TJsonNumber).AsInt;
        end;
      ftFloat, ftCurrency :
        begin
          AValue.FieldByName(AValue.FieldDefs[I].Name).AsFloat :=
            (AJson.Get(AValue.FieldDefs[I].Name).JsonValue as TJsonNumber).AsDouble;
        end;
      ftBoolean :
        begin
          AValue.FieldByName(AValue.FieldDefs[I].Name).AsBoolean :=
            StrToBool(AJson.Get(AValue.FieldDefs[I].Name).JsonValue.Value);
        end;
    end;
  end;
end;
function EscapeString(const AValue: string): string;
const
  ESCAPE = '\';
  QUOTATION_MARK = '"';
  REVERSE_SOLIDUS = '\';
  SOLIDUS = '/';
  BACKSPACE = #8;
  FORM_FEED = #12;
  NEW_LINE = #10;
  CARRIAGE_RETURN = #13;
  HORIZONTAL_TAB = #9;
var
  AChar: Char;
begin
  Result := '';
  for AChar in AValue do
  begin
    case AChar of
      QUOTATION_MARK: Result := Result + ESCAPE + QUOTATION_MARK;
      REVERSE_SOLIDUS: Result := Result + ESCAPE + REVERSE_SOLIDUS;
      SOLIDUS: Result := Result + ESCAPE + SOLIDUS;
      BACKSPACE: Result := Result + ESCAPE + 'b';
      FORM_FEED: Result := Result + ESCAPE + 'f';
      NEW_LINE: Result := Result + ESCAPE + 'n';
      CARRIAGE_RETURN: Result := Result + ESCAPE + 'r';
      HORIZONTAL_TAB: Result := Result + ESCAPE + 't';
      else
      begin
        if (Integer(AChar) < 32) or (Integer(AChar) > 126) then
          Result := Result + ESCAPE + 'u' + IntToHex(Integer(AChar), 4)
        else
          Result := Result + AChar;
      end;
    end;
  end;
end;
(* in form: Process, Memo, Button, Edit *)

procedure TForm1.Button1Click(Sender: TObject);
begin
  Process1.CommandLine:= Edit1.Text;
  Process1.Execute;
  Memo1.Lines.LoadFromStream(Process1.Output);
end;
//Uses Process,...

function isMacDarkMode: Boolean;
var s:ansistring;
begin
  RunCommand('/usr/bin/defaults',['read','-g','AppleInterfaceStyle'],s);
  Result:=(pos('Dark',s)>0);
end; 
function MessageDlg2(capt: string; Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; Captions: array of string): Integer;
var
  aMsgDlg: TForm;
  i: Integer;
  dlgButton: TBitBtn;
  CaptionIndex: Integer;
begin

  { Create the Dialog }
  { Dialog erzeugen }
  
  aMsgDlg := CreateMessageDialog(Msg, DlgType, Buttons);
  try
    aMsgDlg.Caption:=capt;
    captionIndex := 0;

    { Loop through Objects in Dialog }
    { Über alle Objekte auf dem Dialog iterieren}

    for i := 0 to aMsgDlg.ComponentCount - 1 do
    begin

     { If the object is of type TButton, then }
     { Wenn es ein Button ist, dann...}

      if (aMsgDlg.Components[i] is TBitBtn) then
      begin
        dlgButton := TBitBtn(aMsgDlg.Components[i]);
        if CaptionIndex > High(Captions) then Break;

        { Give a new caption from our Captions array}
        { Schreibe Beschriftung entsprechend Captions array}

        dlgButton.Caption := Captions[CaptionIndex];
        Inc(CaptionIndex);
      end;
    end;
    Result := aMsgDlg.ShowModal;
  finally
    aMsgDlg.Free;
  end;
end;
$> docker pull haskell
$> docker run -it haskell stack <parameters>


$> git clone https://github.com/jean-lopes/dfm-to-json.git

$> cd dfm-to-json

$> stack setup
$> stack install
$> dfm-to-json --version
Function DetectIsOpen(Cb: TCombobox): Boolean;
Begin
  Result := SendMessage(ComboBox1.Handle,CB_GETDROPPEDSTATE,0,0)=1;
End;
unit RegURI;

interface

type
  TUriRecord = record
    Descrip: String;
    Protocol: String; // only letters or nombers .. no spaces ..
    Path: String; // complete path for application to be opened
                     //when appuri:// is called
    Icon: string; // icon file or executable file with icon
  end;

  function RegisterAppURI(URIReg: TUriRecord): boolean;

implementation

uses Registry, windows, ShlObj, dialogs;

function RegisterAppURI(URIReg: TUriRecord): boolean;
const
  root = '\Software\Classes\';
var
  Reg : TRegistry;
begin
  result := false;
  reg := TRegistry.Create;

  try
    try
      reg.RootKey := HKEY_CURRENT_USER;
      if reg.Openkey(root + URIReg.Protocol, True) then
      begin
        reg.WriteString('', 'URL:'+URIReg.Descrip);
        reg.WriteString('URL Protocol', '');

        if reg.Openkey(root + URIReg.Protocol + '\DefaultIcon', True) then
          reg.WriteString('', URIReg.Icon);

        if reg.Openkey(root + URIReg.Protocol + '\shell', True) and
          reg.Openkey(root + URIReg.Protocol + '\shell\open', True) and
          reg.Openkey(root + URIReg.Protocol + '\shell\open\command', True) then
          reg.WriteString('', '"'+URIReg.Path + '" "%1" "%2" "%3" "%4" "%5" "%6" "%7" "%8" "%9"');
      end;
      reg.CloseKey;

      reg.RootKey := HKEY_CURRENT_USER;
      if reg.Openkey('\Software\Microsoft\Internet Explorer\ProtocolExecute\' + URIReg.Protocol, True) then
      begin
        reg.WriteInteger('WarnOnOpen', 0);
      end;
      reg.CloseKey;

    //can cause problems…
      SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
      result := true;
    except
      showmessage('No se pudo realizar el registro.'#13'Asegurese de ejecutar la aplicación con permisos de Administrador');
      result := false;
    end;
  finally
    reg.free;
  end;
end;

function UnRegisterAppURI(protocol: string): boolean;
const
  root = '\Software\Classes\';
var
  Reg : TRegistry;
begin
  result := false;
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CLASSES_ROOT;
    result := reg.DeleteKey(root+protocol);

    reg.RootKey := HKEY_CURRENT_USER;
    reg.DeleteKey('\Software\Microsoft\Internet Explorer\ProtocolExecute\' + Protocol);
  finally
    reg.Free;
  end;
end;
(*
  - Put TfrxRichView object into a MasterData (if not dataset set Record Count=1) 
  - Set MasterData.Stretched = true
  - Set TfrxRichView.StretchMode to smActualHeight or smMaxHeight
*)
1) instala lazarus normal

2) instala estas dependencias:

sudo apt-get install msttcorefonts
sudo apt-get install gsfonts
sudo apt-get install sqlite3 libsqlite3-dev
sudo apt-get install libcanberra-gtk-module

3) abre lazarus

4) ve a "packages=> open package file .lpk"

5) en la ventana de busqueda ubica la carpeta donde tienes los fuentes de fast report, yo lo hice con el 6.6

6) vas a buscar el archivo fs_lazarus.lpk y le vas a dar a open

7) en la ventana nueva dale a "compile" y cuando termine vas a "use=>install" en la misma ventanita

8) vas a repetir el mismo proceso del 4 al 7 para estos otros archivo:
fr6_lazarus.lpk
frxchartlazarus.lpk
frxlazdbf.lpk
frxe6_lazarus.lpk
frxlazsqlite.lpk 
Chart.LeftAxis.StartPosition := 1; //1% top
Chart.LeftAxis.EndPosition := 99; //1% bottom
Open [yourappfolder]/AndroidManifest.template.xml file
and add the following property:

<application android:persistent="%persistent%" ...
    :
    android:usesCleartextTraffic="true">
    
</application>
/*-- put this on ServerModule.CustomCSS property --*/

#loading-mask, #loading-indicator, #loading {
  display: none;
}
program JSONPostExample;

{$APPTYPE CONSOLE}

uses
  IdHTTP, IdGlobal, SysUtils, Classes;

var
  HTTP: TIdHTTP;
  RequestBody: TStream;
  ResponseBody: string;
begin
  HTTP := TIdHTTP.Create;
  try
    try
      RequestBody := TStringStream.Create('{"code":42}',
        TEncoding.UTF8);
      try
        HTTP.Request.Accept := 'application/json';
        HTTP.Request.ContentType := 'application/json';
        ResponseBody := HTTP.Post('https://httpbin.org/post',
          RequestBody);
        WriteLn(ResponseBody);
        WriteLn(HTTP.ResponseText);
      finally
        RequestBody.Free;
      end;
    except
      on E: EIdHTTPProtocolException do
      begin
        WriteLn(E.Message);
        WriteLn(E.ErrorMessage);
      end;
      on E: Exception do
      begin
        WriteLn(E.Message);
      end;
    end;
  finally
    HTTP.Free;
  end;
  ReadLn;
end.
procedure ListRegisteredBrowsers(List: TStrings);
var
  reg: TRegistry;
  ki: TRegKeyInfo;
  i: Integer;
  keyname: string;
  len: DWORD;
  path: string;
  appName: string;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    if not Reg.KeyExists('\SOFTWARE\Clients\StartMenuInternet') then Exit;
    if not Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet', false) then
      raise Exception.Create('ListRegisteredBrowsers: Could not open registry key.');
    if not reg.GetKeyInfo(ki) then
      raise Exception.Create('ListRegisteredBrowsers: Could not obtain registry key information.');
    List.Clear;
    SetLength(keyname, len);
    for i := 0 to ki.NumSubKeys - 1 do
    begin
      len := ki.MaxSubKeyLen + 1;
      if RegEnumKeyEx(reg.CurrentKey, i, PChar(keyname), len, nil, nil, nil, nil) <> ERROR_SUCCESS then
        RaiseLastOSError;
      if reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet\' + keyname, false) then
        appName := reg.ReadString('');
      path := '\SOFTWARE\Clients\StartMenuInternet\' + copy(keyname,1,len) + '\shell\open\command';
      if reg.OpenKey(path, false) then
        appName := appName + ' ('+reg.ReadString('')+')';
      if appName <> '' then
        list.add(appName);
      Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet', true);
    end;
  finally
    reg.Free;
  end;
end;

//and

function GetDefaultBrowser: string;
var
  reg: TRegistry;
  path: string;
begin
  result := '';
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet', false) then
    begin
      result := reg.ReadString('');
      path := '\SOFTWARE\Clients\StartMenuInternet\' + result + '\shell\open\command';
      if reg.OpenKey(path, false) then
        result := result + ' ('+reg.ReadString('')+')';
    end
    else
    begin
      reg.RootKey := HKEY_LOCAL_MACHINE;
      if Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet', false) then
      begin
        result := reg.ReadString('');
        path := '\SOFTWARE\Clients\StartMenuInternet\' + result + '\shell\open\command';
        if reg.OpenKey(path, false) then
          result := result + ' ('+reg.ReadString('')+')';
      end;
    end;
    reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('\SOFTWARE\Clients\StartMenuInternet\' + result, false) then
    begin
      result := reg.ReadString('');
      path := '\SOFTWARE\Clients\StartMenuInternet\' + result + '\shell\open\command';
      if reg.OpenKey(path, false) then
        result := result + ' ('+reg.ReadString('')+')';
    end;
  finally
    reg.Free;
  end;
end;

//Test it:

procedure TForm1.Button1Click(Sender: TObject);
var
  sl: TStringList;
  i: Integer;
  DefBrw: string;
begin
  DefBrw := GetDefaultBrowser;
  sl := TStringList.Create;
  try
    ListRegisteredBrowsers(sl);
    Memo1.Lines.BeginUpdate;
    for i := 0 to sl.Count - 1 do
      if SameText(sl[i], DefBrw) then
        Memo1.Lines.Add(sl[i] + ' (Default)')
      else
        Memo1.Lines.Add(sl[i]);
    Memo1.Lines.EndUpdate;
  finally
    sl.Free;
  end;
end;
procedure TService1.Service1Execute(Sender: TService);
 begin
   Stream := TMemoryStream.Create;
   try
     ServerSocket1.Port := 80; // WWW port
     ServerSocket1.Active := True;
     while not Terminated do begin
       ServiceThread.ProcessRequests(True);
     end;
     ServerSocket1.Active := False;
   finally
     Stream.Free;
   end;
 end;

procedure TMyTestServiceApp.ServiceAfterInstall(Sender: TService);
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create(KEY_READ or KEY_WRITE);
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey('\SYSTEM\CurrentControlSet\Services\' + Name, false) then
    begin
      Reg.WriteString('Description', 'This is a description for my fine Service Application.');
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;
end;

Similiar Collections

Python strftime reference pandas.Period.strftime python - Formatting Quarter time in pandas columns - Stack Overflow python - Pandas: Change day - Stack Overflow python - Check if multiple columns exist in a df - Stack Overflow Pandas DataFrame apply() - sending arguments examples python - How to filter a dataframe of dates by a particular month/day? - Stack Overflow python - replace a value in the entire pandas data frame - Stack Overflow python - Replacing blank values (white space) with NaN in pandas - Stack Overflow python - get list from pandas dataframe column - Stack Overflow python - How to drop rows of Pandas DataFrame whose value in a certain column is NaN - Stack Overflow python - How to drop rows of Pandas DataFrame whose value in a certain column is NaN - Stack Overflow python - How to lowercase a pandas dataframe string column if it has missing values? - Stack Overflow How to Convert Integers to Strings in Pandas DataFrame - Data to Fish How to Convert Integers to Strings in Pandas DataFrame - Data to Fish create a dictionary of two pandas Dataframe columns? - Stack Overflow python - ValueError: No axis named node2 for object type <class 'pandas.core.frame.DataFrame'> - Stack Overflow Python Pandas iterate over rows and access column names - Stack Overflow python - Creating dataframe from a dictionary where entries have different lengths - Stack Overflow python - Deleting DataFrame row in Pandas based on column value - Stack Overflow python - How to check if a column exists in Pandas - Stack Overflow python - Import pandas dataframe column as string not int - Stack Overflow python - What is the most efficient way to create a dictionary of two pandas Dataframe columns? - Stack Overflow Python Loop through Excel sheets, place into one df - Stack Overflow python - How do I get the row count of a Pandas DataFrame? - Stack Overflow python - How to save a new sheet in an existing excel file, using Pandas? - Stack Overflow Python Loop through Excel sheets, place into one df - Stack Overflow How do I select a subset of a DataFrame? — pandas 1.2.4 documentation python - Delete column from pandas DataFrame - Stack Overflow python - Convert list of dictionaries to a pandas DataFrame - Stack Overflow How to Add or Insert Row to Pandas DataFrame? - Python Examples python - Check if a value exists in pandas dataframe index - Stack Overflow python - Set value for particular cell in pandas DataFrame using index - Stack Overflow python - Pandas Dataframe How to cut off float decimal points without rounding? - Stack Overflow python - Pandas: Change day - Stack Overflow python - Clean way to convert quarterly periods to datetime in pandas - Stack Overflow Pandas - Number of Months Between Two Dates - Stack Overflow python - MonthEnd object result in <11 * MonthEnds> instead of number - Stack Overflow python - Extracting the first day of month of a datetime type column in pandas - Stack Overflow
MySQL MULTIPLES INNER JOIN How to Use EXISTS, UNIQUE, DISTINCT, and OVERLAPS in SQL Statements - dummies postgresql - SQL OVERLAPS PostgreSQL Joins: Inner, Outer, Left, Right, Natural with Examples PostgreSQL Joins: A Visual Explanation of PostgreSQL Joins PL/pgSQL Variables ( Format Dates ) The Ultimate Guide to PostgreSQL Date By Examples Data Type Formatting Functions PostgreSQL - How to calculate difference between two timestamps? | TablePlus Date/Time Functions and Operators PostgreSQL - DATEDIFF - Datetime Difference in Seconds, Days, Months, Weeks etc - SQLines CASE Statements in PostgreSQL - DataCamp SQL Optimizations in PostgreSQL: IN vs EXISTS vs ANY/ALL vs JOIN PostgreSQL DESCRIBE TABLE Quick and best way to Compare Two Tables in SQL - DWgeek.com sql - Best way to select random rows PostgreSQL - Stack Overflow PostgreSQL: Documentation: 13: 70.1. Row Estimation Examples Faster PostgreSQL Counting How to Add a Default Value to a Column in PostgreSQL - PopSQL How to Add a Default Value to a Column in PostgreSQL - PopSQL SQL Subquery - Dofactory SQL IN - SQL NOT IN - JournalDev DROP FUNCTION (Transact-SQL) - SQL Server | Microsoft Docs SQL : Multiple Row and Column Subqueries - w3resource PostgreSQL: Documentation: 9.5: CREATE FUNCTION PostgreSQL CREATE FUNCTION By Practical Examples datetime - PHP Sort a multidimensional array by element containing date - Stack Overflow database - Oracle order NULL LAST by default - Stack Overflow PostgreSQL: Documentation: 9.5: Modifying Tables PostgreSQL: Documentation: 14: SELECT postgresql - sql ORDER BY multiple values in specific order? - Stack Overflow How do I get the current unix timestamp from PostgreSQL? - Database Administrators Stack Exchange SQL MAX() with HAVING, WHERE, IN - w3resource linux - Which version of PostgreSQL am I running? - Stack Overflow Copying Data Between Tables in a Postgres Database php - How to remove all numbers from string? - Stack Overflow
Clear config cache Eloquent DB::Table RAW Query / WhereNull Laravel Eloquent "IN" Query get single column value in laravel eloquent php - How to use CASE WHEN in Eloquent ORM? - Stack Overflow AND-OR-AND + brackets with Eloquent - Laravel Daily Database: Query Builder - Laravel - The PHP Framework For Web Artisans ( RAW ) Combine Foreach Loop and Eloquent to perform a search | Laravel.io Access Controller method from another controller in Laravel 5 How to Call a controller function in another Controller in Laravel 5 php - Create a Laravel Request object on the fly php - Laravel 5.6 Upgrade caused Logging to break Artisan Console - Laravel - The PHP Framework For Web Artisans What to include in gitignore for a Laravel and PHPStorm project php - Create a Laravel Request object on the fly Process big DB table with chunk() method - Laravel Daily How to insert big data on the laravel? - Stack Overflow php - How can I build a condition based query in Laravel? - Stack Overflow Laravel Chunk Eloquent Method Example - Tuts Make Database: Migrations - Laravel - The PHP Framework For Web Artisans php - Laravel Model Error Handling when Creating - Exception Laravel - Inner Join with Multiple Conditions Example using Query Builder - ItSolutionStuff.com laravel cache disable phpunit code example | Newbedev In PHP, how to check if a multidimensional array is empty? · Humblix php - Laravel firstOrNew how to check if it's first or new? - Stack Overflow get base url laravel 8 Code Example Using gmail smtp via Laravel: Connection could not be established with host smtp.gmail.com [Connection timed out #110] - Stack Overflow
PostgreSQL POSITION() function PostgresQL ANY / SOME Operator ( IN vs ANY ) PostgreSQL Substring - Extracting a substring from a String How to add an auto-incrementing primary key to an existing table, in PostgreSQL PostgreSQL STRING_TO_ARRAY()function mysql FIND_IN_SET equivalent to postgresql PL/pgSQL Variables ( Format Dates ) The Ultimate Guide to PostgreSQL Date By Examples Data Type Formatting Functions PostgreSQL - How to calculate difference between two timestamps? | TablePlus Date/Time Functions and Operators PostgreSQL - DATEDIFF - Datetime Difference in Seconds, Days, Months, Weeks etc - SQLines CASE Statements in PostgreSQL - DataCamp SQL Optimizations in PostgreSQL: IN vs EXISTS vs ANY/ALL vs JOIN PL/pgSQL Variables PostgreSQL: Documentation: 11: CREATE PROCEDURE Reading a Postgres EXPLAIN ANALYZE Query Plan Faster PostgreSQL Counting sql - Fast way to discover the row count of a table in PostgreSQL - Stack Overflow PostgreSQL: Documentation: 9.1: tablefunc PostgreSQL DESCRIBE TABLE Quick and best way to Compare Two Tables in SQL - DWgeek.com sql - Best way to select random rows PostgreSQL - Stack Overflow How to Add a Default Value to a Column in PostgreSQL - PopSQL How to Add a Default Value to a Column in PostgreSQL - PopSQL PL/pgSQL IF Statement PostgreSQL: Documentation: 9.1: Declarations SQL Subquery - Dofactory SQL IN - SQL NOT IN - JournalDev PostgreSQL - IF Statement - GeeksforGeeks How to work with control structures in PostgreSQL stored procedures: Using IF, CASE, and LOOP statements | EDB PL/pgSQL IF Statement How to combine multiple selects in one query - Databases - ( loop reference ) DROP FUNCTION (Transact-SQL) - SQL Server | Microsoft Docs SQL : Multiple Row and Column Subqueries - w3resource PostgreSQL: Documentation: 9.5: CREATE FUNCTION PostgreSQL CREATE FUNCTION By Practical Examples datetime - PHP Sort a multidimensional array by element containing date - Stack Overflow database - Oracle order NULL LAST by default - Stack Overflow PostgreSQL: Documentation: 9.5: Modifying Tables PostgreSQL: Documentation: 14: SELECT PostgreSQL Array: The ANY and Contains trick - Postgres OnLine Journal postgresql - sql ORDER BY multiple values in specific order? - Stack Overflow sql - How to aggregate two PostgreSQL columns to an array separated by brackets - Stack Overflow How do I get the current unix timestamp from PostgreSQL? - Database Administrators Stack Exchange SQL MAX() with HAVING, WHERE, IN - w3resource linux - Which version of PostgreSQL am I running? - Stack Overflow Postgres login: How to log into a Postgresql database | alvinalexander.com Copying Data Between Tables in a Postgres Database PostgreSQL CREATE FUNCTION By Practical Examples php - How to remove all numbers from string? - Stack Overflow
כמה עוד נשאר למשלוח חינם גם לעגלה ולצקאאוט הוספת צ'קבוקס לאישור דיוור בצ'קאאוט הסתרת אפשרויות משלוח אחרות כאשר משלוח חינם זמין דילוג על מילוי כתובת במקרה שנבחרה אפשרות איסוף עצמי הוספת צ'קבוקס לאישור דיוור בצ'קאאוט שינוי האפשרויות בתפריט ה-סידור לפי בווקומרס שינוי הטקסט "אזל מהמלאי" הערה אישית לסוף עמוד העגלה הגבלת רכישה לכל המוצרים למקסימום 1 מכל מוצר קבלת שם המוצר לפי ה-ID בעזרת שורטקוד הוספת כפתור וואטסאפ לקנייה בלופ ארכיון מוצרים הפיכה של מיקוד בצ'קאאוט ללא חובה מעבר ישיר לצ'קאאוט בלחיתה על הוספה לסל (דילוג עגלה) התראה לקבלת משלוח חינם בדף עגלת הקניות גרסה 1 התראה לקבלת משלוח חינם בדף עגלת הקניות גרסה 2 קביעה של מחיר הזמנה מינימלי (מוצג בעגלה ובצ'קאאוט) העברת קוד הקופון ל-ORDER REVIEW העברת קוד הקופון ל-ORDER REVIEW Kadence WooCommerce Email Designer קביעת פונט אסיסנט לכל המייל בתוסף מוצרים שאזלו מהמלאי - יופיעו מסומנים באתר, אבל בתחתית הארכיון הוספת כפתור "קנה עכשיו" למוצרים הסתרת אפשרויות משלוח אחרות כאשר משלוח חינם זמין שיטה 2 שינוי סימן מטבע ש"ח ל-ILS להפוך סטטוס הזמנה מ"השהייה" ל"הושלם" באופן אוטומטי תצוגת הנחה באחוזים שינוי טקסט "בחר אפשרויות" במוצרים עם וריאציות חיפוש מוצר לפי מק"ט שינוי תמונת מוצר לפי וריאציה אחרי בחירה של וריאציה אחת במקרה של וריאציות מרובות הנחה קבועה לפי תפקיד בתעריף קבוע הנחה קבועה לפי תפקיד באחוזים הסרה של שדות משלוח לקבצים וירטואליים הסתרת טאבים מעמוד מוצר הצגת תגית "אזל מהמלאי" בלופ המוצרים להפוך שדות ל-לא חובה בצ'קאאוט שינוי טקסט "אזל מהמלאי" לוריאציות שינוי צבע ההודעות המובנות של ווקומרס הצגת ה-ID של קטגוריות המוצרים בעמוד הקטגוריות אזל מהמלאי- שינוי ההודעה, תגית בלופ, הודעה בדף המוצר והוספת אזל מהמלאי על וריאציה הוספת שדה מחיר ספק לדף העריכה שינוי טקסט אזל מהמלאי תמונות מוצר במאונך לצד תמונת המוצר הראשית באלמנטור הוספת כפתור קנה עכשיו לעמוד המוצר בקניה הזו חסכת XX ש''ח לאפשר למנהל חנות לנקות קאש ברוקט לאפשר רק מוצר אחד בעגלת קניות הוספת סימון אריזת מתנה ואזור להוראות בצ'קאאוט של ווקומרס הצגת הנחה במספר (גודל ההנחה) הוספת "אישור תקנון" לדף התשלום הצגת רשימת תכונות המוצר בפרונט
החלפת טקסט באתר (מתאים גם לתרגום נקודתי) הסרת פונטים של גוגל מתבנית KAVA ביטול התראות במייל על עדכון וורדפרס אוטומטי הוספת תמיכה בקבצי VCF באתר (קבצי איש קשר VCARD) - חלק 1 להחריג קטגוריה מסוימת מתוצאות החיפוש שליפת תוכן של ריפיטר יצירת כפתור שיתוף למובייל זיהוי אלו אלמנטים גורמים לגלילה אופקית התקנת SMTP הגדרת טקסט חלופי לתמונות לפי שם הקובץ הוספת התאמת תוספים לגרסת WP הוספת טור ID למשתמשים הסרת כותרת בתבנית HELLO הסרת תגובות באופן גורף הרשאת SVG חילוץ החלק האחרון של כתובת העמוד הנוכחי חילוץ הסלאג של העמוד חילוץ כתובת העמוד הנוכחי מניעת יצירת תמונות מוקטנות התקנת SMTP הצגת ה-ID של קטגוריות בעמוד הקטגוריות להוריד מתפריט הניהול עמודים הוספת Favicon שונה לכל דף ודף הוספת אפשרות שכפול פוסטים ובכלל (של שמעון סביר) הסרת תגובות באופן גורף 2 בקניה הזו חסכת XX ש''ח חיפוש אלמנטים סוררים, גלישה צדית במובייל שיטה 1 לאפשר רק מוצר אחד בעגלת קניות הצגת הנחה במספר (גודל ההנחה) הוספת "אישור תקנון" לדף התשלום שינוי צבע האדמין לפי סטטוס העמוד/פוסט שינוי צבע אדמין לכולם לפי הסכמות של וורדפרס תצוגת כמות צפיות מתוך הדשבורד של וורדפרס הצגת סוג משתמש בפרונט גלילה אין סופית במדיה שפת הממשק של אלמנטור תואמת לשפת המשתמש
הודעת שגיאה מותאמת אישית בטפסים להפוך כל סקשן/עמודה לקליקבילית (לחיצה) - שיטה 1 להפוך כל סקשן/עמודה לקליקבילית (לחיצה) - שיטה 2 שינוי הגבלת הזיכרון בשרת הוספת לינק להורדת מסמך מהאתר במייל הנשלח ללקוח להפוך כל סקשן/עמודה לקליקבילית (לחיצה) - שיטה 3 יצירת כפתור שיתוף למובייל פתיחת דף תודה בטאב חדש בזמן שליחת טופס אלמנטור - טופס בודד בדף פתיחת דף תודה בטאב חדש בזמן שליחת טופס אלמנטור - טפסים מרובים בדף ביי ביי לאריק ג'ונס (חסימת ספאם בטפסים) זיהוי אלו אלמנטים גורמים לגלילה אופקית לייבלים מרחפים בטפסי אלמנטור יצירת אנימציה של "חדשות רצות" בג'ט (marquee) שינוי פונט באופן דינאמי בג'ט פונקציה ששולפת שדות מטא מתוך JET ומאפשרת לשים הכל בתוך שדה SELECT בטופס אלמנטור הוספת קו בין רכיבי התפריט בדסקטופ ולדציה למספרי טלפון בטפסי אלמנטור חיבור שני שדות בטופס לשדה אחד שאיבת נתון מתוך כתובת ה-URL לתוך שדה בטופס וקידוד לעברית מדיה קוורי למובייל לייבלים מרחפים בטפסי אלמנטור תמונות מוצר במאונך לצד תמונת המוצר הראשית באלמנטור הצגת תאריך עברי פורמט תאריך מותאם אישית תיקון שדה תאריך בטופס אלמנטור במובייל שאיבת פרמטר מתוך הכתובת והזנתו לתוך שדה בטופס (PARAMETER, URL, INPUT) עמודות ברוחב מלא באלמנטור עמודה דביקה בתוך אלמנטור יצירת "צל" אומנותי קוד לסוויצ'ר, שני כפתורים ושני אלמנטים סקריפט לסגירת פופאפ של תפריט לאחר לחיצה על אחד העמודים הוספת כפתור קרא עוד שפת הממשק של אלמנטור תואמת לשפת המשתמש