(*
/*

CLASS {NATIVE_Hardware|_Delphi_FPC},
UNTESTED,
ABSTRACT:

NATIVE: "///COPY NATIVE_Hardware.pas" .

*/
*)

unit NATIVE_Hardware;

interface

uses {$IFDEF LINUX}{$ELSE} Windows, {$ENDIF} AL4;

function EjectDrive(driveLetter: Char): Boolean;
{$IFDEF LINUX}
{$ELSE}
procedure Do_Memory_status(mem: DynAReal);
function GetCPULoad: Double;
{$ENDIF}
function Processors_count: Integer;
function Get_power_status(pow: DynAInt): Double;
function DiskGetSize( const Path: String; get_free: Boolean ): Int64;
function DiskVolumeLabel( const Path: String ): String;
function DiskFileSystem( const Path: String ): String;

implementation

const IOCTL_STORAGE_EJECT_MEDIA = $2D4808;

function EjectDrive(driveLetter: Char): Boolean;
{$IFDEF LINUX}
{$ELSE}
var path: String;
	handle: Integer;
	dummy: Cardinal;
{$ENDIF}
begin
	Result := FALSE;
	{$IFnDEF LINUX} 
    path := '\\.\' + driveLetter + ':';
    handle := CreateFile(PChar(path), GENERIC_READ or GENERIC_WRITE,
    	FILE_SHARE_READ or FILE_SHARE_WRITE, nil, 3, 0, 0);

    if handle = -1 then Exit;

    dummy := 0;
    DeviceIoControl(handle, IOCTL_STORAGE_EJECT_MEDIA, 
    	nil, 0, nil, 0, dummy, nil);

    CloseHandle(handle);
    Result := true;
    {$ENDIF}
end;

		{$IFnDEF LINUX}
		type TMemoryStatusEx = record
			  dwLength: DWORD;
			  dwMemoryLoad: DWORD;
			  ullTotalPhys: Int64;
			  ullAvailPhys: Int64;
			  ullTotalPageFile: Int64;
			  ullAvailPageFile: Int64;
			  ullTotalVirtual: Int64;
			  ullAvailVirtual: Int64;
			  ullAvailExtendedVirtual: Int64;
			 end;
			 PMemoryStatusEx = ^TMemoryStatusEx;
			 
			TGlobalMemoryStatusEx = procedure(gms: PMemoryStatusEx); stdcall;
		var GlobalMemoryStatusEx: TGlobalMemoryStatusEx;
			use_GlobalMemoryStatus: Boolean;
		
		procedure Do_Memory_status(mem: DynAReal);
//?{System_functions}.Memory_status
		var gms: TMemoryStatusEx;
		var gms1: TMemoryStatus;
			kernel: THandle;
			Status: {$IFDEF KOL} PSt_memory__C_System_functions 
					{$ELSE} St_memory__C_System_functions {$ENDIF};
//.
		begin
//?{System_functions}.Memory_status
			if not use_GlobalMemoryStatus and 
				not Assigned(GlobalMemoryStatusEx) then
			begin
				kernel := LoadLibrary('kernel32.dll');
				GlobalMemoryStatusEx := TGlobalMemoryStatusEx(GetProcAddress(kernel, 
					'GlobalMemoryStatusEx'));
				if not Assigned(GlobalMemoryStatusEx) then
					use_GlobalMemoryStatus := true
				else
				begin
				 	gms0dwLength := Sizeof(gms);
				 	GlobalMemoryStatusEx(@gms);
				 	mem.Add(gms.dwMemoryLoad);
				 	mem.Add(gms.ullTotalPhys);
				 	mem.Add(gms.ullAvailPhys);
				 	mem.Add(gms.ullTotalPageFile);
				 	mem.Add(gms.ullAvailPageFile);
				 	mem.Add(gms.ullTotalVirtual);
				 	mem.Add(gms.ullAvailExtendedVirtual);
				 	Exit;
				end;
			end;
			gms1.dwLength := Sizeof(gms1);
			GlobalMemoryStatus(gms1);
		 	mem.Add(gms1.dwMemoryLoad);
		 	mem.Add(gms1.dwTotalPhys);
		 	mem.Add(gms1.dwAvailPhys);
		 	mem.Add(gms1.dwTotalPageFile);
		 	mem.Add(gms1.dwAvailPageFile);
		 	mem.Add(gms1.dwTotalVirtual);
		 	mem.Add(gms1.dwAvailExtendedVirtual);
//.
	   	end;
	   	{$ENDIF}
   	
