about.pas

通过程序的试算平衡表

unit about;

interface

uses Windows, Classes, Graphics, SysUtils, Forms, Controls, StdCtrls,
  Buttons, ExtCtrls, GetCPUID, BiosHelp, md5, xpGroupBox;

type
  TAboutBox = class(TForm)
    xpGroupBox1: TxpGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    STextSoftName: TStaticText;
    STextSoftVer: TStaticText;
    STextRegNo: TStaticText;
    ButtonRegster: TButton;
    ButtonClose: TButton;
    Label4: TLabel;
    STextUserInfo: TStaticText;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    STextSystem: TStaticText;
    STextMen: TStaticText;
    procedure ButtonCloseClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ButtonRegsterClick(Sender: TObject);
  private
   s:string;
//   Procedure Delay(x,y:word);//延时程序
    Function GetMachineCode: String;
   function GetFileVer():string;
   procedure GetOSInfo; //系统信息程序
   Procedure GetMemoryInfo ; //可用资源程序
    { Private declarations }
  public
    { Public declarations }
  end;

var
  AboutBox: TAboutBox;

implementation

uses SoftReg;

{$R *.dfm}
function TAboutBox.GetFileVer():string;
var
  VerInfoSize: DWORD;
  VerInfo: Pointer;
  VerValueSize: DWORD;
  VerValue: PVSFixedFileInfo;
  Dummy: DWORD;
  V1, V2, V3, V4: Word;
begin
  VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), Dummy);
  if VerInfoSize = 0 then begin
    Dummy := GetLastError;
    Result := '0.0.0.0';
  end; {if}
  GetMem(VerInfo, VerInfoSize);
  GetFileVersionInfo(PChar(ParamStr(0)), 0, VerInfoSize, VerInfo);
  VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
  with VerValue^ do begin
    V1 := dwFileVersionMS shr 16;
    V2 := dwFileVersionMS and $FFFF;
    V3 := dwFileVersionLS shr 16;
    V4 := dwFileVersionLS and $FFFF;
  end;
  Result := IntToStr(V1) + '.'
    + IntToStr(V2) + '.'
    + IntToStr(V3) + '.'
    + IntToStr(V4);
  FreeMem(VerInfo, VerInfoSize);
end;


Procedure TAboutBox.GetMemoryInfo ;//可用资源
var
MS: TMemoryStatus;
begin
    MS.dwLength := SizeOf(TMemoryStatus);
    GlobalMemoryStatus(MS);
    STextMen.Caption := FormatFloat('#,###" KB"', MS.dwTotalPhys div 1024);
end;

procedure TAboutBox.GetOSInfo; //获取系统信息
var
   Platform: string;
   BuildNumber: Integer;
begin
   case Win32Platform of
      VER_PLATFORM_WIN32_WINDOWS:
      begin
         if (Win32MajorVersion=4) and (Win32MinorVersion=10) then
            Platform :='Windows 98'
         else
            Platform := 'Windows 95';
         BuildNumber := Win32BuildNumber and $0000FFFF;
      end;
      VER_PLATFORM_WIN32_NT:
      begin
         if (Win32MajorVersion=5) and (Win32MinorVersion=0) then
            Platform := 'Windows 2000'
         else if (Win32MajorVersion=5) and (Win32MinorVersion=1) then
            Platform := 'Windows XP'
         else if (Win32MajorVersion=5) and (Win32MinorVersion=2) then
            Platform := 'Windows 2003'
         else if (Win32MajorVersion=4) and (Win32MinorVersion=0) then
            Platform := 'Windows NT 4.0'
         else
            Platform := 'Windows NT'; 
         BuildNumber := Win32BuildNumber;
      end;
      else
      begin
         Platform := 'Windows';
         BuildNumber := 0;
      end;
   end;
   if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) or
      (Win32Platform = VER_PLATFORM_WIN32_NT) then
   begin
      if Win32CSDVersion = '' then
         STextSystem.Caption := Format('%s 版本 %d.%d （内部版本 %d）', [Platform, Win32MajorVersion,
            Win32MinorVersion, BuildNumber])
      else
         STextSystem.Caption := Format('%s 版本 %d.%d （内部版本 %d: %s）', [Platform, Win32MajorVersion,
            Win32MinorVersion, BuildNumber, Win32CSDVersion]);
   end
   else
      STextSystem.Caption := Format('%s %d.%d', [Platform, Win32MajorVersion,
      Win32MinorVersion])
   end;

procedure TAboutBox.ButtonCloseClick(Sender: TObject);
begin
    Close;
end;

procedure TAboutBox.FormCreate(Sender: TObject);
begin
    try
      self.Caption := application.Title + ' - ';
      self.Caption := self.caption+'关于本软件';
      STextSoftName.Caption := Application.Title;
      STextSoftVer.Caption := GetFileVer;
      STextRegNo.Caption := GetMachineCode;
      ////初始化---------------------------
      GetMemoryInfo;
      GetOsinfo;
      //初始化变量s...
      s:='';
   except
      MessageBox(handle,'在提取系统信息时某些信息不能取得','提示',MB_OK);
   end;
end;

procedure TAboutBox.ButtonRegsterClick(Sender: TObject);
begin
    FmSoftReg.ShowModal;
end;

Function TAboutBox.GetMachineCode: String;
Var
   ID1, ID2         : String;
Begin
   ID1 := GetCPUID.CpuData.GetCPUID;
   ID2 := BiosHelp.GetmotherboradKey;
   result := Copy(MD5Print(MD5String(ID1 + ID2)), 0, 8);
End;

end.