Отправляет email-рассылки с помощью сервиса Sendsay
  Все выпуски  

Мастера DELPHI. Новости мира компонент, FAQ, статьи...


Служба Рассылок Subscribe.Ru
Ежедневная рассылка сайта Мастера DELPHI

DELPHI.mastak.ru

Выпуск от 08.01.02 09:04

Вышел очередной дайджест форумов. Скачать можно здесь

Рекомедуем посетить:
Programming K-Station: http://pks.mari-el.ru
"Сайт о компьютерах и ПО. Ежедневно обновляемые новости из мира компьютеров, документации, FAQ's, статьи, интервью и другое... Для компьютерщиков PKS будет очень интересен."

Новая статья от Андрея Попкова "Свои настройки Proxy в программе с TWebBrowser"
Маленькая рекомендация тем, кто хочет реализовать возможность работы TWebBrowser в своей программе с настройками Proxy , которые отличаются от стандартных.
Лучшее из нашего FAQ   |x|
Как получить информацию о БИОСе?
Вот пример как можно даты БИОС материнской платы и видеокарты выдрать.
То же самое можно с названием производителя и версией.
В WinNT приходится читать не из ПЗУ а из реестра но это достаточно надежно
- соотв ключи WinNT закрывает на запись и обновляет при каждом старте (?).
Для Win9x можешь хоть весь БИОС напрямую читать.

   Получить заводской номер винчестера (не тот что getvolumeinfo дает) ИМХО
невозможно - порты IDE даже Win9x блокирует.

type
TRegistryRO = class (TRegistry)
  function OpenKeyRO (const Key: string): Boolean;
 end;
{ это уже ветхая история - был один глюк у D3}

implementation

uses WAPIInfo, Windows, SysUtils, StrUtils;

