API应用实例

API声明透明

{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

 如何取得系统中的桌面的路径

我们在编写程序的时候,经常会需要得到系统中的一些特殊目录,例如:桌面、收藏夹、历史文件、字体等。在windows98、windows NT、Windows 2000中他们的位置是不一样的，尤其在windows2000和wodows NT中，他们的位置随着登陆用户的不同而改变。那么我们要如何取得这些特殊目录的具体位置呢？
       当然是利用Api函数，现在我介绍两个Api函数，利用他们就可以轻松简单的获取这些特殊系统目录。
      Function SHGetSpecialFolderLocation(hwndOwner: HWND; nFolder: Integer;
 var ppidl: PItemIDList): HResult; stdcall;
      Function SHGetPathFromIDList(pidl: PItemIDList; pszPath: PChar):                BOOL;stdcall;
      其中由nFolder参数指定的就是各个特殊系统目录：
      CSIDL_DESKTOP：毫无疑问这就是桌面；
      CSIDL_DRIVERS：我的电脑；
      CSIDL_FAVORITES：收藏夹；
      CSIDL_STARTUP：开始菜单；
      CSIDL_NETWORK：网上邻居；
       还有很多，你可以查阅一下Delphi的Win32 Api函数的帮助文件，不过在帮助文件下的这些参数也不是很全，像收藏夹帮助文件里面就没有，你可以查阅一下它的头文件：shlobj.pas。
      下面我就利用这两个函数取得桌面的路径(在win98和win2000下都可以使用):
       uses shlobj;
       var
         pitem:PITEMIDLIST;
         s:string;
       begin
          shGetSpecialFolderLocation(handle,CSIDL_DESKTOP,pitem);
         setlength(s,100);
          shGetPathFromIDList(pitem,pchar(s));
       end;
        在字符串s中存储的就是桌面的路径值。简单吧！就是这么简单，但要是你不知道，你就得绕一个大圈子。

View Code

 Delphi重启电脑、关闭计算机、注销（退出当前用户用其它用户重新登录系统）功能的实现代码，在Delphi中算是比较基础的例子了，程序运行后，窗体上有对应的控制按钮，测试时候要注意哦，如果点击关闭或重启，电脑就会执行该项命令，要保存好你需要保存的内容。

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 获取所有应用程序窗口标题 类似任务管理器

delphi 获取所有应用程序窗口标题 类似任务管理器
procedure TForm1.Button1Click(Sender: TObject);
var
    hCurWindow:HWnd;
    WinText:array[0..255] of char;
begin
   memo1.Lines.Clear;
   hCurWindow:=GetWindow(Handle,GW_HWNDFirst);
   while hCurWindow<>0 do
   begin
   if (GetWindowText(hCurWindow,@WinText,255)>0) and (IsWindowVisible(hcurwindow))
   and(StrPas(@WinText)<>'Program Manager')and(StrPas(@WinText)<>self.Caption) then
   //if GetWindowText(hCurWindow,@WinText,255)>0 then 此可获得所有窗口標題(可找到系統程序)
     Memo1.Lines.Add(StrPas(@WinText));
     hCurWindow:=GetWindow(hCurWindow,GW_HWNDNEXT); //查找下个程序窗口句柄.
   end;
end;  

View Code

重启计算机：

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);
            if LookupPrivilegeValue(nil, 'SeShutdownPrivilege',
              tkp.Privileges[0].Luid) then
            begin
              tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
              tkp.PrivilegeCount := 1;
              AdjustTokenPrivileges(hToken, False, tkp, 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

 

转载于:https://www.cnblogs.com/blogpro/p/11344151.html