qemutest/unit1.pas

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, EditBtn,
  ComCtrls, Buttons, ExtCtrls, Process, Math;

type

  { TForm1 }

  TForm1 = class(TForm)
    btnStart: TBitBtn;
    btnStop: TBitBtn;
    chkKVM: TCheckBox;
    edtCustom: TEdit;
    edtImageFile: TFileNameEdit;
    edtHarddiskFile: TFileNameEdit;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    lblCores: TLabel;
    lblRAM: TLabel;
    trkCores: TTrackBar;
    trkRAM: TTrackBar;
    procedure btnStartClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure trkCoresChange(Sender: TObject);
    procedure trkRAMChange(Sender: TObject);
  private
    function ConvertBytes(Bytes: Int64): string;
    function GetCommandOutput(command: string): string;

  public

  end;

var
  Form1: TForm1;
  //
  AProcess: TProcess;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.btnStartClick(Sender: TObject);
var
  SystemArchitecture: string;
  Params: TStringArray;
  Param, s: string;
begin
  // If already running then don't start vm
  if (AProcess <> nil) and (AProcess.Running = true) then Exit;

  if AProcess = nil then
    AProcess := TProcess.Create(nil);

  // TODO: Add specific qemu executable
  SystemArchitecture:=GetCommandOutput('uname -m');
  // It becomes something like: qemu-system-x86_64
  AProcess.Executable:= 'qemu-system-'+SystemArchitecture;

  AProcess.Parameters.Clear;
  // ISO image
  AProcess.Parameters.Add('--cdrom');
  AProcess.Parameters.Add(edtImageFile.FileName);
  // Hard Disk image
  if FileExists(edtHarddiskFile.FileName) then begin
    AProcess.Parameters.Add('--hda');
    AProcess.Parameters.Add(edtHarddiskFile.FileName);
  end;
  // CPU Cores
  AProcess.Parameters.Add('-smp');
  AProcess.Parameters.Add(inttostr(trkCores.Position));
  // Memory
  AProcess.Parameters.Add('-m');
  AProcess.Parameters.Add(inttostr(trkRAM.Position));
  // KVM
  if chkKVM.Checked then
    AProcess.Parameters.Add('-enable-kvm');
  // Custom parameters
  Params := string(edtCustom.Text).Split(' ');
  for Param in Params do
    AProcess.Parameters.Add(Param);

  AProcess.Options := AProcess.Options + [poUsePipes];

  AProcess.Execute;
end;

procedure TForm1.btnStopClick(Sender: TObject);
begin
  AProcess.Terminate(0);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  TotalMemory: longint;
begin
  // RAM
  TotalMemory := StrToInt( GetCommandOutput('cat /proc/meminfo | head -n 1 | awk "{print \$2}"') ) div 1024;
  trkRAM.Max:=TotalMemory;
  trkRAM.Position:=TotalMemory div 4;
  // CPU Cores
  trkCores.Max:=StrToInt( GetCommandOutput('grep -c ^processor /proc/cpuinfo 2>/dev/null || sysctl -n hw.ncpu || echo "$NUMBER_OF_PROCESSOR"') );
  trkCores.Position:=trkCores.Max;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  AProcess.Free;
end;

procedure TForm1.trkCoresChange(Sender: TObject);
begin
  lblCores.Caption:=inttostr( trkCores.Position );
end;

procedure TForm1.trkRAMChange(Sender: TObject);
begin
  lblRAM.Caption:= ConvertBytes(trkRAM.Position*1024*1024);
end;

// Source: https://stackoverflow.com/a/30549584
function TForm1.ConvertBytes(Bytes: Int64): string;
const
  Description: Array [0 .. 8] of string = ('Bytes', 'KB', 'MB', 'GB', 'TB', 'PB', 'EB', 'ZB', 'YB');
var
  i: Integer;
begin
  i := 0;

  while Bytes > Power(1024, i + 1) do
    Inc(i);

  Result := FormatFloat('###0.##', Bytes / IntPower(1024, i)) + ' ' + Description[i];
end;

function TForm1.GetCommandOutput(Command:string):string;
var
  s: ansistring;
begin
  if RunCommand('/bin/sh', ['-c', Command], s) then
    Result := Trim(s);
  // We use Trim() to cut off access carriage return at the end
end;

end.