dialog_about.pas

EXELOCK 1.83 EXE文件加密器的源代码

{
          通用关于界面 版权所有 2001

      -'`"_         -'`" \
     /     \       /      "
    /     /\\__   /  ___   \       西安科技学院143信箱 710054
   |      | \  -"`.-(   \   |
   |      |  |     | \"  |  |                万  重
   |     /  /  "-"  \  \    |
    \___/  /  (o o)  \  (__/       电邮: [e-mail]
         __| _     _ |__
        (      ( )      )          网址: http://mantousoft.51.net
         \_\.-.___.-./_/
           __  | |  __             QQ  : 6036742
          |  \.| |./  |
          | '#.   .#' |
          |__/ '"" \__|                     2001.3.1
        -/             \-
}

unit dialog_about;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Buttons, StdCtrls, ShellAPI, TFlatButtonUnit;

type
  Tfrm_about = class(TForm)
    ProductName: TLabel;
    ProgramIcon: TImage;
    Copyright: TLabel;
    Version: TLabel;
    lblOs: TLabel;
    lblMemory: TLabel;
    lb_email: TLabel;
    lb_HomePage: TLabel;
    homepage: TLabel;
    email: TLabel;
    FlatButton1: TFlatButton;
    procedure FormCreate(Sender: TObject);
    procedure emailClick(Sender: TObject);
    procedure homepageClick(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FlatButton1Click(Sender: TObject);
  private
    procedure GetOSInfo;
    procedure GetMemoryInfo ;
    procedure GetBuildInfo;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frm_about: Tfrm_about;

implementation

{$R *.DFM}

procedure Tfrm_About.GetBuildInfo;
var
  V1,V2,V3,V4: Word;
  VerInfoSize: DWORD;
  VerInfo: Pointer;
  VerValueSize: DWORD;
  VerValue: PVSFixedFileInfo;
  Dummy: DWORD;
begin
  VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), Dummy);
  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;
  FreeMem(VerInfo, VerInfoSize);
  Version.Caption:=Version.Caption +'1.21 '+Format('(Build %d%d%d%d)',[v1,v2,v3,v4]);
end;

procedure Tfrm_About.GetMemoryInfo ;
var
  MS: TMemoryStatus;
begin
  MS.dwLength:=SizeOf(TMemoryStatus);
  GlobalMemoryStatus(MS);
  lblMemory.Caption:=lblMemory.Caption +FormatFloat('#,###" KB"',MS.dwTotalPhys div 1024);
end;

procedure Tfrm_About.GetOSInfo;
var
  Platform: string;
  BuildNumber: Integer;
begin
  case Win32Platform of
  VER_PLATFORM_WIN32_WINDOWS:
    begin
      Platform := 'Windows 95';
      BuildNumber := Win32BuildNumber and $0000FFFF;
    end;
  VER_PLATFORM_WIN32_NT:
    begin
      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 lblOS.Caption := lblOS.Caption+Format('%s %d.%d (Build %d)',[Platform,Win32MajorVersion,Win32MinorVersion,BuildNumber])
    else lblOS.Caption := lblOS.Caption+Format('%s %d.%d (Build %d: %s)',[Platform,Win32MajorVersion,Win32MinorVersion, BuildNumber,Win32CSDVersion]);
  end else lblOS.Caption := lblOS.Caption+Format('%s %d.%d', [Platform,Win32MajorVersion,Win32MinorVersion])
end;

procedure Tfrm_about.FormCreate(Sender: TObject);
var
  R : HRgn;
begin
  R :=CreateRoundRectRgn(0,0,Width,Height,5,5);
  SetWindowRgn(Handle,R,True);
  {begin about infomation}
  try
    Caption:='关于['+application.Title+']';                    //title
    ProgramIcon.Picture.icon:=Application.Icon;                //icon
    ProductName.Caption:=ProductName.Caption+Application.Title;//name
    GetBuildInfo;                                              //version
    Copyright.Caption:=Copyright.Caption+'中国-西安-孜孜软件';
    GetMemoryInfo;
    GetOsinfo;
  except
    MessageBox(handle,'某些信息不能取得','提示',MB_OK);
  end;
  {end about infomation}
end;

procedure Tfrm_about.emailClick(Sender: TObject);
begin
  ShellExecute(Self.Handle,'Open',PChar('mailto:[e-mail]?Subject=关于EXE文件加密器'),nil,nil,1);
//  ShellExecute(Self.Handle,'Open',PChar('http://mantousoft.51.net/myemail/myemail.php'),nil,nil, 1);
end;

procedure Tfrm_about.homepageClick(Sender: TObject);
begin
  ShellExecute(Self.Handle,'Open',PChar('http://mantousoft.51.net'),nil,nil,1);
end;

procedure Tfrm_about.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  SendMessage(Handle, WM_SYSCOMMAND, $F012, 0);
end;

procedure Tfrm_about.FormPaint(Sender: TObject);
begin
  {begin draw}
  Canvas.Pen.Color:=$00555E66;
  Canvas.Pen.Width:=10;
  Canvas.RoundRect(0,0,Width,Height,5,5);
  Canvas.Pen.Color:=$00996633;
  Canvas.Pen.Width:=2;
  Canvas.PenPos:=Point(15,110);
  Canvas.LineTo(Width-15,110);
  {draw over}
end;

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

procedure Tfrm_about.FlatButton1Click(Sender: TObject);
begin
  Close;
end;

end.