function Processors_count: Integer;
{$IFDEF FPC}
{$ELSE}
var SI: TSystemInfo;
{$ENDIF}
begin
	{$IFDEF FPC}
		Result := GetCPUCount();
	{$ELSE}
	 	GetSystemInfo(SI);
	 	RESULT := SI.dwNumberOfProcessors;
	 	if RESULT < 1 then RESULT := 1;
	{$ENDIF}
end;

{$IFnDEF LINUX}
type TGetSystemTimes = function(idleTime, kernelTime, 
	userTime: PFileTime): BOOL; stdcall;	

var GetSystemTimes: TGetSystemTimes;

function FileTime_to_Int64(ft: TFileTime): Int64;
begin
	Result := Int64(ft.dwHighDateTime) shl 32 or ft.dwLowDateTime;
end;

var prev_idle: Int64;
	prev_busy: Int64;

function GetCPULoad: Double;
var idleTime, kernelTime, userTime: TFileTime;
	idle, busy, delta_idle, delta_busy: Int64;
	kernel: THandle;
begin
	Result := -1;
	if not Assigned(GetSystemTimes) then
	begin
		kernel := LoadLibrary('kernel32.dll');
		GetSystemTimes := TGetSystemTimes(
			GetProcAddress(kernel, 'GetSystemTimes'));
		if not Assigned(GetSystemTimes) then Exit;
	end;
	if not GetSystemTimes(@idleTime, @kernelTime, @userTime) then
		Exit;
	idle := FileTime_to_Int64(idleTime);
	busy := FileTime_to_Int64(kernelTime) + FileTime_to_Int64(userTime);
	delta_idle := idle - prev_idle;
	delta_busy := busy - prev_busy;
	if prev_busy > 0 then
		if delta_busy > 0 then
			Result := (1.0 - delta_idle / delta_busy) * 100.0
		else Result := 0
	else Result := 0;
	prev_idle := idle;
	prev_busy := busy;
end;
{$ENDIF LINUX}

		function Get_power_status(pow: DynAInt): Double;
//?{System_functions}.Power_status
		{$IFDEF LINUX}
		{$ELSE}
		var sps: TSystemPowerStatus;
		{$ENDIF}
//.
		var flags: Integer;
		begin
//?{System_functions}.Power_status
			{$IFnDEF LINUX}
			FillChar(sps, SizeOf(sps), 0);
			if GetSystemPowerStatus(sps) then
			begin
				pow.Add( sps.ACLineStatus );
				flags := 0;
				if sps.BatteryFlag = 255 then flags := flags or 1;
				if sps.BatteryFlag <> 255 then
				begin
					if (sps.BatteryFlag and 1) <> 0 then //high
						flags := flags or 2;
					if (sps.BatteryFlag and 2) <> 0 then //low
						flags := flags or 4;
					if (sps.BatteryFlag and 4) <> 0 then //critical
						flags := flags or 8; 
					if (sps.BatteryFlag and 8) <> 0 then //charging
						flags := flags or 16;
					if (sps.BatteryFlag and 128) <> 0 then //no batt
						flags := flags or 32;
				end;
				if sps.BatteryLifePercent > 100 then
					flags := flags or 64;
				if Integer(sps.BatteryLifeTime) = -1 then
					flags := flags or 128;
				if Integer(sps.BatteryFullLifeTime) = -1 then
					flags := flags or 256;
				pow.Add(flags);
				Result := sps.BatteryLifePercent;
				if ((flags and 256) = 0) and (Result > 0) and (Result < 100) then
					Result := sps.BatteryLifeTime * 100.0
						/ sps.BatteryFullLifeTime;
				pow.Add(Trunc(Result));
				pow.Add(sps.BatteryLifeTime); 
				pow.Add(sps.BatteryFullLifeTime);
			end;
			{$ENDIF}
//.
		end;

function DiskGetSize( const Path: String; get_free: Boolean ): Int64;
{$IFDEF LINUX}
{$ELSE}
type TGetDFSEx = function( 
	Path: PChar; CallerFreeBytes, TotalBytes, FreeBytes: Pointer )
	: Bool; stdcall;
