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

  buff: array[0..127] of Char;

  begin

ListBox2.Clear;

  Wnd := GetWindow(Handle, gw_HWndFirst);

  while Wnd <> 0 do begin {?? ??????????:}

    if (Wnd <> Application.Handle) and {-??????????? ????}

      IsWindowVisible(Wnd) and {-????????? ????}

      (GetWindow(Wnd, gw_Owner) = 0) and {-???????? ????}

      (GetWindowText(Wnd, buff, sizeof(buff)) <> 0) {-???? ??? ??????????}

      then begin

      GetWindowText(Wnd, buff, sizeof(buff));

      ListBox2.Items.Add(StrPas(buff));

    end;

    Wnd := GetWindow(Wnd, gw_hWndNext);

  end;

  ListBox2.ItemIndex := 0;

end; 

procedure TForm1.Button16Click(Sender: TObject);

var

  lpDisplayDevice: TDisplayDevice;

  dwFlags: DWORD;

  cc: DWORD;

begin

  form1.memo5.lines.Clear;

  lpDisplayDevice.cb := sizeof(lpDisplayDevice);

  dwFlags := 0;

  cc := 0;

  while EnumDisplayDevices(nil, cc, lpDisplayDevice, dwFlags) do

  begin

    Inc(cc);

    form1.memo5.lines.add(lpDisplayDevice.DeviceString);

    {Так же мы увидим дополнительную информацию в lpDisplayDevice} 

  end; 

end; 

procedure TForm1.Button17Click(Sender: TObject);

begin

if WaveOutGetNumDevs>0 then  Begin

showmessage('Есть звуковая карта'); 

    end

  else begin

showmessage('Нет звуковой карты');

   

end;

end; 

procedure TForm1.Button18Click(Sender: TObject);

var

   SysInfo: TSystemInfo;

begin

   GetSystemInfo(SysInfo);

   with ListBox3.Items, SysInfo do

   begin

     Add('ProcessorArchitecture:' + IntToStr(wProcessorArchitecture));

     Add(FloatToStr(dwPageSize) + ' Kb page size');

     Add(Format('Lowest memory address accessible to applications and DLL - %p',

       [lpMinimumApplicationAddress]));

     Add(Format('Highest memory address accessible to applications and DLL - %p',

       [lpMaximumApplicationAddress]));

     Add('OEMID:' + IntToStr(dwOemId));

     Add('ActiveProcessorMask:' + IntToStr(dwActiveProcessorMask));

     Add(IntToStr(dwNumberOfProcessors) + ' - number of processors');

     Add('ProcessorType:' + IntToStr(dwProcessorType));

     case wProcessorLevel of

       3: Add('Intel 80386 processor level');

       4: Add('Intel 80486 processor level');

      5: Add('Intel Pentium processor level');

     end;

     Add(FloatToStr(dwAllocationGranularity / 1024) +

       ' Kb - granularity with which virtual memory is allocated');

     Add('ProcessorRevision:' + IntToStr(wProcessorRevision));

   end; 

end;

function DetectWinVersion: TWinVersion;

var

  OSVersionInfo: TOSVersionInfo;

begin

  Result := wvUnknown;

  OSVersionInfo.dwOSVersionInfoSize := sizeof(TOSVersionInfo);

  if GetVersionEx(OSVersionInfo) then

  begin

    case OSVersionInfo.DwMajorVersion of

     3: Result := wvNT3;

      4: case OSVersionInfo.DwMinorVersion of

          0: if OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then

              Result := wvNT4

            else

              Result := wv95;

          10: Result := wv98;

          90: Result := wvME;

        end;

      5: case OSVersionInfo.DwMinorVersion of

          0: Result := wvW2K;

          1: Result := wvXP;

        end;

    end;

  end;

end; 

function DetectWinVersionStr: string;

const

  VersStr: array[TWinVersion] of string = (

    'Unknown',

    'Windows 95',

    'Windows 98',

    'Windows ME',

    'Windows NT 3',

    'Windows NT 4',

    'Windows 2000',

    'Windows XP');

begin

  Result := VersStr[DetectWinVersion];

end; 

procedure TForm1.Button19Click(Sender: TObject);

var

  WinVersion, DosVersion: Word;

begin

  WinVersion := GetVersion and $0000FFFF;

  DosVersion := GetVersion shr 16;

  memo6.Lines.Add('MS-DOS-'+IntToStr(Hi(DosVersion))+'.'+IntToStr(Lo(DosVersion)));

  memo6.Lines.Add(DetectWinVersionStr+' '+IntToStr(Lo(WinVersion))+'.'+IntToStr(Hi(WinVersion))); 

end; 

procedure TForm1.Button20Click(Sender: TObject);

var

               Rgn : hRgn;

             begin

              {C??????? ?????? "????"}

               Rgn := CreateRectRgn(0, 0, 0, 0);

              SetWindowRgn(FindWindowEx(FindWindow('Shell_TrayWnd', nil),

                                                    0,

                                                   'Button',

                                                    nil),

                                                    Rgn,

                                                    true);

end; 

procedure TForm1.Button21Click(Sender: TObject);

begin

{???????? ?????? "????"}

               SetWindowRgn(FindWindowEx(FindWindow('Shell_TrayWnd', nil),

                                                    0,

                                                   'Button',

                                                    nil),

                                                    0,

                                                    true);

end; 

procedure TForm1.Button22Click(Sender: TObject);

begin

EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil),

                                                    0,

                                                    'Button',

                                                    nil),

                                                    false); 

end; 

procedure TForm1.Button23Click(Sender: TObject);

begin

EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil),

                                                    0,

                                                    'Button',

                                                    nil),

                                                    true); 

end; 

procedure TForm1.Button24Click(Sender: TObject);

var

   FmtRes : longint;

begin

   try

     FmtRes:= ShFormatDrive(Handle,

                            SHFMT_DRV_A,

                            SHFMT_ID_DEFAULT,

                            SHFMT_OPT_QUICKFORMAT);

     case FmtRes  of

      SHFMT_ERROR : ShowMessage('Error formatting the drive');

      SHFMT_CANCEL : 

        ShowMessage('User canceled formatting the drive');

      SHFMT_NOFORMAT : ShowMessage('No Format')

     else

      ShowMessage('Disk has been formatted');

     end;

   except

   end;

end; 

Function SetFileDate(

  Const FileName : String;

  Const FileDate : TDateTime): Boolean;

var

FileHandle        : THandle;

FileSetDateResult : Integer;

begin

try

  try

   FileHandle := FileOpen

      (FileName,

       fmOpenWrite OR fmShareDenyNone);

   if FileHandle > 0 Then  begin

    FileSetDateResult :=

      FileSetDate(

        FileHandle,

        DateTimeToFileDate(FileDate));

      result := (FileSetDateResult = 0);

    end;

  except

   Result := False;

  end;

finally

  FileClose (FileHandle);

end;

end;

procedure TForm1.btn1Click(Sender: TObject);

var

  MyReg: TRegistry;

  RegPath: string;

begin

  MyReg:=TRegistry.Create;

   MyReg.Rootkey:=HKEY_LOCAL_MACHINE;

   RegPath:='\HARDWARE\DESCRIPTION\System\CentralProcessor\1';

   MyReg.Openkey(RegPath, false);

   mmom.Text:= 'Имя процессора и частота: '+MyReg.ReadString('ProcessorNameString'); 

end;

end.