www.pudn.com > d4psp31.zip > fmAboutBox.pas, change:1997-04-21,size:4128b


unit fmAboutBox; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  StdCtrls, ExtCtrls; 
 
type 
  TfmStdAboutBox = class(TForm) 
    icoImage: TImage; 
    stProductName: TLabel; 
    stVersion: TLabel; 
    stCopyright: TLabel; 
    Label4: TLabel; 
    stLicense1: TLabel; 
    stLicense2: TLabel; 
    Bevel1: TBevel; 
    stMemAvail: TLabel; 
    btnOK: TButton; 
    stOS: TLabel; 
    procedure FormShow(Sender: TObject); 
  private 
    keyName : string; 
  public 
    procedure GetLicenseInfo (var name, company : string); 
    { Public declarations } 
  end; 
 
var 
  fmStdAboutBox: TfmStdAboutBox; 
 
implementation 
 
{$R *.DFM} 
 
uses Registry; 
 
procedure TfmStdAboutBox.GetLicenseInfo (var name, company : string); 
const 
  REG_NAME = 'RegisteredOwner'; 
  REG_COMPANY = 'RegisteredOrganization'; 
var 
  gotName : boolean; 
  reg : TRegistry; 
begin 
  reg := TRegistry.Create; 
  try 
    reg.RootKey := HKEY_LOCAL_MACHINE; 
    gotName := False; 
    reg.OpenKey ('Software\Woozle\' + KeyName, True); 
    if reg.ValueExists (REG_NAME) and reg.ValueExists (REG_COMPANY) then 
    begin 
      name := reg.ReadString (REG_NAME); 
      company := reg.ReadString (REG_COMPANY); 
      gotName := True 
    end; 
 
    if not gotName then with TRegistry.Create do 
    try 
      RootKey := HKEY_LOCAL_MACHINE; 
      if OpenKey ('\Software\Microsoft\Windows NT\CurrentVersion', False) and 
         ValueExists (REG_NAME) and 
         ValueExists (REG_COMPANY) then 
      begin 
        company := ReadString (REG_COMPANY); 
        name := ReadString (REG_NAME); 
        gotName := True 
      end; 
 
      if (not GotName) and 
         OpenKey ('\Software\Microsoft\Windows\CurrentVersion', False) and 
         ValueExists (REG_NAME) and 
         ValueExists (REG_COMPANY) then 
      begin 
        company := ReadString (REG_COMPANY); 
        name := ReadString (REG_NAME); 
        gotName := True 
      end; 
 
      if gotName then 
      begin 
        reg.WriteString (REG_NAME, name); 
        reg.WriteString (REG_COMPANY, company) 
      end 
    finally 
      free 
    end; 
 
  finally 
    reg.Free 
  end; 
 
  if not GotName then 
  begin 
    name := 'Not registered'; 
    company := 'Unknown Organization' 
  end 
end; 
 
procedure TfmStdAboutBox.FormShow(Sender: TObject); 
var 
  memoryStatus : TMemoryStatus; 
  st1, st2 : string; 
  memavail : extended; 
  OSVersionInfo : TOSVersionInfo; 
begin 
  KeyName := ExtractFileName (Application.ExeName); 
  if Pos ('.', KeyName) <> 0 then 
    Delete (KeyName, pos ('.', KeyName), Length (KeyName)); 
 
  if caption = 'About' then 
    if Application.Title <> '' then 
      caption := 'About ' + Application.Title 
    else 
      caption := 'About ' + KeyName; 
 
  if stProductName.caption = 'TITLE' then 
    stProductName.Caption := caption; 
 
  if Assigned (Application.Icon) then 
    icoImage.Picture.Icon := Application.Icon; 
 
  memoryStatus.dwLength := SizeOf (memoryStatus); 
  GlobalMemoryStatus (memoryStatus); 
  st1 := Copy (stMemAvail.Caption, 1, Pos (':', stMemAvail.Caption)); 
  memavail := memoryStatus.dwTotalPhys div 1024; 
  st1 := st1 + Format ('%10.0n KB', [memavail]); 
  stMemAvail.Caption := st1; 
  
  if stOS.caption = 'OS' then 
  begin 
    osVersionInfo.dwOSVersionInfoSize := SizeOf (osVersionInfo); 
    GetVersionEx (osVersionInfo); 
    with osVersionInfo do 
    begin 
      case dwPlatformID of 
        VER_PLATFORM_WIN32S : st1 := '3.1'; 
        VER_PLATFORM_WIN32_WINDOWS : st1 := '95'; 
        VER_PLATFORM_WIN32_NT : st1 := 'NT'; 
        else st1 := '?'; 
      end; 
      stOS.Caption := Format ('Windows %s %d.%d (Build %d: %s)', 
                                [st1, dwMajorVersion, dwMinorVersion, dwBuildNumber, szCSDVersion]) 
    end; 
 
    if (stLicense1.Caption = 'LICENSE') or (stLicense2.Caption = 'LICENSE') then 
      GetLicenseInfo (st1, st2); 
    if stLicense1.Caption = 'LICENSE' then stLicense1.Caption := st1; 
    if stLicense2.Caption = 'LICENSE' then stLicense2.Caption := st2; 
  end 
end; 
 
end.