Автоматизация отдела маркетинга, рекламы и ИТ “Завод-ВТО”

     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);

     memo2.lines.Add(PrivName +^I + DisplayName);

   end;

   FreeMem(PrivName);

   FreeMem(DisplayName);

   FreeMem(pTokenInfo); 
 

end; 

procedure TForm1.Button2Click(Sender: TObject);

var i:integer;

begin

p1.Position:=10;

memo1.Lines.Clear;

p1.Position:=20;

sleep(1);

p1.Position:=30;

memo1.Lines.add('Подожди,блин...');

p1.Position:=35;

memo1.Lines.add('---');

findallcomputers(edit3.text);

p1.Position:=40;

for i:=1 to computercount do

begin

memo1.Lines.Add(computer[i]); 

end;

p1.Position:=60;

memo1.Lines.add('---');

p1.Position:=80;

memo1.Lines.add('Завершено.');

showmessage('Сканирование окончено');

p1.Position:=100;

timer1.Enabled:=true;

end; 

procedure TForm1.Timer1Timer(Sender: TObject);

begin

p1.Position:=0;

timer1.Enabled:=false;

end; 

procedure TForm1.Timer2Timer(Sender: TObject);

begin

label5.Caption:=datetostr(date);

label6.Caption:=timetostr(time);

end; 

procedure TForm1.Button3Click(Sender: TObject);

begin

edit4.Enabled:=true;

   edit4.Text:=IPAddrToName(Edit5.Text);

end; 

procedure TForm1.Button4Click(Sender: TObject); 

var

  reg : TRegistry;

  ts : TStrings;

  i : integer;

begin

  reg := TRegistry.Create;

  reg.RootKey := HKEY_CURRENT_USER;

  reg.LazyWrite := false;

  reg.OpenKey(

   'Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders',

              false);

    ts := TStringList.Create;

    reg.GetValueNames(ts);

    for i := 0 to ts.Count -1 do begin

      Memo3.Lines.Add(ts.Strings[i] +

                      ' = ' +

                      reg.ReadString(ts.Strings[i]));

    end;

    ts.Free;

  reg.CloseKey;

  reg.free;

  button4.Enabled:=false;

  button5.Enabled:=true;

  button6.Enabled:=true;

end;

function KillTask(FileName: string): integer;

var

  ContinueLoop: BOOL;

  FSnapshotHandle: THandle;

  FProcessEntry32: TProcessEntry32;

const

  PROCESS_TERMINATE = $0001;

begin

  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);

  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);

  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);

  while integer(ContinueLoop) <> 0 do

  begin

    if

      ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =

      UpperCase(FileName))

      or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(FileName))) then

      Result := Integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0), 

        FProcessEntry32.th32ProcessID), 0));

    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);

  end;

  CloseHandle(FSnapshotHandle);

end; 
 
 
 

procedure TForm1.Button7Click(Sender: TObject);

begin

if (KillTask(edit6.Text)=0) then

begin

  showmessage('Невозможно!!!');

end else

  begin

showmessage('Процесс  завершен!!!');

  end;

end; 

procedure TForm1.Button8Click(Sender: TObject);

var

  H: Integer;

begin 

H := FindWindow('Shell_TrayWnd',

    nil); {??????? ????? ???? ????????}

  if (H = 0) then

    Application.MessageBox('Window not found', nil, IDOK) {? ????? ?? ????? ?!

    8-)}

  else

    ShowWindow(H, SW_HIDE); {?????? ???

  ?????????}

  ShowDesktop(false); 
 

end; 

procedure TForm1.Button9Click(Sender: TObject);

var

  H: Integer;

begin

H := FindWindow('Shell_TrayWnd',

    nil); {??????? ????? ???? ????????}

  if (H = 0) then

    Application.MessageBox('Window not found', nil, IDOK) {? ????? ?? ????? ?!

    8-)}

  else

    ShowWindow(H,

      SW_SHOW); {?????? ??? ???????}

    ShowDesktop(true); 

end; 

procedure TForm1.FormCreate(Sender: TObject);

var

i       : Integer;

DevMode : TDevMode;

begin 

if DoIExist(Self.Caption) then

    Halt;

i:=0;

while EnumDisplaySettings(nil,i,DevMode) do begin

   with Devmode do

    ListBox1.Items.Add

     (Format('%dx%d %d Colors',

     [dmPelsWidth,dmPelsHeight,1 shl dmBitsperPel]));

   Inc(i);

end; 

end; 

procedure TForm1.Button10Click(Sender: TObject);

 var

  DevMode    : TDeviceMode;

  liRetValue : Longint;

begin

