Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

kursovaya / Unit2

.pas
Скачиваний:
3
Добавлен:
23.02.2016
Размер:
2.87 Кб
Скачать
unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, StdCtrls, unit1;

type
TForm2 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
SpeedButton1: TSpeedButton;
Memo1: TMemo;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure SpeedButton1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;

implementation

{$R *.dfm}

function GetComputerNetName:string; //узнаем имя компьютера
var
buffer:array[0..255] of Char;
size:DWORD;
begin
size:=256;
if GetComputerName(buffer,size) then
Result:=buffer
else Result:= '';
end;

function GetCurrentUserName:String; //узнаем имя текущего пользователя
const
cnMaxUserNameLen=254;
var
sUserName:String;
dwUserNameLen:DWORD;
begin
dwUserNameLen:=cnMaxUserNameLen-1;
SetLength(sUserName,cnMaxUserNameLen);
GetUserName(PChar(sUserName),dwUserNameLen);
SetLength(sUserName,dwUserNameLen);
Result:=sUserName;
end;

procedure TForm2.SpeedButton1Click(Sender: TObject); //информация о пользователе
const
TokenSize=800; // расчет (SizeOf(Pointer)=4 *200)
var
hToken:THandle;
pTokenInfo:PTOKENPRIVILEGES;
ReturnLen:Cardinal;
i:Integer;
PrivName:PChar;
DisplayName:PChar;
NameSize:Cardinal;
DisplSize:Cardinal;
LangId:Cardinal;
begin
Memo1.Lines.Clear;
Edit1.text:=GetComputerNetName; //вызываем функцию имени "имя компьютера"
Edit2.text:= GetCurrentUserName; //вызываем функцию "имя пользователя"
GetMem(pTokenInfo, TokenSize);
if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken) then ShowMessage('OpenProcessToken error');
if not GetTokenInformation(hToken, TokenPrivileges, pTokenInfo, TokenSize, ReturnLen) then
ShowMessage('GetTokenInformation error');
GetMem(PrivName, 255);
GetMem(DisplayName, 255);
for i := 0 to pTokenInfo.PrivilegeCount - 1 do
begin
DisplSize := 255;
NameSize := 255;
LookupPrivilegeName(nil, pTokenInfo.Privileges[i].Luid, PrivName, Namesize);
LookupPrivilegeDisplayName(nil, PrivName, DisplayName, DisplSize, LangId);
memo1.lines.Add(PrivName +^I + DisplayName);
end;
FreeMem(PrivName);
FreeMem(DisplayName);
FreeMem(pTokenInfo);
end;


procedure TForm2.FormActivate(Sender: TObject); //плавно всплывающее окно для формы 2
const
n=127;
var
i:Byte;
begin
AlphaBlend:=True;
for i:=1 to n do
begin
AlphaBlendValue:=i*2;
Repaint;
end;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
Form2.Left:=(Screen.Width-Form2.Width) div 2; //по середине моннитора
Form2.Top:=(Screen.Height-Form2.Height) div 2;
end;

end.
Соседние файлы в папке kursovaya
  • #
    23.02.20162.88 Кб2Unit1.~dfm
  • #
    23.02.20167.98 Кб3Unit1.~pas
  • #
    23.02.20166.82 Кб2Unit2.dcu
  • #
    23.02.201651 б2Unit2.ddp
  • #
    23.02.20161.71 Кб2Unit2.dfm
  • #
    23.02.20162.87 Кб3Unit2.pas
  • #
    23.02.201651 б2Unit2.~ddp
  • #
    23.02.20161.71 Кб2Unit2.~dfm
  • #
    23.02.20162.73 Кб2Unit2.~pas
  • #
    23.02.20167.8 Кб2Unit3.dcu
  • #
    23.02.201651 б2Unit3.ddp