unit2.pas

用delphi编写的针对商品房销售合同格式

unit Unit2;

interface

uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, AAFont, AACtrls, jpeg, ExtCtrls, LbSpeedButton, Registry;

type
    TForm2 = class(TForm)
        Image1: TImage;
        Image2: TImage;
        AALabel9: TAALabel;
        AALabel2: TAALabel;
        AALabel1: TAALabel;
        AALabel3: TAALabel;
        LbSpeedButton5: TLbSpeedButton;
        LbSpeedButton6: TLbSpeedButton;
        LbSpeedButton8: TLbSpeedButton;
        Timer1: TTimer;
        procedure LbSpeedButton5Click(Sender: TObject);
        procedure LbSpeedButton6Click(Sender: TObject);
        procedure LbSpeedButton8Click(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure Timer1Timer(Sender: TObject);
    private

    public
        { Public declarations }
    end;
function CreateMutex: Boolean; // 全项目公用函数
procedure DestroyMutex; // 全项目公用函数

var
    Form2: TForm2;
    REG: TRegistry;
    Mutex: hWnd;
    X: Integer;
implementation
uses mainunit, REGUnit, SoftReg;
{$R *.dfm}

procedure DestroyMutex;
begin
    if Mutex <> 0 then
        CloseHandle(Mutex);
end;

function CreateMutex: Boolean;
var
    PrevInstHandle: THandle;
    AppTitle: PChar;
begin
    AppTitle := StrAlloc(100);
    StrPCopy(AppTitle, Application.Title);
    Result := True;
    Mutex := Windows.CreateMutex(nil, False, AppTitle);
    if (GetLastError = ERROR_ALREADY_EXISTS) or (Mutex = 0) then begin
        Result := False;
        SetWindowText(Application.Handle, '');
        PrevInstHandle := FindWindow(nil, AppTitle);
        if PrevInstHandle <> 0 then begin
            if IsIconic(PrevInstHandle) then
                ShowWindow(PrevInstHandle, SW_RESTORE)
            else
                BringWindowToTop(PrevInstHandle);
            SetForegroundWindow(PrevInstHandle);
        end;
        if Mutex <> 0 then
            Mutex := 0;
    end;
    StrDispose(AppTitle);
end;

procedure TForm2.LbSpeedButton5Click(Sender: TObject);
begin
    if Application.MessageBox('是否真的退出“商品房买卖合同套打程序”？', '询问'
        , MB_YESNO + MB_ICONQUESTION) = IDYES then
        Application.Terminate;

end;

procedure TForm2.LbSpeedButton6Click(Sender: TObject);
begin
    Form1 := TForm1.Create(self);
    form1.ShowModal;
end;

procedure TForm2.LbSpeedButton8Click(Sender: TObject);
begin
    if Assigned(RegSoftForm) then begin
        SetWindowPos(RegSoftForm.Handle, 0, 0, 0, 0, 0, swp_nomove +
            swp_nosize);
        Exit;
    end;
    RegSoftForm := TRegSoftForm.create(self);
    RegSoftForm.ShowModal;
end;

procedure TForm2.FormCreate(Sender: TObject);
var
    runs: Integer;
    bFirst: Boolean;
    sMcode, sNo, SReg: string;
    s: PChar;
begin
    runs := 5;
    Application.ProcessMessages;
    ////////////////////////////////////
    REG := TRegistry.Create;
    REG.RootKey := HKEY_LOCAL_MACHINE;
    bfirst := not reg.KeyExists('SOFTWARE\ABICO\HTPrinter');
    if bfirst then begin
        Application.MessageBox('你是第一次运行这个程序！你暂时只能使用5次！' + #13 +
            '如要继续使用请与安邦公司联系取得注册码并进行注册！',
            '提示', MB_OK + MB_ICONINFORMATION)
    end;
    REG.OpenKey('SOFTWARE\ABICO\HTPrinter', true);
    if bfirst then
        REG.WriteBinaryData('Runs', runs, SizeOf(runs))
    else begin
        REG.ReadBinaryData('runs', runs, SizeOf(runs));
        if runs > 0 then begin
            Application.MessageBox(PChar('你还能使用本软件' + inttostr(runs) + '次！' + #13 +
                '如要继续使用请与安邦公司联系取得注册码并进行注册！' + #13 +
                '联系电话：[phone]' + #13 +
                '电子邮箱：[e-mail]'),
                '提示', MB_OK + MB_ICONINFORMATION);
        end;
    end;
    runs := runs - 1;
    reg.WriteBinaryData('Runs', runs, SizeOf(runs));

    if runs < 0 then begin
        if REG.ValueExists('KEY_ID') then begin
            sMcode := REGUnit.GetMachineCode;
            SNO := REGUnit.GetSNFromMCode(SMCODE);
            SREG := REG.ReadString('KEY_ID');
            //  ShowMessage('SNO='+sNo+#13+'SREG='+SReg);
            if sNo = SREG then begin
                LbSpeedButton6.Visible := TRUE;
                LbSpeedButton8.Visible := FALSE;
                REG.FREE;
                Exit;
            end;
        end; 

        Application.MessageBox('软件已超出使用次数！' + #13 +
            '如要继续使用请与安邦公司联系取得注册码并进行注册！' + #13 +
            '联系电话：[phone]' + #13 +
            '电子邮箱：[e-mail]',
            '警告', MB_OK + MB_ICONERROR);
        LbSpeedButton6.Visible := False;
        LbSpeedButton8.Visible := TRUE;
    end
    else begin

        LbSpeedButton6.Visible := TRUE;
        LbSpeedButton8.Visible := TRUE;
    end;

    REG.FREE;

end;

procedure TForm2.Timer1Timer(Sender: TObject);
    procedure ClearMemory;
    begin
        if Win32Platform = VER_PLATFORM_WIN32_NT then begin
            SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);
            application.ProcessMessages;
        end;
    end;

begin
    ClearMemory;
end;

end.