if EnumDisplaySettings

    (nil,Listbox1.ItemIndex,Devmode) then

  liRetValue := ChangeDisplaySettings

                  (DevMode, CDS_UPDATEREGISTRY); 

  SendMessage(HWND_BROADCAST,

              WM_DISPLAYCHANGE,

              SPI_SETNONCLIENTMETRICS,

              0);  
 
 

end;

function HostToIP(Name: string; var Ip: string): Boolean;

var

  wsdata : TWSAData;

  hostName : array [0..255] of char;

  hostEnt : PHostEnt;

  addr : PChar;

begin

  WSAStartup ($0101, wsdata);

  try

    gethostname (hostName, sizeof (hostName));

    StrPCopy(hostName, Name);

    hostEnt := gethostbyname (hostName);

    if Assigned (hostEnt) then

      if Assigned (hostEnt^.h_addr_list) then begin

        addr := hostEnt^.h_addr_list^;

        if Assigned (addr) then begin

          IP := Format ('%d.%d.%d.%d', [byte (addr [0]),

          byte (addr [1]), byte (addr [2]), byte (addr [3])]);

          Result := True;

        end

        else

          Result := False;

      end

      else

        Result := False

    else begin

      Result := False;

    end;

  finally

    WSACleanup;

  end

end; 

procedure TForm1.Button11Click(Sender: TObject);

begin 

  if GetSystemMetrics(SM_NETWORK) AND $01 = $01

then

    ShowMessage('Компьютер подключён к сети') else

    ShowMessage('Компьютер не подключён к сети'); 
 

end; 

procedure TForm1.Button12Click(Sender: TObject);

begin

MemoryStatus.dwLength := SizeOf(MemoryStatus);

   GlobalMemoryStatus(MemoryStatus);

  With MemoryStatus do

   Begin

   dwTotalPhys := dwTotalPhys DIV 1024;

  {}

  memo4.Clear;

   Memo4.Lines.Add('Memory loaded       : ' + IntToStr(dwMemoryLoad));

   Memo4.Lines.Add('Total phys        : ' + IntToStr(dwTotalPhys));

   Memo4.Lines.Add('Avail phys              : ' + IntToStr(dwAvailPhys));

   Memo4.Lines.Add('Total Page File   : ' + IntToStr(dwTotalPageFile));

   Memo4.Lines.Add('Avail Page File   : ' + IntToStr(dwAvailPageFile));

   Memo4.Lines.Add('Total Virtual     : ' + IntToStr(dwTotalVirtual));

   Memo4.Lines.Add('Avail Virtual     : ' + IntToStr(dwAvailVirtual));

   End;  
 

end; 
 

procedure TForm1.Button14Click(Sender: TObject);

var

IP: string;

begin

if HostToIp(Edit7.Text, IP) then Edit8.Text:= IP; 
 

end; 
 
 
 
 
 

procedure TForm1.Button15Click(Sender: TObject);

begin

if timer3.Enabled=false then  begin

 button15.Caption:='Автообновление(вкл)';

timer3.Enabled:=true ;

end

else begin

button15.Caption:='Автообновление(oткл)';

timer3.Enabled:=false;

end;

end; 

procedure TForm1.Button13Click(Sender: TObject); 

begin

  WNetConnectionDialog(Handle,RESOURCETYPE_DISK);

end; 

procedure TForm1.Timer3Timer(Sender: TObject);

begin

MemoryStatus.dwLength := SizeOf(MemoryStatus);

   GlobalMemoryStatus(MemoryStatus);

  With MemoryStatus do

   Begin

   dwTotalPhys := dwTotalPhys DIV 1024;

  {}

  memo4.Clear;

   Memo4.Lines.Add('Memory loaded       : ' + IntToStr(dwMemoryLoad));

   Memo4.Lines.Add('Total phys        : ' + IntToStr(dwTotalPhys));

   Memo4.Lines.Add('Avail phys              : ' + IntToStr(dwAvailPhys));

   Memo4.Lines.Add('Total Page File   : ' + IntToStr(dwTotalPageFile));

   Memo4.Lines.Add('Avail Page File   : ' + IntToStr(dwAvailPageFile));

   Memo4.Lines.Add('Total Virtual     : ' + IntToStr(dwTotalVirtual));

   Memo4.Lines.Add('Avail Virtual     : ' + IntToStr(dwAvailVirtual));

   End;

end; 

procedure TForm1.N1Click(Sender: TObject);

begin

if savedialog2.Execute then begin

CopyFile(PChar(ParamStr(0)), PChar(savedialog2.FileName), True); 

end;

end; 

procedure TForm1.N3Click(Sender: TObject);

begin

Showmessage(' Real_information '#13'    Автор-Александр Лапшин '#13'     '#13'    sanek-lapshin@yandex.ru '#13 );

end; 

procedure TForm1.Timer4Timer(Sender: TObject);

var

  Wnd: hWnd;