Recent

Author Topic: Windows System Manipulation with Lazarus  (Read 16259 times)

BioHazard

  • Jr. Member
  • **
  • Posts: 57
  • Starless...
Windows System Manipulation with Lazarus
« on: May 02, 2011, 10:32:23 pm »
I m impressed this old delphi unit works with Lazarus as it worked 7 years ago and maybe useful for beginners. It includes Windows Shutdown, Windows Restart, Windows Shutdown Force, Windows Restart Force, Windows Enable/Disable Taskbar, Windows Minimize All Winodws, Get Windows User Name, Get Windows Computer Name, Get Windows Ip, Set Windows Screen Rezolution and some more useful functions and procedures:

Code: [Select]
unit _System;

interface

uses Windows, SysUtils, Winsock, Classes;

procedure SystemDesktopEnable;
procedure SystemDesktopDisable;

procedure SystemTaskbarDisable;
procedure SystemTaskbarEnable;
procedure SystemTaskbarHide;
procedure SystemTaskbarShow;

procedure SystemWindowsMinimize;

procedure SystemShutdownForce;
procedure SystemRestartForce;

procedure SystemShutDown;
procedure SystemRestart;

function SystemScreenResolutionSet(Width, Height: integer): longint;
function SystemComputerName: string;
function SystemUserLogin: string;
function SystemIp: string;


implementation


procedure SystemDesktopEnable;
begin
  EnableWindow(FindWindowEx(FindWindow('Progman', nil), 0,
    'ShellDll_DefView', nil), False);
end;

procedure SystemDesktopDisable;
begin
  EnableWindow(FindWindowEx(FindWindow('Progman', nil), 0,
    'ShellDll_DefView', nil), True);
end;

procedure SystemTaskbarDisable;
begin
  EnableWindow(FindWindow('Shell_TrayWnd', nil), False);
end;

procedure SystemTaskbarEnable;
begin
  EnableWindow(FindWindow('Shell_TrayWnd', nil), True);
end;

function SystemIp: string;
type
  TaPInAddr = array [0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  Buffer: array [0..63] of char;
  I: integer;
  GInitData: TWSADATA;

begin
  WSAStartup($101, GInitData);
  Result := '';
  GetHostName(Buffer, SizeOf(Buffer));
  phe := GetHostByName(buffer);
  if phe = nil then
    Exit;
  pptr := PaPInAddr(Phe^.h_addr_list);
  I := 0;
  while pptr^[I] <> nil do
  begin
    Result := StrPas(inet_ntoa(pptr^[I]^));
    Inc(I);
  end;
  WSACleanup;
end;

procedure SystemTaskbarHide;
var
  wndClass: array[0..50] of char;
  wndHandle: THandle;
begin
  StrPCopy(@wndClass[0], 'Shell_TrayWnd');
  wndHandle := FindWindow(@wndClass[0], nil);
  ShowWindow(wndHandle, SW_HIDE);
end;

procedure SystemTaskbarShow;
var
  wndClass: array[0..50] of char;
  wndHandle: THandle;
begin
  StrPCopy(@wndClass[0], 'Shell_TrayWnd');
  wndHandle := FindWindow(@wndClass[0], nil);
  ShowWindow(wndHandle, SW_SHOW);
end;

procedure SystemWindowsMinimize;
begin
  Keybd_event(VK_LWIN, 0, 0, 0);
  Keybd_event(byte('M'), 0, 0, 0);
  Keybd_event(byte('M'), 0, KEYEVENTF_KEYUP, 0);
  Keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0);
end;

function SystemPrivilegeSet(sPrivilegeName: string; bEnabled: boolean): boolean;
var
  TPPrev, TP: TTokenPrivileges;
  Token: THandle;
  dwRetLen: DWord;
begin
  Result := False;
  OpenProcessToken(
    GetCurrentProcess,
    TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
    Token);
  TP.PrivilegeCount := 1;
  if (LookupPrivilegeValue(nil, PChar(sPrivilegeName),
    TP.Privileges[0].LUID)) then
  begin
    if (bEnabled) then
    begin
      TP.Privileges[0].Attributes :=
        SE_PRIVILEGE_ENABLED;
    end
    else
    begin
      TP.Privileges[0].Attributes :=
        0;
    end;
    dwRetLen := 0;
    Result := AdjustTokenPrivileges(Token, False,
      TP, SizeOf(TPPrev), TPPrev,
      dwRetLen);
  end;
  CloseHandle(Token);
end;



// iFlags:

//  one of the following must be
//  specified

//   EWX_LOGOFF
//   EWX_REBOOT
//   EWX_SHUTDOWN

//  following attributes may be
//  combined with above flags

//   EWX_POWEROFF
//   EWX_FORCE    : terminate processes

function SystemExit(iFlags: integer): boolean;
begin
  Result := True;
  if (SystemPrivilegeSet('SeShutdownPrivilege', True)) then
  begin
    if (not ExitWindowsEx(iFlags, 0)) then
    begin
      // handle errors...
      Result := False;
    end;
    SystemPrivilegeSet('SeShutdownPrivilege', False);
  end
  else
  begin
    // handle errors...
    Result := False;
  end;
end;


procedure SystemShutdownForce;
begin
  SystemExit(EWX_SHUTDOWN + EWX_FORCE + EWX_POWEROFF);
end;

procedure SystemRestartForce;
begin
  SystemExit(EWX_REBOOT + EWX_FORCE);
end;

