:: MVP ::
|
|
:: RSS ::
|
|
|
Как узнать имя пользователя?
// Способ первый
function GettingUserName: string;
var
Size: Cardinal;
pStr: PChar;
Res: Boolean;
begin
pStr := nil;
Size := MAX_COMPUTERNAME_LENGTH + 1;
try
pStr := StrAlloc(Size);
Res := GetUserName(pStr, Size);
if Res then
Result := StrPas(pStr)
else
Result := 'Имя пользователя неизвестно';
finally
if pStr <> nil then
StrDispose(pStr);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GettingUserName);
end;
// Способ второй
const
WTS_CURRENT_SERVER_HANDLE = THandle(0);
WTSUserName = 5;
function ProcessIdToSessionId(dwProcessId: DWORD; var pSessionId: DWORD): BOOL;
stdcall; external 'Kernel32.dll' name 'ProcessIdToSessionId';
function WTSQuerySessionInformationA(hServer: THandle; SessionId: DWORD;
WTSInfoClass: DWORD; var ppBuffer: Pointer; var pBytesReturned: DWORD
): BOOL; stdcall; external 'wtsapi32.dll' name 'WTSQuerySessionInformationA';
procedure WTSFreeMemory(pMemory: Pointer); stdcall;
external 'wtsapi32.dll' name 'WTSFreeMemory';
procedure TForm1.Button1Click(Sender: TObject);
var
BufSize: Cardinal;
pBuf: PAnsiChar;
pSessionId: DWORD;
Result: string;
begin
ProcessIdToSessionId(GetCurrentProcessId, pSessionId);
// или pSessionId := DWORD(-1);
if WTSQuerySessionInformationA(WTS_CURRENT_SERVER_HANDLE, pSessionId,
WTSUserName, Pointer(pBuf), BufSize) then
try
SetString(Result, pBuf, BufSize);
ShowMessage(Result);
finally
WTSFreeMemory(pBuf);
end;
end;
|
Как узнать имя компьютера?
// Способ первый
function GettingComputerName: string;
var
Size: Cardinal;
pStr: PChar;
Res: Boolean;
begin
pStr := nil;
Size := MAX_COMPUTERNAME_LENGTH + 1;
try
pStr := StrAlloc(Size);
Res := GetComputerName(pStr, Size);
if Res then
Result := StrPas(pStr)
else
Result := 'Имя компьютера неизвестно';
finally
if pStr <> nil then
StrDispose(pStr);
end;
end;
// Способ второй
uses
{...,} WinSock;
function GetLocalName: string;
var
WSAData: TWSAData;
Buf: array [0..127] of AnsiChar;
begin
Result := '';
if WSAStartup($101, WSAData) = 0 then
try
if GetHostName(@Buf, SizeOf(Buf)) = 0 then
Result := Buf;
finally
WSACleanup;
end;
end;
|
Как получить путь к директории Windows?
function TForm1.GettingWinDirectory: string;
var
Size: Cardinal;
pStr: PChar;
begin
pStr := nil;
Size := MAX_COMPUTERNAME_LENGTH + 1;
try
pStr := StrAlloc(Size);
GetWindowsDirectory(pStr, Size);
Result := pStr;
finally
if pStr <> nil then
StrDispose(pStr);
end;
end;
|
Как получить хэндл рабочего стола для манипуляций иконками?
// Способ первый
function GetHandle: HWND;
begin
// Находим нужное окно в три этапа
Result := FindWindow('Progman', 'Program Manager');
// Используем FindWindowEx для нахождения дочернего окна
Result := FindWindowEx(Result, HWND(nil), 'SHELLDLL_DefView', nil);
// SysListView32, это список с иконками на рабочем столе
Result := FindWindowEx(Result, HWND(nil), 'SysListView32', nil);
end;
// Способ второй
function GetHandle: HWND;
var
s: string;
begin
// Находим нужное окно в три этапа
Result := FindWindow('Progman', 'Program Manager');
// Нахождим дочернее окно
Result := GetWindow(Result, GW_CHILD);
// Нахождим дочернее окно
Result := GetWindow(Result, GW_CHILD);
SetLength(s, 40);
GetClassName(Result, PChar(s), 39);
if PChar(s) <> 'SysListView32' then
Result := 0;
end;
|
Как отследить факт изменения системного времени?
type
TForm1 = class(TForm)
private
{ Private declarations }
procedure WMTIMECHANGE(var Message: TWMTIMECHANGE);
message WM_TIMECHANGE;
public
{ Public declarations }
end;
procedure TForm1.WMTIMECHANGE(var Message: TWMTIMECHANGE);
begin
Caption := 'Системное время изменено';
end;
|
Как в Windows2000 получить список пользователей?
{$EXTERNALSYM NetUserEnum}
function NetUserEnum(servername: LPWSTR; level, filter: DWORD;
bufptr: Pointer; prefmaxlen: DWORD;
entriesread, totalentries, resume_handle: LPDWORD): DWORD; stdcall;
external 'NetApi32.dll' Name 'NetUserEnum';
function NetApiBufferFree(Buffer: Pointer): DWORD; stdcall;
external 'NetApi32.dll' Name 'NetApiBufferFree';
var
Form1: TForm1;
UserList: TStringList;
// Процедура возвращает список пользователей
// локального хоста (Windows NT, Windows 2000)
procedure TForm1.GetLocalUserList(ulist: TStringList);
const
NERR_SUCCESS = 0;
FILTER_TEMP_DUPLICATE_ACCOUNT = $0001;
FILTER_NORMAL_ACCOUNT = $0002;
FILTER_PROXY_ACCOUNT = $0004;
FILTER_INTERDOMAIN_TRUST_ACCOUNT = $0008;
FILTER_WORKSTATION_TRUST_ACCOUNT = $0010;
FILTER_SERVER_TRUST_ACCOUNT = $0020;
type
TUSER_INFO_10 = record
usri10_name,
usri10_comment,
usri10_usr_comment,
usri10_full_name: PWideChar;
end;
PUSER_INFO_10 = ^TUSER_INFO_10;
var
dwERead, dwETotal, dwRes, res: DWORD;
inf: PUSER_INFO_10;
info: Pointer;
p: PChar;
i: Integer;
begin
if ulist = nil then
Exit;
ulist.Clear;
info := nil;
dwRes := 0;
res := NetUserEnum(nil, 10, FILTER_NORMAL_ACCOUNT, @info,
65536, @dwERead, @dwETotal, @dwRes);
if (res <> NERR_SUCCESS) or (info = nil) then
Exit;
p := PChar(info);
for i := 0 to dwERead-1 do
begin
inf := PUSER_INFO_10(p + i * SizeOf(TUSER_INFO_10));
ulist.Add(WideCharToString( PWideChar((inf^).usri10_name)));
end;
NetApiBufferFree(info);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
Memo1.Clear;
UserList := TStringList.Create;
GetLocalUserList(UserList);
for i := 0 to UserList.Count-1 do
Memo1.Lines.Add(UserList.Strings[i]);
UserList.Free;
end;
|
Как проверить, включён ли ActiveDesktop?
function IsActiveDeskTopOn: Boolean;
var
h: hWnd;
begin
h := FindWindow('Progman', nil);
h := FindWindowEx(h, 0, 'SHELLDLL_DefView', nil);
h := FindWindowEx(h, 0, 'Internet Explorer_Server', nil);
Result := h <> 0;
end;
|
Как отследить изменения настроек дисплея?
type
TForm1 = class(TForm)
private
{ Private declarations }
procedure WMDisplayChange(var Message: TMessage); message WM_DISPLAYCHANGE;
public
{ Public declarations }
end;
procedure TForm1.WMDisplayChange(var Message: TMessage);
begin
inherited;
ShowMessage('Настройки экрана изменены');
end;
|
При использовании материала - ссылка на сайт обязательна
|
|