function TRegistryRO.OpenKeyRO (const Key: string): Boolean;
function IsRelative(const Value: string): Boolean;
 begin Result := not ((Value <> '') and (Value[1] = '\')) end;
var
 TempKey: HKey;
 S: string;
 Relative: Boolean;
begin
 S := Key;
 Relative := IsRelative(S);
 if not Relative then Delete(S, 1, 1);
 TempKey := 0;
   Result := RegOpenKeyEx(GetBaseKey(Relative), PChar(S), 0,
     KEY_READ, TempKey) = ERROR_SUCCESS;
  if Result then begin
    if (CurrentKey <> 0) and Relative then S := CurrentPath + '\' + S;
    ChangeKey(TempKey, S);
   end;
end;

function GetBIOSDate : string;
const
 BIOSDatePtr = $0ffff5;
 SystemKey = 'HARDWARE\DESCRIPTION\System';
 BiosDateParam = 'SystemBiosDate';
var
 p : pointer;
 s : string[128];
begin
 if OSisNT then begin
    with TRegistryRO.Create do try
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKeyRO (SystemKey) then begin
        s := ReadString (BiosDateParam);
       end;
      finally Free;
     end; { of try}
   end
  else try
     s[0] := #8;
     p := Pointer(BIOSDatePtr);
     Move (p^, s[1], 8);
    except FillChar (s[1], 8, '9');
   end; { of try}
 Result := copy (s, 1, 2) + copy (s, 4, 2) + copy (s, 7, 2);
end;

function GetVideoDate : string;
const
 VideoDatePtr = $0C0000;
 SystemKey = 'HARDWARE\DESCRIPTION\System';
 VideoDateParam = 'VideoBiosDate';
var
 p : pointer;
 s : string[255];
begin
 if OSisNT then begin
    with TRegistryRO.Create do try
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKeyRO (SystemKey)
       then s := ReadString (VideoDateParam)
       else s := 'NT/de/tected';
      finally Free;
     end; { of try}
   end
  else try
     s[0] := #255;
     p := Pointer(VideoDatePtr + 60); { первые $60 - строка CopyRight}
     Move (p^, s[1], 255);
     if pos('/', s) > 2 then s := copy (s, pos('/', s) - 2, 8)
      else begin
        p := Pointer! (VideoDatePtr + 60 + 250);
        Move (p^, s[1], 255);
        if pos('/', s) > 2 then s := copy (s, pos('/', s) - 2, 8);
       end;
    except FillChar (s[1], 8, '9');
   end; { of try}
 Result := copy (s, 1, 2) + copy (s, 4, 2) + copy (s, 7, 2);
end;

unit WAPIInfo;

interface

uses Registry, SysUtils, Windows;

procedure GetOSVerInfo (var OSID : DWORD; var OSStr : string);
function OSisNT : boolean;
procedure GetCPUInfo (var CPUID : DWORD; var CPUStr : string);
procedure GetMemInfo (var MemStr : string);

implementation

procedure GetOSVerInfo (var OSID : DWORD; var OSStr : string);
var
 OSVerInfo : TOSVersionInfo;
 Reg : TRegistry;
 s : string;
begin
 OSVerInfo.dwOSVersionInfoSize := SizeOf (OSVerInfo);
 GetVersionEx (OSVerInfo);
 OSID := OSVerInfo.dwPlatformID;
 case OSID of
   VER_PLATFORM_WIN32S : OSStr := 'Windows 3+';
   VER_PLATFORM_WIN32_WINDOWS : OSStr := 'Windows 95+';
   VER_PLATFORM_WIN32_NT : begin
     OSStr := 'Windows NT';
     Reg := TRegistry.Create;
     Reg.RootKey := HKEY_LOCAL_MACHINE;
     if Reg.OpenKey ('SYSTEM\CurrentControlSet\Control\', False)
       then try
        s := Reg.ReadString ('ProductOptions')
       except s := ''
      end;
     if s = 'WINNT' then OSStr := OSStr + ' WorkStation'
     else if s = 'SERVERNT' then OSStr := OSStr + ' Server 3.5 & hi'
     else if s = 'LANMANNT' then OSStr := OSStr + ' Advanced server 3.1';
     Reg.Free;
    end;
  end;
 with OSVerInfo do OSStr := OSStr + Format (' %d.%d (выпуск %d)',
  [dwMajorVersion, dwMinorVersion, LoWord(dwBuildNumber)]);
end;

function OSisNT : boolean;
var
 s : string;
 i : DWORD;
begin
 GetOSVerInfo (i, s);
 Result := (i = VER_PLATFORM_WIN32_NT);
end;

procedure GetCPUInfo (var CPUID : DWORD; var CPUStr : string);
var SI : TSystemInfo;
begin
 GetSystemInfo (SI);
 CPUID := SI.dwProcessorType;
 case CPUID of
   386: CPUStr := '80386-совместимый процессор';
   486: CPUStr := '80486-совместимый процессор';
   586: CPUStr := 'Pentium-совместимый процессор';
   else CPUStr := 'Неизвестный процессор';
  end;
{  case SI.wProcessorArchitecture of
   PROCESSOR_ARCHITECTURE_INTEL: ;
   MIPS
   ALPHA
   PPC
   UNKNOWN
  end;}
end;

procedure GetMemInfo (var MemStr : string);
var MemInfo : TMemoryStatus;
begin
 MemInfo.dwLength := SizeOf (MemInfo);
 GlobalMemoryStatus (MemInfo);
 with MemInfo do MemStr := Format ('ОЗУ: %0.2f M (свободно %0.2f M)'#$d+
  ' Файл подкачки: %0.2f M (свободно: %0.2f M)'#$d,
  [(dwTotalPhys div 1024) / 1024,
   (dwAvailPhys div 1024) / 1024,
   (dwTotalPageFile div 1024) / 1024,
   (dwAvailPageFile div 1024) / 10! 24]);
end;

end.

PS Возможно, эти процедуры не всегда дату возвращают ;)
но то что практически всегда для разных материнских/видео
плат возвращаются разные значения - проверено, что мне
собственно и требовалось.

Andrey Sorokin from sunny ;) Saint-Petersburg anso@mail.ru
Russian Technology http://attend.to/rt anso@rt.spb.ru

»»» Прислать свои комментарии

Обсуждается в конференциях   |x|
У нас большой выбор статей   |x|
Свои настройки Proxy в программе с TWebBrowser.
Маленькая рекомендация тем, кто хочет реализовать возможность работы TWebBrowser в своей программе с настройками Proxy , которые отличаются от стандартных.
Новинки книжного рынка   |x|
Delphi 5: учебный курс
В книге рассмотрены возможности системы программирования Delphi 5, описан язык программирования Object Pascal, рассмотрены визуальные компоненты системы и методы их создания. Особое внимание уделено принципам и практическим приемам создания сетевых приложений для разных архитектур и разработке программ, поддерживающих основные протоколы Интернета.Не требует специальной подготовки, может быть использована как пособие для изучающих основы программирования и сетевые технологии, а также как справочник по компонентам Delphi и пособие для самообразования.
Автор: С. Бобровский
Другие сайты о DELPHI   |x|
Delphi & DirectX (rus)
Программирование на Делфи при помощи DirectX, WinApi, OpenGl and so one. Имеется конференция для программистов
Опрос населения :)
Стоит ли сделать англоязычную версию этого сайта?
»»» Да
»»» Нет
Журнал "RSDN Magazine"  |x|

Дорогие друзья! Мы рады представить вам новый совместный проект сайтов www.rsdn.ru, delphi.mastak.ru и www.optim.ru - профессиональный журнал для программистов RSDN Magazine.
Несомненно, ваше мнение о необходимости такого журнала, содержании рубрик и темах отдельных статей поможет сделать журнал более полезным и интересным. Высказать свое мнение, проголосовать или же подписаться вы можете на сайте. Без вашего участия, нам будет трудно сделать правильный журнал!

Для души

Хокку дня
Сижу на веранде
в шортах -
огни машин сквозь дождь.

Афоризмы
Расизм - это снобизм бедняков... (Арон)

Фраза дня
Творите о себе мифы. Боги начинали именно так.

И на закуску коротенький анекдот
Почтальон подходит к калитке и видит табличку: "ОСТОРОЖНО, СОБАКА! " Посмотрев вглубь и не увидев никакой собаки, он входит и тут же слышит собачий вой. Тут из дома выходит хозяин и орет:
- Ну, вы что все, читать разучились, что ли? Ты сегодня уже третий, кто на собаку наступил!

Фотоприколы.
Начните день с хорошего настроения!
http://delphi.mastak.ru/cgi-bin/prikol.pl?id=19878


На этом позвольте откланяться и пожелать вам удачного дня.
Искренне ваш, Алексей (delphi@mastak.com)

Добро пожаловать на сайт -= Мастера DELPHI =- 


http://subscribe.ru/
E-mail: ask@subscribe.ru
Отписаться
Убрать рекламу

В избранное