var GetDFSEx: TGetDFSEx;
    Kern32: THandle;
    V: TOSVersionInfo;
    Ex: Boolean;
    SpC, BpS, NFC, TNC: DWORD;
    FBA, TNB: Int64;
{$ENDIF}
begin
	{$IFDEF LINUX}
	{$ELSE}
  GetDFSEx := nil;
  V.dwOSVersionInfoSize := Sizeof( V );
  GetVersionEx( POSVersionInfo( @ V )^ ); // bug in Windows.pas !
  Ex := FALSE;
  if V.dwPlatformId = VER_PLATFORM_WIN32_NT then
      Ex := V.dwMajorVersion >= 4
  else if V.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then
  begin
      Ex := V.dwMajorVersion > 4;
      if not Ex then
      if V.dwMajorVersion = 4 then
      begin
          Ex := V.dwMinorVersion > 0;
          if  not Ex then
              Ex := LoWord( V.dwBuildNumber ) >= $1111;
      end;
  end;
  if Ex then
  begin
    Kern32 := GetModuleHandle( 'kernel32' );
    GetDFSEx := TGetDFSEx(GetProcAddress( Kern32, 'GetDiskFreeSpaceExA' ));
  end;
  Result := 0;
  if Assigned( GetDFSEx ) then
  	 if get_free then GetDFSEx( PChar( Path ), @ FBA, @ TNB, @Result )
  	 else GetDFSEx( PChar( Path ), @ FBA, @Result, @NFC )
  else
  begin
     GetDiskFreeSpace( PChar( Path ), SpC, BpS, NFC, TNC );
     Result := Int64(SpC) * Int64(BpS);
     if get_free then Result := Result * Int64(NFC)
     else Result := Result * Int64(TNC);
  end;
  	{$ENDIF}
end;

function DiskVolumeLabel( const Path: String ): String;
{$IFDEF LINUX}
{$ELSE}
var buffer: array[0..255] of AnsiChar;
	mcl, flags: DWORD;
{$ENDIF}
begin
	{$IFDEF LINUX}
	{$ELSE}
	buffer[0] := #0;
	GetVolumeInformationA(PChar(Path),
		buffer,
		Sizeof(buffer),
		nil, 
		mcl, 
		flags, 
		nil,
		0);
	Result := buffer;
  	{$ENDIF}
end;

function DiskFileSystem( const Path: String ): String;
{$IFDEF LINUX}
{$ELSE}
var buffer: array[0..255] of AnsiChar;
	mcl, flags: DWORD;
{$ENDIF}
begin
	{$IFDEF LINUX}
	{$ELSE}
	buffer[0] := #0;
	GetVolumeInformationA(PChar(Path),
		nil,
		0,
		nil, 
		mcl, 
		flags, 
		buffer,
		Sizeof(buffer));
	Result := buffer;
  	{$ENDIF}
end;

(*
/*

CONST STR:
	NATIVE_Hardware_import = @
	"uses {$IFDEF LINUX}{$ELSE} Windows, {$ENDIF} NATIVE_Hardware;"	

	NATIVE_Get_drives = @
	"var d: Integer; c: Char;"
 	"{$IFnDEF LINUX}"
	"	d := GetLogicalDrives;"
	"	for c := 'A' to 'Z' do"
	"	begin"
	"		if (d and 1) <> 0 then RESULT := RESULT + c;"
	"		d := d shr 1;"
	"	end;"
	"{$ENDIF}"
	
	NATIVE_Get_drive_type = @
	"{$IFnDEF LINUX}"
	"	RESULT := GetDriveType(PChar(X_disk {$IFDEF FPC}.As_string {$ENDIF} ));"
	"	/////////////////////////////////////////"     
	"	//Writeln('called GetDriveType(' + PChar(X_disk) + ')-->' + "
	"	//IntToStr(RESULT));"     
	"	///////////////////"     
	"{$ENDIF}"
	
	NATIVE_Eject_drive = @
	"	RESULT := EjectDrive("
	"   			 {$IFDEF FPC} X_disk {$IFDEF FPC}.As_string {$ENDIF} [1]"
	"   			 {$ELSE} X_disk[1]"
	"   			 {$ENDIF});"
	
	NATIVE_Disk_volume_label = @
	"	RESULT := DiskVolumeLabel("
	"			  PChar(X_disk {$IFDEF FPC}.As_string{$ENDIF} ));"
	
	NATIVE_Disk_total_size = @
	"	RESULT := DiskGetSize("
	"			  PChar(X_disk {$IFDEF FPC}.As_string{$ENDIF} ), false);"
	
	NATIVE_Disk_free_space = @
	"	RESULT := DiskGetSize("
	"			  PChar(X_disk {$IFDEF FPC}.As_string{$ENDIF} ), true);"
	
	NATIVE_Disk_file_system = @
	"	RESULT := DiskFileSystem(X_disk {$IFDEF FPC}.As_string{$ENDIF});"     
	
	NATIVE_Memory_status = @
	"{$IFnDEF LINUX} "
	"Do_Memory_status(X_mem);"
	"{$ENDIF}"
	
	NATIVE_Processor_load = @
	" {$IFnDEF LINUX}"
	"RESULT := GetCPULoad;"
	" {$ENDIF} "
	
	NATIVE_Processors_count = @
	" RESULT := Processors_count; "
	
	NATIVE_Power_status = @
	"	RESULT := Get_power_status(X_pow);"
	.

END

*/
*)

end.
