mainform_form.pas

Delphi三层原代码掩饰及补丁

{-----------------------------------------------------------------------------
  Unit: MainForm_form
  Author:    Aleyn.wu
  Date:      2002-05-12
  Descript: Server Application Monitor
-----------------------------------------------------------------------------}

unit MainForm_form;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Forms, Dialogs, hmOleVariant,
  ADODB, DB, Menus, HMTrayIcon, Controls, StdCtrls, ImgList, Buttons,
  ComCtrls, dmBaseModule, dmBaseService, hmIniTools, hmUniKey, ExtCtrls;
type
  TfrmDataServer = class(TForm)
    TrayIcon: THMTrayIcon;
    TrayMenu: TPopupMenu;
    mnShowHideWindow: TMenuItem;
    mnExitSystem: TMenuItem;
    N1: TMenuItem;
    mnShowDebug: TMenuItem;
    N2: TMenuItem;
    mnClearDebug: TMenuItem;
    ImageList1: TImageList;
    btnStart: TSpeedButton;
    btnPause: TSpeedButton;
    btnStop: TSpeedButton;
    Edit1: TEdit;
    Label1: TLabel;
    lblStart: TLabel;
    lblPause: TLabel;
    lblStop: TLabel;
    StatusBar1: TStatusBar;
    chkAutoStart: TCheckBox;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure mnExitSystemClick(Sender: TObject);
    procedure TrayIconDblClick(Sender: TObject);
    procedure mnShowDebugClick(Sender: TObject);
    procedure mnClearDebugClick(Sender: TObject);
    procedure StartServer1Click(Sender: TObject);
    procedure StopServer1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    FDefaultDataBase: string;
    CanQuit: Boolean;
    FConnectionString: string;
    FIniFile: THMIniFile;
    FSqlLngDB: string;
    procedure SetSqlLngDB(const Value: string);
  protected
    procedure WMQUIT(var Message: TMessage); message WM_Quit;
    procedure StartService;
    procedure PauseService;
    procedure StopService;
  public
    property DafaultDataBase: string read FDefaultDataBase;
    property ConnectionString: string read FConnectionString;
    property IniFile: THMIniFile read FIniFile;
    property SqlLngDB:string read FSqlLngDB write SetSqlLngDB;
  end;

var
  frmDataServer: TfrmDataServer;
  ServiceState: TServiceState;

implementation

uses dmSystemService;

{$R *.dfm}

{ TfrmDataServer }

procedure TfrmDataServer.FormCreate(Sender: TObject);
begin
  try
    dmSysService := TdmSysService.Create(Application);
    FIniFile := THMIniFile.Create;
    FIniFile.LoadFromFile('swServer2.ini');
    FIniFile.RootKey := 'Connect';
    FIniFile.OpenFirstKey;
    FConnectionString := 'Provider=SQLOLEDB.1;User ID=' + FIniFile['UserID'] + ';Password=' + FIniFile['Password'] + ';Data Source=' + FIniFile['DataSource'] + ';Initial Catalog=' + FIniFile['Database'] + ';';
    FSqlLngDB:=FIniFile['SqlLngDB'];
    dmSysService.Connection.ConnectionString := FConnectionString;
    dmSysService.Connection.Open;
    dmSysService.CreateMDTable;
    ServiceState := srStop;
    CanQuit := False;
    FDefaultDataBase := FIniFile['Database'];
    dmSysService.mdLibrary.Append;
    dmSysService.mdLibrary['md_Filename'] := 'dmDefault.dll';
    dmSysService.mdLibrary['md_LoadWhenStart'] := True;
    dmSysService.mdLibrary['md_UniKey'] := UniKey;
    dmSysService.mdLibrary['md_State'] := 3;
    dmSysService.mdLibrary['md_ModuleAddr'] := 0;
    dmSysService.mdLibrary['md_System'] := True;
    dmSysService.mdLibrary.Post;
    FIniFile.RootKey := 'ExtendModule';
    FIniFile.OpenFirstKey;
    while FIniFile.ItemKeyOpend do
      begin
        dmSysService.mdLibrary.Append;
        dmSysService.mdLibrary['md_Filename'] := FIniFile['Library'];
        dmSysService.mdLibrary['md_LoadWhenStart'] := Uppercase(FIniFile['Option']) = 'LOADWHENSTART';
        dmSysService.mdLibrary['md_UniKey'] := UniKey;
        dmSysService.mdLibrary['md_State'] := 3;
        dmSysService.mdLibrary['md_ModuleAddr'] := 0;
        dmSysService.mdLibrary['md_System'] := False;
        dmSysService.mdLibrary.Post;
        FIniFile.OpenNextKey;
      end; // while
    dmSysService.mdLibrary.First;
    StartService;
    OnLineUserCount := 0;
    Timer1.Enabled := True;
  except
    CanQuit:=True;
    Close;
  end;
