API application examples

API declarations transparent

{API声明}
type
  TSetLayeredWindowAttributes
    = function(wnd: HWND; crKey: DWORD;
      bAlpha: BYTE; dwFlag: DWORD): Boolean; stdcall;

const
  WS_EX_LAYERED = ＄80000;
  LWA_ALPHA = 2;

var
  hLibUser32: THandle;
  MySetLayeredWindowAttributes:
      TSetLayeredWindowAttributes;

implementation

{＄R ＊.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  p: Pointer;
begin
  hLibUser32 := LoadLibraryA(‘user32.dll');
  MySetLayeredWindowAttributes := nil;
  if hLibUser32 <> 0 then begin
p:=GetProcAddress(hLibUser32,
    ‘SetLayeredWindowAttributes');
    if p = nil then begin
      FreeLibrary(hLibUser32);
      hLibUser32 := 0;
    end else begin
      MySetLayeredWindowAttributes :=
    TSetLayeredWindowAttributes(p);
    end;
  end;
  if hLibUser32 <> 0 then begin
    SetWindowLong(Handle, GWL_EXSTYLE,
      GetWindowLong(Handle, GWL_EXSTYLE)
      or WS_EX_LAYERED);
    ScrollBar1.Position := ScrollBar1.Max;
    ScrollBar1Change(Self);
  end else begin
    ShowMessage(‘该操作系统不支持！');
    Application.Terminate;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if hLibUser32 <> 0 then begin
    FreeLibrary(hLibUser32);
    hLibUser32 := 0;
  end;
end;

procedure TForm1.ScrollBar1Change(Sender: TObject);
var
  alpha: Integer;
begin
  if hLibUser32 <> 0 then begin
    alpha := ScrollBar1.Position;
alpha := alpha ＊ 255 div
(ScrollBar1.Max － ScrollBar1.Min);
    if alpha < 8 then alpha := 8;
    if alpha > 255 then alpha := 255;
MySetLayeredWindowAttributes
(Handle, 0, Byte(alpha), LWA_ALPHA);
  end;
end;

View Code

 How to get the path of the desktop system

When we write programs, often need to get the system in some special directory, such as: Desktop, Favorites, history files, fonts, and so on. In Windows98, Windows NT, Windows 2000 in their position is not the same, especially in windows2000 and wodows NT, they landed a position with a different user changed. So how do we get the specific location of these special directories it? 
       Of course, the use of Api function, and now I introduce two Api function, they can easily use a simple access to these special system directory. 
      Function the SHGetSpecialFolderLocation (hwndOwner: the HWND; nFolder: Integer; 
 var ppidl: PItemIDList): the HResult; _stdcall ; 
      Function SHGetPathFromIDList (PIDL: PItemIDList; pszPath: the PChar): BOOL; _stdcall ; 
      wherein specified by nFolder parameter is the respective particular system directory: 
      CSIDL_DESKTOP : There is no doubt that this is the desktop; 
      CSIDL_DRIVERS: my computer; 
      CSIDL_FAVORITES: favorites; 
      CSIDL_STARTUP: start menu; 
      CSIDL_NETWORK: my Network Places;
       There are many, you can check what the help file Delphi Win32 Api function, but these parameters with the help file is not very full, like help files which have no favorites, you can check what its headers: shlobj. pas. 
      Now I will use these two functions acquired path desktop (can be used in win98 and Win2000): 
       uses shlobj;
        var 
         pItem: PITEMIDLIST; 
         S: String ;
        the begin 
          the SHGetSpecialFolderLocation (handle, CSIDL_DESKTOP, pItem); 
         SetLength (S, 100 ); 
          SHGetPathFromIDList (pItem, PChar (s)); 
       End ; 
        stored in the table is the string s path value. Simple, right! It is that simple, but if you do not know, you have around a big circle.

View Code

 Delphi restart the computer, shut down the computer, log off (exit the current user login system with other users re) implementation code function, be regarded as an example of a basis of comparison in Delphi, after the program is running, there is a corresponding control buttons on the form, time to test Note well, if you click shut down or restart, the computer will execute the order, you need to save to save the contents.

unit MainUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TMainForm = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
procedure GetPrivilege;
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
procedure TMainForm.GetPrivilege;
var
NewState: TTokenPrivileges;
lpLuid: Int64;
ReturnLength: DWord;
ToKenHandle: Cardinal;
begin
OpenProcessToken(GetCurrentProcess,
TOKEN_ADJUST_PRIVILEGES
OR TOKEN_ALL_ACCESS
OR STANDARD_RIGHTS_REQUIRED
OR TOKEN_QUERY,ToKenHandle);
LookupPrivilegeValue(nil,'SeShutdownPrivilege',lpLuid);
NewState.PrivilegeCount:=1;
NewState.Privileges[0].Luid:=lpLuid;
NewState.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
ReturnLength:=0;
AdjustTokenPrivileges(ToKenHandle,False,NewState,0,nil,ReturnLength);
end;
procedure TMainForm.Button1Click(Sender: TObject);
begin
GetPrivilege;
ExitWindowsEx(EWX_REBOOT OR EWX_POWEROFF, 0);
end;
procedure TMainForm.Button2Click(Sender: TObject);
begin
GetPrivilege;
ExitWindowsEx(EWX_SHUTDOWN OR EWX_POWEROFF, 0);
end;
procedure TMainForm.Button3Click(Sender: TObject);
begin
ExitWindowsEx(EWX_LOGOFF, 0);
end;
end.

View Code

delphi get all application window title is similar to the Task Manager

delphi get all application window title is similar to the task manager
 Procedure TForm1.Button1Click (Sender: TObject);
 var 
    hCurWindow: the HWnd; 
    WinText: Array [ 0 .. 255 ] of char;
 the begin 
   memo1.Lines.Clear; 
   hCurWindow: = the GetWindow ( the Handle, GW_HWNDFIRST);
    the while hCurWindow <> 0  do 
   the begin 
   IF (the GetWindowText (hCurWindow, @ WinText, 255 )> 0 ) and (IsWindowVisible (hcurwindow))
    and (StrPas (@WinText) <> ' Program Manager ' )and (StrPas (@WinText) <> self.Caption) the then 
   // IF the GetWindowText (hCurWindow, @ WinText, 255)> 0 the then all this available window title (can be found in the system program) 
     Memo1.Lines.Add (StrPas (@ WinText)); 
     hCurWindow: = GetWindow (hCurWindow, GW_HWNDNEXT); // Find the next window handles. 
   End ;
 End ;  

View Code

Restart the computer:

procedure TForm1.RebootSystem;
var
  osVerInfo: TOSVersionInfo;
  rl: Cardinal;
  hToken: Cardinal;
  tkp: TOKEN_PRIVILEGES;
begin
  if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or
    TOKEN_QUERY, hToken) then
  begin
    osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
    if GetVersionEx(osVerInfo) then
      case osVerInfo.dwPlatformId of
        VER_PLATFORM_WIN32_NT: // Windows NT/2000/XP
          begin
            OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or 
              TOKEN_QUERY, hToken) 
            ow LookupPrivilegeValue ( nil , ' SeShutdownPrivilege ' , 
              tkp.Privileges [ 0 ] .Luid) THENI 
            Begin 
              tkp.Privileges [ 0 ] .Attributes: = SE_PRIVILEGE_ENABLED; 
              tkp.PrivilegeCount: = 1 ; 
              AdjustTokenPrivileges (hToken, False, dpi, 0 , nil , rl)
            end ;
            // ExitWindowsEx (EWX_SHUTDOWN EWX_FORCE + + EWX_POWEROFF, 0); //关闭计算机
            ExitWindowsEx (EWX_REBOOT, $ FFFF); // 重启
          end ; 
        VER_PLATFORM_WIN32_WINDOWS: // Windows 95/98 / 98SE / Me 
          Begin 
            // ExitWindowsEx (EWX_SHUTDOWN EWX_FORCE + + EWX_POWEROFF, 0); //关闭计算机 
            ExitWindowsEx (EWX_REBOOT, $ FFFF); // 重启
  
          end ;
      end ;
  end ;
end ;

View Code