delphi控制本计算机和远程计算机关机等
- unit mainunit;
- {远程关机源码}
- interface
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, StrUtils;
- type
- TForm1 = class(TForm)
- GroupBox1: TGroupBox;
- RadioButton1: TRadioButton;
- RadioButton2: TRadioButton;
- RadioButton3: TRadioButton;
- RadioButton4: TRadioButton;
- Button1: TButton;
- Button2: TButton;
- Label1: TLabel;
- RadioButton5: TRadioButton;
- RadioButton6: TRadioButton;
- GroupBox2: TGroupBox;
- Label2: TLabel;
- Edit1: TEdit;
- Button3: TButton;
- Label3: TLabel;
- Label4: TLabel;
- Edit2: TEdit;
- Edit3: TEdit;
- Label5: TLabel;
- Edit4: TEdit;
- Memo1: TMemo;
- Label6: TLabel;
- Button4: TButton;
- Button5: TButton;
- procedure FormShow(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure Button2Click(Sender: TObject);
- procedure Button1Click(Sender: TObject);
- procedure Button3Click(Sender: TObject);
- procedure Button4Click(Sender: TObject);
- procedure Button5Click(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- function GetWinVer: Byte;//获得当前操作系统的版本
- function SetPrivilege(PrivilegeName: string; Enable: Boolean): Boolean;//设置系统权限
- procedure ShutDownSystem(EWX_Type: Integer);//根据关机类型,执行操作
- function ShutDownRemote(lpMachineName: PChar; lpUsr: PChar; lpPwd: PChar; lpMsg: PChar; dwTimeOut: DWORD): Integer;
- end;
- var
- Form1: TForm1;
- implementation
- {$R *.dfm}
- const
- EWX_FORCE= ;
- EWX_LOGOFF= ;
- EWX_SHUTDOWN= ;
- EWX_REBOOT= ;
- EWX_POWEROFF= ;
- EWX_SLEEP= ;
- function TForm1.GetWinVer: Byte;
- var
- OS: TOSVersionInfo;
- begin
- OS.dwOSVersionInfoSize:= SizeOf(TOSVersionInfo);
- GetVersionEx(OS);
- case OS.dwPlatformId of
- VER_PLATFORM_WIN32s : Result:= ;//Windows 3.1x/32s
- VER_PLATFORM_WIN32_WINDOWS : Result:= ;//Windows 95
- VER_PLATFORM_WIN32_NT : Result:= ;//Windows NT
- else
- Result := ;
- end;
- end;
- function TForm1.SetPrivilege(PrivilegeName: string; Enable: Boolean): Boolean;
- var
- NewState, PreviousState: TTokenPrivileges;
- Token: THandle;
- dwRetLen: DWORD;
- begin
- Result:= False;
- OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, Token);
- NewState.PrivilegeCount:= ;
- if(LookupPrivilegeValue(nil, PChar(PrivilegeName), NewState.Privileges[].Luid)) then
- begin
- if Enable then
- NewState.Privileges[].Attributes:= SE_PRIVILEGE_ENABLED
- else
- NewState.Privileges[].Attributes:= ;
- dwRetLen:= ;
- Result:= AdjustTokenPrivileges(Token, False, NewState, SizeOf(PreviousState), PreviousState, dwRetLen);
- end;
- CloseHandle(token);
- end;
- function TForm1.ShutDownRemote(lpMachineName: PChar; lpUsr: PChar; lpPwd: PChar; lpMsg: PChar; dwTimeOut: DWORD): Integer;
- var
- hToken: THandle;
- nRet: Integer;
- tp, tpNew: TOKEN_PRIVILEGES;
- nr: _NETRESOURCE;
- dwRetLen, dwResult: DWORD;
- begin
- nRet := -;
- ZeroMemory(@nr, sizeof(nr));
- nr.dwType := RESOURCETYPE_ANY;
- nr.lpLocalName := '';
- nr.lpProvider := '';
- nr.lpRemoteName := lpMachineName;
- dwResult := WNetAddConnection2(nr, lpPwd, lpUsr, )- ;
- if(dwResult = ) then
- begin
- if(OpenProcessToken(GetCurrentProcess(),
- TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken)) then
- begin
- tp.PrivilegeCount := ;
- if(not(LookupPrivilegeValue(lpMachineName,
- 'SeRemoteShutdownPrivilege', tp.Privileges[].Luid))) then
- begin
- nRet := -; // 查找远程关机权限失败
- end
- else
- begin
- tp.Privileges[].Attributes := SE_PRIVILEGE_ENABLED;
- if(not(AdjustTokenPrivileges(
- hToken, false, tp, SizeOf(tp), tpNew, dwRetLen))) then
- begin
- nRet := -; // 调整远程关机权限失败
- end
- else
- begin
- if(InitiateSystemShutdown(
- lpMachineName, lpMsg, dwTimeOut, True, False)) then
- nRet :=
- else
- nRet := -; // 远程关机执行失败
- end;
- end;
- CloseHandle(hToken);
- end;
- end
- else
- nRet := -; // 连接到远程主机失败
- Result := nRet;
- end;
- procedure TForm1.ShutDownSystem(EWX_Type: Integer);
- begin
- if GetWinVer= then
- begin
- SetPrivilege('SeShutdownPrivilege', True);//提升权限到可以关机
- if (not ExitWindowsEx(EWX_Type, )) then
- SetPrivilege('SeShutdownPrivilege', False);//如果关机不成功,还将权限设置回去
- end
- else //如果内核是Win9x,或者其他,则直接调用API函数
- ExitWindowsEx(EWX_Type, );
- end;
- procedure TForm1.FormShow(Sender: TObject);
- begin
- RadioButton1.Checked:= True;
- Button1.SetFocus;
- end;
- procedure TForm1.FormCreate(Sender: TObject);
- begin
- if GetWinVer= then
- Label1.Caption:= Label1.Caption + 'Windows NT'
- else
- Label1.Caption:= Label1.Caption + 'Windows 95/98';
- Memo1.Text := '';
- Edit1.Text := '192.168.135.123';
- Edit2.Text := 'Administrator';
- Edit4.Text := '';
- AnimateWindow(Handle, , AW_CENTER);
- end;
- procedure TForm1.Button2Click(Sender: TObject);
- begin
- Close;
- end;
- procedure TForm1.Button1Click(Sender: TObject);
- begin
- if(Application.MessageBox('Do you decide to Execute?', 'System Warning', MB_OKCANCEL + MB_OK)= IDOK) then
- begin
- if (RadioButton1.Checked) then
- ShutDownSystem(EWX_SHUTDOWN)
- else if (RadioButton2.Checked) then
- ShutDownSystem(EWX_REBOOT)
- else if (RadioButton3.Checked) then
- ShutDownSystem(EWX_LOGOFF)
- else if (RadioButton4.Checked) then
- ShutDownSystem(EWX_POWEROFF)
- else if (RadioButton5.Checked) then
- ShutDownSystem(EWX_FORCE)
- else if (RadioButton6.Checked) then
- ShutDownSystem(EWX_FORCEIFHUNG);
- end;
- end;
- procedure TForm1.Button3Click(Sender: TObject);
- var
- strMsg, strCpt: string;
- dwTimeOut: DWORD;
- nRet: Integer;
- unIcon: UINT;
- begin
- if (Edit1.Text = '') or (Edit2.Text = '') then
- MessageBox(Handle, 'Input ComputerIP and UserName', 'System Warning',
- MB_OK + MB_ICONWARNING);
- if Edit1.Text[] <> '\' then
- strCpt := '\\' + Edit1.Text;
- try
- begin
- dwTimeOut := StrToInt(Edit4.Text);
- end;
- except
- begin
- dwTimeOut := ;
- end;
- end;
- nRet := ShutDownRemote(PChar(Edit1.Text), PChar(Edit2.Text), PChar(Edit3.Text),
- PChar(Memo1.Text), dwTimeOut);
- unIcon := MB_ICONWARNING;
- case nRet of
- :
- begin
- strMsg := 'Shut' + strCpt + ' Successfully';
- unIcon := MB_ICONINFORMATION;
- end;
- -: strMsg := 'Search' + strCpt + ' Failed';
- -: strMsg := 'Adjust' + strCpt + ' Failed';
- -: strMsg := 'Shut' + strCpt + ' Failed';
- -: strMsg := 'Connect' + strCpt + ' Failed';
- else
- strMsg := 'Connect to ' + strCpt + 'faild' + # + 'Maybe Can not find the IP';
- //SysErrorMessage(nRet);
- end;
- MessageBox(Handle, PChar(strMsg), 'System FeedBack', MB_OK + unIcon);
- end;
- procedure TForm1.Button4Click(Sender: TObject);
- var
- strCpt: string;
- begin
- if Edit1.Text[] <> '\' then
- strCpt := '\\' + Edit1.Text;
- if AbortSystemShutdown(PChar(strCpt)) then
- MessageBox(Handle, 'Abort Shut System successfully', 'System FeedBack', MB_OK+MB_ICONINFORMATION)
- else
- MessageBox(Handle, 'Abort Shut System failed', 'System FeedBack', MB_OK+MB_ICONWARNING);
- end;
- procedure TForm1.Button5Click(Sender: TObject);
- begin
- Close;
- end;
- end.
delphi控制本计算机和远程计算机关机等的更多相关文章
- c# Start/Stop/Check Status远程计算机的Windows Service
static void Main(string[] args) { ConnectionOptions op = new ConnectionOptions(); // 登陆远程计算机的远程, op. ...
- ubuntu下唤醒或休眠远程计算机
ubuntu让我明白,没有什么完美的东西,要想完美必须付出代价.要么花时间折腾,要么花时间赚钱买系统. 人生也是一样,所以不要期待什么完美.哪有那么好的人,在合适的时间合适的地点让你遇见,还对你有感觉 ...
- [原创]用windows7连接windows2003的终端服务器时,出现"由于这台计算机没有远程桌面客户端访问许可证,远程会话被中断"的问题
用windows7连接windows2003的终端服务器时,出现"由于这台计算机没有远程桌面客户端访问许可证,远程会话被中断"的问题,原因是终端服务器授权方式设置为了"每 ...
- ECS Win2008 远程时提示"要登录到此远程计算机,您必须被授予允许通过终端登录登录的权限"的解决方法
问题描述 ECS Windows 2008 远程登陆时提示"要登录到此远程计算机,您必须被授予允许通过终端登录登录的权限",如下图所示: 问题分析 组策略中做了设置不允许管理员组成 ...
- Win7 远程桌面 错误代码:5 异常处理(您的远程桌面会话即将结束 此计算机的虚拟内存可能不足。请关闭其他程序,然后重试连接远程计算机。如果问题仍然存在,请联系网络管理员或技术支持。)
问题表现: 在用windows7 远程桌面连接其他电脑时,出现错误提示对话框—-标题为“严重错误(错误代码:5)”,内容为“您的远程桌面会话即将结束 此计算机的虚拟内存可能不足.请关闭其他程序,然后重 ...
- win 10 远程连接出现 "由于安全设置错误, 客户端无法连接到远程计算机. 确定你已登录到网络后.” 错误
win 10 远程连接出现 "由于安全设置错误, 客户端无法连接到远程计算机. 确定你已登录到网络后.” 错误 解决方法如下: Step 1:打开"本地安全策略"- Wi ...
- PC-如何提高计算机的启动和关机的速度?
如何提高计算机的启动和关机的速度? 一.bios的优化设置 在bios设置的首页我们进入"advanced bios features"选项,将光标移到"frist bo ...
- (转)WS2008远程桌面连接时提示:“要登录到此远程计算机,您必须被授予允许通过终端服务登录的权限”的解决办法
原文:http://www.chunfengxiyu.com/ws2008-mstsc-privilege.html WS2008远程桌面连接时提示:“要登录到此远程计算机,您必须被授予允许通过终端服 ...
- 关于win8.1“连接被远程计算机关闭”的一种解决方案
我就是连接的时候出现"连接被远程计算机关闭",然后想着可能是win8更新之后网络协议 出问题了,后来无意中发现e信在第一次启动的时候会在网络适配器中会多出很多网卡,其中三个是带感叹 ...
随机推荐
- python运算符&优先性
(1)算数运算符: + - * / //(求整) %(求余) ** (2)比较运算符: > < > ...
- Python: 如何写一个异常
例子1 try: #test area function() except Exception, e: print e.message 例子2:用raise抛出一个异常 if bool_var is ...
- asp.net网站中增删文件夹会导致Session或cache等等丢失
因为这会导致网站资源本身重新加载. 如果要改变文件和文件夹,一般应该是对 app_data 下进行操作.
- Python并发编程二(多线程、协程、IO模型)
1.python并发编程之多线程(理论) 1.1线程概念 在传统操作系统中,每个进程有一个地址空间,而且默认就有一个控制线程 线程顾名思义,就是一条流水线工作的过程(流水线的工作需要电源,电源就相当于 ...
- 【Jmeter自学】Jmeter实战-web程序(六)
1.确认测试被测对象 **网站 windows环境 2.需求: 并发登录性能测试 3.场景设置: 1s增加2个线程,运行2000次 分别查看20,,60并发下的表现 4.监控 成功率 响应时间 标准差 ...
- Python下的opencv小问题大智慧
1.今晚日了狗了,图像显示不按照预期出现,然后突然就好了...... 2.根据第一个问题举一个例子,另一个我没保存... 是不是分不清楚???? plt.imshow(wjy2, cmap='gr ...
- linux问题集
Too many authentication failures for root (code 2) 原因:服务器可能由于装了一下安全软件导致有时用ssh远程工具登陆不了,提示太多认证失败for ro ...
- java-代码生成器
package ormRex; import java.io.File; import java.io.IOException; import java.io.PrintWriter; import ...
- Wed Jul 04 18:01:38 CST 2018 WARN: Establishing SSL connection without server's identity verification is not recommended
Wed Jul 04 18:01:38 CST 2018 WARN: Establishing SSL connection without server's identity verificatio ...
- samba配置中常见错误收集.txt
在命令行输入命令: ~$ smbclient -L \\127.0.0.1按要求输入密码后,提示出错:session setup failed: NT_STATUS_LOGON_FAILURE 这是因 ...