end;

procedure TfrmDataServer.FormDestroy(Sender: TObject);
begin
  if ServiceState <> srStop then StopService;
  try
    FIniFile.Free;
    dmSysService.DropMDTable;
    dmSysService.Free;
  except
    ShowMessage('Ini Free Error');
  end;
end;

procedure TfrmDataServer.mnExitSystemClick(Sender: TObject);
begin
  CanQuit := True;
  Close;
end;

procedure TfrmDataServer.TrayIconDblClick(Sender: TObject);
begin
  if Visible then
    begin
      Self.WindowState := wsMinimized;
      Visible := False;
      TrayIcon.HideMainForm;
      mnShowHideWindow.Caption := 'Show &MainWindow';
    end
  else
    begin
      TrayIcon.ShowMainForm;
      Self.WindowState := wsNormal;
      Visible := True;
      mnShowHideWindow.Caption := 'Hide &MainWindow';
    end;
end;

procedure TfrmDataServer.mnShowDebugClick(Sender: TObject);
begin
  if mnShowDebug.Checked then
    mnShowDebug.Caption := 'Show Debug'
  else
    mnShowDebug.Caption := 'Hide Debug'
end;

procedure TfrmDataServer.mnClearDebugClick(Sender: TObject);
begin
  // edtMemo.Clear;
end;

procedure TfrmDataServer.StartService;
begin
  try
    if ServiceState = srStart then exit;
    StatusBar1.Panels[0].Text := 'Start Service...';
    if not dmsysService.LoadAllModuleLibrary then raise Exception.Create('Error');
    StatusBar1.Panels[0].Text := 'Start Service Success.';
    ServiceState := srStart;
    btnStart.Enabled := False;
    lblStart.Enabled := False;
  except
    on E: Exception do
      begin
        ServiceState := srStop;
        StatusBar1.Panels[0].Text := 'Start Service Error.';
      end;
  end;
end;

procedure TfrmDataServer.PauseService;
begin
  ServiceState := srPause;
end;

procedure TfrmDataServer.StopService;
begin
  try
    if ServiceState = srStop then exit;
    if not dmSysService.FreeAllModuleLibrary then raise Exception.Create('Error');
    ServiceState := srStop;
    btnStart.Enabled := True;
    lblStart.Enabled := True;
    StatusBar1.Panels[0].Text := 'Stop Service Success.';
  except
    on E: Exception do
      begin
        StatusBar1.Panels[0].Text := 'Stop Service Error.';
      end;
  end;
end;

procedure TfrmDataServer.StartServer1Click(Sender: TObject);
begin
  if ServiceState = srStop then StartService;
end;

procedure TfrmDataServer.StopServer1Click(Sender: TObject);
begin
  if ServiceState <> srStop then StopService;
end;

procedure TfrmDataServer.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  CanClose := CanQuit;
  if not CanClose then
    begin
      Self.WindowState := wsMinimized;
      Visible := False;
      TrayIcon.HideMainForm;
      mnShowHideWindow.Caption := 'Show &MainWindow';
    end;
end;

procedure TfrmDataServer.WMQUIT(var Message: TMessage);
begin
  Message.Result := -1;
  CanQuit := True;
  Close;
end;

procedure TfrmDataServer.Timer1Timer(Sender: TObject);
begin
  StatusBar1.Panels[1].Text := 'Online: ' + IntTostr(OnlineUserCount);
end;

procedure TfrmDataServer.SetSqlLngDB(const Value: string);
begin
  FSqlLngDB := Value;
end;

end.