procedure SystemShutdown;
begin
  SystemExit(EWX_SHUTDOWN + EWX_POWEROFF);
end;

procedure SystemRestart;
begin
  SystemExit(EWX_REBOOT);
end;



function SystemUserLogin: string;
const
  cnMaxLen = 254;
var
  sUserName: string;
  dwUserNameLen: DWord;
begin
  dwUserNameLen := cnMaxLen - 1;
  SetLength(sUserName, cnMaxLen);
  GetUserName(PChar(sUserName), dwUserNameLen);
  SetLength(sUserName, dwUserNameLen);
  Result := sUserName;
  if dwUserNameLen = cnMaxLen - 1 then
    Result := '';
end;

function SystemComputerName: string;
const
  cnMaxLen = 254;
var
  sUserName: string;
  dwUserNameLen: DWord;
begin
  dwUserNameLen := cnMaxLen - 1;
  SetLength(sUserName, cnMaxLen);
  GetComputerName(PChar(sUserName), dwUserNameLen);
  SetLength(sUserName, dwUserNameLen);
  Result := sUserName;
  if dwUserNameLen = cnMaxLen - 1 then
    Result := '';
end;


function SystemScreenResolutionSet(Width, Height: integer): longint;
var
  DeviceMode: TDeviceMode;
begin
  with DeviceMode do
  begin
    dmSize := SizeOf(TDeviceMode);
    dmPelsWidth := Width;
    dmPelsHeight := Height;
    dmFields := DM_PELSWIDTH or DM_PELSHEIGHT;
  end;
  Result := ChangeDisplaySettings(DeviceMode, CDS_UPDATEREGISTRY);
end;



end.
« Last Edit: May 03, 2011, 11:10:13 am by BioHazard »

Fred vS

  • Hero Member
  • *****
  • Posts: 2083
    • StrumPract is the musicians best friend
Re: Windows System Manipulation with Lazarus
« Reply #1 on: May 03, 2011, 03:08:50 am »
Thank you, very useful and clear  :)
Any plan for a sytem manipulation for Linux and OSX ?
I use Lazarus 2.0.6 32/64 and FPC 3.2.0 32/64 on Debian 10.2 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64 and Mac OS X Snow Leopard 32.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt, Carbon.

https://github.com/fredvs
https://gitlab.com/fredvs

Takeda

  • Full Member
  • ***
  • Posts: 157
Re: Windows System Manipulation with Lazarus
« Reply #2 on: May 03, 2011, 03:14:31 am »
I m impressed this old delphi unit works with Lazarus as it worked 7 years ago and maybe useful for beginners. It includes Windows Shutdown, Windows Restart, Windows Shutdown Force, Windows Restart Force, Windows Enable/Disable Taskbar, Windows Minimize All Winodws, Get Windows User Name, Get Windows Computer Name, Get Windows Ip, Set Windows Screen Rezolution and some more useful functions and procedures:

Cool.. I love it.  :)
Well, Can I use this codes and put it into my program for free? I mean, I'll adding this code into my commercial program?  O:-)
Call me Takeda coz that's my true name.
Pascal coding using Lazarus => "Be native in any where.."

ƪ(˘⌣˘)┐ ƪ(˘⌣˘)ʃ ┌(˘⌣˘)ʃ

BioHazard

  • Jr. Member
  • **
  • Posts: 57
  • Starless...
Re: Windows System Manipulation with Lazarus
« Reply #3 on: May 03, 2011, 11:08:42 am »
Thank you, very useful and clear  :)
Any plan for a sytem manipulation for Linux and OSX ?
I have programmed only 3 times linux app and I have no idea still how on linux such things are done...

: )
Cool.. I love it.  :)
Well, Can I use this codes and put it into my program for free? I mean, I'll adding this code into my commercial program?  O:-)
Of course...

carli

  • New Member
  • *
  • Posts: 14
Re: Windows System Manipulation with Lazarus
« Reply #4 on: May 03, 2011, 04:27:04 pm »
Thank you, very useful and clear  :)
Any plan for a sytem manipulation for Linux and OSX ?

For Unix, you need more privileges to shut down the computer ;)

Nice work, i will see how i can annoy some windows-user friends with that

nicke85

  • Jr. Member
  • **
  • Posts: 92
  • #13#10
Re: Windows System Manipulation with Lazarus
« Reply #5 on: May 03, 2011, 05:16:12 pm »
Excellent unit for learning :D
ArchLinux X64 (XFCE) & Windows 7 SP1 Ultimate X64
FPC 2.7.1 / Lazarus 1.1 / ZeosDBO / fortes4lazarus -- all svn

carlosrm

  • Newbie
  • Posts: 1
Re: Windows System Manipulation with Lazarus
« Reply #6 on: November 24, 2011, 03:42:49 pm »
Very, very useful. Thank you.

xinyiman

  • Hero Member
  • *****
  • Posts: 2147
    • Lazarus and Free Pascal italian community
Re: Windows System Manipulation with Lazarus
« Reply #7 on: November 24, 2011, 03:58:13 pm »
interesting  ;)
Win10, Ubuntu and Mac
Lazarus: 2.1.0
FPC: 3.3.1

LA.Center

  • Full Member
  • ***
  • Posts: 244
    • LA.Center
Re: Windows System Manipulation with Lazarus
« Reply #8 on: November 24, 2011, 09:46:16 pm »
Thx a bunch, nice code :)

 

TinyPortal © 2005-2018