1、如何在Delphi中记录用户开、关计算机的时间
2、如何获取本地计算机的操作系统类型
3、如何获取本地计算机网络是否通畅(局域网中)
4、如何获取用户登录网络、退出网络时间(在局域网中建立了域,同时计算机以网络登录来登录)
5、如何监控用户在本地计算机的操作
希望能给出代码实现。
2、如何获取本地计算机的操作系统类型
3、如何获取本地计算机网络是否通畅(局域网中)
4、如何获取用户登录网络、退出网络时间(在局域网中建立了域,同时计算机以网络登录来登录)
5、如何监控用户在本地计算机的操作
希望能给出代码实现。
给你一个delphi的例子,利用Microsoft未公开的api函数实现的,功能非常强大,你试一下!
unit Unit1;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls,shlobj,Activex,
NMUDP;
const
SHCNE_RENAMEITEM=$1;
SHCNE_CREATE=$2;
SHCNE_DELETE=$4;
SHCNE_MKDIR=$8;
SHCNE_RMDIR=$10;
WM_SHNOTIFY =$401;
NOERROR = 0;
type
TForm1 = class(TForm)
Button1: TButton;
edIp: TEdit;
edPt: TEdit;
Label1: TLabel;
Label2: TLabel;
NMUDP1: TNMUDP;
edDir: TEdit;
Label3: TLabel;
btCancel: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btCancelClick(Sender: TObject);
procedure NMUDP1InvalidHost(var handled: Boolean);
private
{ Private declarations }
procedure WMShellReg(var Message:TMessage);message WM_SHNOTIFY;
public
{ Public declarations }
end;
type PSHNOTIFYSTRUCT=^SHNOTIFYSTRUCT;
SHNOTIFYSTRUCT = record
dwItem1 : PItemIDList;
dwItem2 : PItemIDList;
end;
Type PSHFileInfoByte=^SHFileInfoByte;
_SHFileInfoByte = record
hIcon :Integer;
iIcon :Integer;
dwAttributes : Integer;
szDisplayName : array [0..259] of char;
szTypeName : array [0..79] of char;
end;
SHFileInfoByte=_SHFileInfoByte;
Type PIDLSTRUCT = ^IDLSTRUCT;
_IDLSTRUCT = record
pidl : PItemIDList;
bWatchSubFolders : Integer;
end;
IDLSTRUCT =_IDLSTRUCT;
function SHNotify_Register(hWnd : Integer) : Bool;
function SHNotify_UnRegister:Bool;
function SHEventName(strPath1,strPath2:string;lParam:Integer):string;
Function SHChangeNotifyDeregister(hNotify:integer):integer;stdcall;external 'Shell32.dll' index 4;
Function SHChangeNotifyRegister(hWnd,uFlags,dwEventID,uMSG,cItems:LongWord;lpps:PIDLSTRUCT):integer;stdcall;external 'Shell32.dll' index 2;
Function SHGetFileInfoPidl(pidl : PItemIDList;dwFileAttributes : Integer;psfib : PSHFILEINFOBYTE;cbFileInfo : Integer;uFlags : Integer):Integer;stdcall;external 'Shell32.dll' name 'SHGetFileInfoA';var
Form1: TForm1;
m_hSHNotify:Integer;
m_pidlDesktop : PItemIDList;
iport:integer;implementation
{$R *.DFM}function SHEventName(strPath1,strPath2:string;lParam:Integer):string;
var
sEvent:String;
begin
case lParam of //根据参数设置提示消息
SHCNE_RENAMEITEM: sEvent := '重命名文件'+strPath1+'为'+strpath2;
SHCNE_CREATE: sEvent := '建立文件 文件名:'+strPath1;
SHCNE_DELETE: sEvent := '删除文件 文件名:'+strPath1;
SHCNE_MKDIR: sEvent := '新建目录 目录名:'+strPath1;
SHCNE_RMDIR: sEvent := '删除目录 目录名:'+strPath1;
end;
Result:=sEvent;
end;function SHNotify_Register(hWnd : Integer) : Bool;
var
ps:PIDLSTRUCT;
begin
{$R-}
Result:=False;
If m_hSHNotify = 0 then
begin
//获取桌面文件夹的Pidl
if SHGetSpecialFolderLocation(0, CSIDL_DESKTOP,m_pidlDesktop)<> NOERROR then
Form1.close;
if Boolean(m_pidlDesktop) then
begin
ps.bWatchSubFolders := 1;
ps.pidl := m_pidlDesktop;
// 利用SHChangeNotifyRegister函数注册系统消息处理
m_hSHNotify := SHChangeNotifyRegister(hWnd, (SHCNF_TYPE Or SHCNF_IDLIST),(SHCNE_ALLEVENTS Or SHCNE_INTERRUPT),WM_SHNOTIFY, 1, ps);
Result := Boolean(m_hSHNotify);
end
eLse
// 如果出现错误就使用 CoTaskMemFree函数来释放句柄
CoTaskMemFree(m_pidlDesktop);
end;
{$R+}
end;function SHNotify_UnRegister:Bool;
begin
Result:=False;
If Boolean(m_hSHNotify) Then
//取消系统消息监视,同时释放桌面的Pidl
If Boolean(SHChangeNotifyDeregister(m_hSHNotify)) Then
begin
{$R-}
m_hSHNotify := 0;
CoTaskMemFree(m_pidlDesktop);
Result := True;
{$R-}
End;
end;procedure TForm1.WMShellReg(var Message:TMessage); //系统消息处理函数
var
strPath1,strPath2:String;
charPath:array[0..259]of char;
pidlItem:PSHNOTIFYSTRUCT;
mystream:Tmemorystream;
mysendtext:string;
begin
pidlItem:=PSHNOTIFYSTRUCT(Message.wParam);
//获得系统消息相关得路径
SHGetPathFromIDList(pidlItem.dwItem1,charPath);
strPath1:=charPath;
SHGetPathFromIDList(pidlItem.dwItem2,charPath);
strPath2:=charPath;
if SHEvEntName(strpath1,strpath2,Message.LParam)<>'' then
if (pos(lowercase(edDir.text),lowercase(SHEvEntName(strpath1,strpath2,Message.LParam))))<>0 then
begin
mysendtext:=SHEvEntName(strPath1,strPath2,Message.LParam); //开始往指定主机发送数据
mystream:=TMemoryStream.Create;
try
mystream.Write(mysendtext[1],length(mysendtext));
nmudp1.SendStream(mystream);
finally
mystream.Free;
end;
end
end;procedure TForm1.Button1Click(Sender: TObject); //应该在这个函数里初始化ip地址和端口号,并进行错误检测
var
icode:integer;
begin
val(edPt.Text,iport,icode);
if (length(edIp.Text)=0) or (icode<>0) then //检查ip地址和端口号是否已经填写
// if length(edDir.) >0 then
showmessage('请检查IP地址和端口号是否已经正确填写!')
else //如果正确,开始初始化nmudp和注册组件
begin
if length(edDir.text)>0 then
begin
nmudp1.RemoteHost:=edIp.Text;
nmudp1.LocalPort:=iport;
nmudp1.RemotePort:=iport;
m_hSHNotify:=0;
if SHNotify_Register(Form1.Handle) then
begin //注册Shell监视
ShowMessage('Shell监视程序成功注册');
Button1.Enabled := False;
end
else
ShowMessage('Shell监视程序注册失败');
end
else
showmessage('请正确填写要监控的目录!');
end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
Button1.Caption := 'Open Watch';
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//在程序退出的同时删除监视
if Boolean(m_pidlDesktop) then
SHNotify_Unregister;
end;
procedure TForm1.btCancelClick(Sender: TObject);
begin
if Boolean(m_pidlDesktop) then
SHNotify_Unregister;
button1.Enabled:=true;
end;procedure TForm1.NMUDP1InvalidHost(var handled: Boolean);
begin
showmessage('The Destinatin host Ip is not exit,plesae check the IP !');end;end.
这也是我该别人的,delphi版中有原文,议会我给你找一下!
var
OsInfo: TOSVERSIONINFO;
begin
OsInfo.dwOSVersionInfoSize := sizeof(TOSVERSIONINFO);
GetVersionEx(OsInfo);
Result := (OsInfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS);
end;
判断系统类型的
=-------------------------
Function GetSystem:integer;stdcall;
//得到操作系统的版本信息
var
VersionInfo : TosversionInfo;
osname: shortString;
begin
result:=-1;
try
VersionInfo.dwOSVersionInfoSize := SizeOf( TOSVersionInfo );
if Windows.GetVersionEx( VersionInfo ) then
begin
with VersionInfo do
begin
case dwPlatformId of
VER_PLATFORM_WIN32s :osname:='Win32s';
VER_PLATFORM_WIN32_WINDOWS :osname:='Windows 95';
VER_PLATFORM_WIN32_NT :osname:='Windows NT';
end;
if (osname='Windows NT')and (dwMajorVersion<5) then
//满足条件的是nt操作系统
result:=1; //nt
if (osname='Windows NT')and (dwMajorVersion>4) then
result:=2 ;//2000 or 更高
if osname='Windows 95' then
result:=0;//9x
end;
end
else
result:=-1;
except
result:=-2;
end;
end;