uabout.pas

可实现学生成绩管理系统的各种功能,无需登陆,直接查询学生的各种信息

unit uAbout;

interface

uses
  Windows,  Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Winsock, registry;

type
  TfrmAbout = class(TForm)
    lblTitle: TLabel;
    lblCopyright1: TLabel;
    BevelAbout2: TBevel;
    lblAvailMem1: TLabel;
    cmdAbout: TButton;
    lblAvailMem: TLabel;
    lblDeveloper: TLabel;
    lblCopyright2: TLabel;
    lblTotalMem1: TLabel;
    lblTotalMem: TLabel;
    imgZlIcon: TImage;
    lblIpAddr1: TLabel;
    BevelAbout1: TBevel;
    lblIpAddr: TLabel;
    lblOperSys: TLabel;
    blHostName1: TLabel;
    lblHostName: TLabel;
    lblOperSys1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure cmdAboutClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure imgZlIconMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  end;

var
  frmAbout: TfrmAbout;

implementation

{$R *.DFM}

// 取得本机 IP 地址
function LocalIP : string;
type
    TaPInAddr = array [0..10] of PInAddr;
    PaPInAddr = ^TaPInAddr;
var
    phe  : PHostEnt;
    pptr : PaPInAddr;
    Buffer : array [0..63] of char;
    I    : Integer;
    GInitData      : TWSADATA;

begin
    WSAStartup($101, GInitData);
    Result := '';
    GetHostName(Buffer, SizeOf(Buffer));
    phe :=GetHostByName(buffer);
    if phe = nil then Exit;
    pptr := PaPInAddr(Phe^.h_addr_list);
    I := 0;
    while pptr^[I] <> nil do begin
      result:=StrPas(inet_ntoa(pptr^[I]^));
      Inc(I);
    end;
    WSACleanup;
end;

// 取得用户名称
function GetUserName: AnsiString;
var
  lpName: PAnsiChar;
  lpUserName: PAnsiChar;
  lpnLength: DWORD;

begin
  Result := '';
  lpName := '';
  lpnLength := 0;
  WNetGetUser(nil, nil, lpnLength); // 取得字串长度
  if lpnLength > 0 then
    begin
      GetMem(lpUserName, lpnLength);
      if WNetGetUser(lpName, lpUserName, lpnLength) = NO_ERROR then
        Result := lpUserName;
      FreeMem(lpUserName, lpnLength);
  end;
end; { GetUserName }

// 取得 Windows 产品版本
function GetWindowsVer: string;
  var
    reg: TRegistry;

begin
  Result := '';
  reg := TRegistry.Create;

  with reg do
  begin
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKey('Software\Microsoft\Windows\CurrentVersion', False);
    Result := ReadString('Version');   // 取 Windows 的产品版本
    Free;
  end;

  if Length(Result) = 0 then
    begin
      reg := TRegistry.Create;
      with reg do
      begin
        RootKey := HKEY_LOCAL_MACHINE;
        OpenKey('Software\Microsoft\Windows NT\CurrentVersion', False);
        Result := ReadString('ProductName');   // 取 Windows NT 的产品版本
        Free;
      end;
    end;
end;

// 取得 Windows 产品版本号
function GetWindowsVerNum: string;
  var
    reg: TRegistry;

begin
  Result := '';
  reg := TRegistry.Create;

  with reg do
  begin
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKey('Software\Microsoft\Windows\CurrentVersion', False);
    Result := ReadString('VersionNumber');   // 取 Windows 的版本号
  end;
  reg.Free;
end;



procedure TfrmAbout.FormCreate(Sender: TObject);
var
  MemStat: TMemoryStatus;
  x1,x2: Integer;
begin
  GlobalMemoryStatus(MemStat);
  x1:=MemStat.dwTotalPhys div 1024;
  x2:=MemStat.dwAvailPhys div 1024;
  lblTotalMem.Caption:=FormatFloat('#,###0'' KB''',x1);
  lblAvailMem.Caption:=FormatFloat('#,###0'' KB''',x2);

  lblIpAddr.Caption   := LocalIP;
  lblHostName.Caption := GetUserName;
  lblOperSys.Caption   := GetWindowsVer;
  lblOperSys.Caption   := lblOperSys.Caption + ' ' + GetWindowsVerNum;
end;

procedure TfrmAbout.cmdAboutClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmAbout.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=caFree;
end;

procedure TfrmAbout.imgZlIconMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (Button=mbLeft) and (ssShift in Shift) then
     lblDeveloper.Visible:=not lblDeveloper.Visible;
end;

end.