⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 打印软件
💻 PAS
字号:

{******************************************}
{                                          }
{             FastReport v3.0              }
{          FastReport Server demo          }
{         Copyright (c) 1998-2005          }
{         by Alexander Fediachov,          }
{            Fast Reports Inc.             }
{                                          }
{******************************************}

unit Main;

{$I frx.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  StdCtrls, Db, DBTables, frxDesgn, frxClass, frxDCtrl,
  frxChart, frxRich, frxBarcode, ImgList, ComCtrls, ExtCtrls, frxOLE,
  frxCross, frxServer, frxGradient, frxChBox, Menus, ShellApi, config_form,
  frxADOComponents, ADODB, frxGZip, Dialogs, frxMD5, frxServerUtils, IniFiles;

type
  TMainForm = class(TForm)
    frBarCodeObject1: TfrxBarCodeObject;
    frRichObject1: TfrxRichObject;
    frChartObject1: TfrxChartObject;
    frDialogControls1: TfrxDialogControls;
    ImageList1: TImageList;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    frOLEObject1: TfrxOLEObject;
    frCrossObject1: TfrxCrossObject;
    frxCheckBoxObject1: TfrxCheckBoxObject;
    PopupMenu1: TPopupMenu;
    Close1: TMenuItem;
    ShowWin: TMenuItem;
    N1: TMenuItem;
    MinimizeBtn: TButton;
    CloseBtn: TButton;
    GroupBox1: TGroupBox;
    Label4: TLabel;
    LBActive: TLabel;
    LBInactive: TLabel;
    GroupBox2: TGroupBox;
    Label5: TLabel;
    ETotalSessions: TEdit;
    Label6: TLabel;
    ETotalReports: TEdit;
    Timer1: TTimer;
    Label7: TLabel;
    Label8: TLabel;
    EMaxReports: TEdit;
    EMaxSessions: TEdit;
    Label9: TLabel;
    Label10: TLabel;
    ECurrentReports: TEdit;
    ECurrentSessions: TEdit;
    Label11: TLabel;
    EErrors: TEdit;
    N2: TMenuItem;
    Start1: TMenuItem;
    Stop1: TMenuItem;
    StartBtn: TButton;
    StopBtn: TButton;
    ConfigBtn: TButton;
    DesignBtn: TButton;
    frxDesigner1: TfrxDesigner;
    OpenDialog1: TOpenDialog;
    Label12: TLabel;
    Uptime: TLabel;
    frxADOComponents1: TfrxADOComponents;
    Serv: TfrxReportServer;
    Label13: TLabel;
    DemoDatabase: TADOConnection;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure MinimizeBtnClick(Sender: TObject);
    procedure ShutBtnClick(Sender: TObject);
    procedure ShowWinClick(Sender: TObject);
    procedure StartBtnClick(Sender: TObject);
    procedure StopBtnClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure ConfigBtnClick(Sender: TObject);
    procedure DesignBtnClick(Sender: TObject);
    procedure Label3Click(Sender: TObject);
  protected
    procedure ControlWindow(var Msg:TMessage); message WM_SYSCOMMAND;
    procedure IconMouse(var Msg : TMessage); message WM_USER + 1;
  private
    Icon: TIcon;
    AppPath: String;
    ConfFile: String;
    AllowFile: String;
    DenyFile: String;
    frReport1: TfrxReport;
    procedure TrayIcon(n: Integer; Icon: TIcon);
  end;

var
  MainForm: TMainForm;
  dbMd: String;

const
  CONFIG_FILE = 'server.conf';
  ALLOW_FILE =  'allow.conf';
  DENY_FILE =   'deny.conf';

implementation

{$R *.DFM}

var
  DATABASE_FILE: String;
  DBConnStr: String = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=';

procedure TMainForm.TrayIcon(n:Integer;Icon:TIcon);
var
  Nim: TNotifyIconData;
begin
  with Nim do
  begin
    cbSize:=SizeOf(Nim);
    Wnd:=Self.Handle;
    uID:=1;
    uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP;
    hicon:=Icon.Handle;
    uCallbackMessage:=WM_USER + 1;
    szTip:='FastReport Server';
  end;
  case n of
    1: Shell_NotifyIcon(Nim_Add,@Nim);
    2: Shell_NotifyIcon(Nim_Delete,@Nim);
    3: Shell_NotifyIcon(Nim_Modify,@Nim);
  end;
end;

procedure TMainForm.ControlWindow(var Msg: TMessage);
begin
  if Msg.WParam = SC_MINIMIZE then
  begin
    TrayIcon(1, Icon);
    ShowWindow(Application.Handle, SW_HIDE);
    ShowWindow(Handle, SW_HIDE);
  end else
    inherited;
end;

procedure TMainForm.IconMouse(var Msg: TMessage);
var
  p:tpoint;
begin
  GetCursorPos(p);
  case Msg.LParam of
    WM_LBUTTONUP, WM_LBUTTONDBLCLK:
      ShowWinClick(nil);
    WM_RBUTTONUP:
    begin
      SetForegroundWindow(Handle);
      PopupMenu1.Popup(p.X, p.Y);
      PostMessage(Handle,WM_NULL,0,0)
    end;
  End;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
  ini: TIniFile;
begin
  Label13.Caption := #174;
  
  Icon := TIcon.Create;
  ImageList1.GetIcon(0, Icon);
  AppPath := ExtractFilePath(Application.ExeName);
  ConfFile := AppPath + CONFIG_FILE;
  AllowFile := AppPath + ALLOW_FILE;
  DenyFile := AppPath + DENY_FILE;

  ini := TIniFile.Create(ConfFile);
  try
    DATABASE_FILE := AppPath + ini.ReadString('Database', 'Connection', 'database\server.mdb');
  finally
    ini.Free;
  end;

  DemoDatabase.ConnectionString := DBConnStr + DATABASE_FILE;
  try
    DemoDatabase.Open;
  except
    ShowMessage('Error database connection!');
  end;
  StartBtnClick(Sender);
  MinimizeBtnClick(Sender);
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Serv <> nil then
    StopBtnClick(Sender);
  TrayIcon(2, Icon);
  Icon.Free;
  if DemoDatabase.Connected then
    DemoDatabase.Close;
end;

procedure TMainForm.MinimizeBtnClick(Sender: TObject);
begin
  PostMessage(Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
end;

procedure TMainForm.ShutBtnClick(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.ShowWinClick(Sender: TObject);
begin
  ShowWindow(Application.Handle, SW_SHOWNORMAL);
  ShowWindow(Handle, SW_SHOWNORMAL);
end;

procedure TMainForm.StartBtnClick(Sender: TObject);
begin
  if DemoDatabase.Connected then
  begin
    Screen.Cursor := crHourGlass;
    try
      if FileExists(ConfFile) then
        Serv.Configuration.LoadFromFile(ConfFile);
      if FileExists(AllowFile) then
      begin
        Serv.AllowIP.Clear;
        Serv.AllowIP.LoadFromFile(AllowFile);
      end;
      if FileExists(DenyFile) then
      begin
        Serv.DenyIP.Clear;
        Serv.DenyIP.LoadFromFile(DenyFile);
      end;
        Serv.Open;
      if Serv.Active then
      begin
        StartBtn.Enabled := False;
        StopBtn.Enabled := True;
        LBActive.Visible := True;
        LBInactive.Visible := False;
        Timer1.Enabled := True;
        ImageList1.GetIcon(0, Icon);
        TrayIcon(3, Icon);
        Start1.Enabled := False;
        Stop1.Enabled := True;
      end;
    finally
      Screen.Cursor := crDefault;
    end;
  end;
end;

procedure TMainForm.StopBtnClick(Sender: TObject);
begin
  Screen.Cursor := crHourGlass;
  try
    Timer1.Enabled := False;
    Serv.Close;
    StartBtn.Enabled := True;
    StopBtn.Enabled := False;
    LBActive.Visible := False;
    LBInactive.Visible := True;
    ImageList1.GetIcon(1, Icon);
    TrayIcon(3, Icon);
    Start1.Enabled := True;
    Stop1.Enabled := False;
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TMainForm.Timer1Timer(Sender: TObject);
begin
  ETotalSessions.Text := IntToStr(Serv.Statistic.TotalSessionsCount);
  ETotalReports.Text := IntToStr(Serv.Statistic.TotalReportsCount);
  EMaxSessions.Text := IntToStr(Serv.Statistic.MaxSessionsCount);
  EMaxReports.Text := IntToStr(Serv.Statistic.MaxReportsCount);
  EErrors.Text := IntToStr(Serv.Statistic.TotalErrors);
  ECurrentSessions.Text := IntToStr(Serv.Statistic.CurrentSessionsCount);
  ECurrentReports.Text := IntToStr(Serv.Statistic.CurrentReportsCount);
  Uptime.Caption := IntToStr(Serv.Statistic.UpTimeDays) + ' days ' +
    IntToStr(Serv.Statistic.UpTimeHours) + ' hours ' +
    IntToStr(Serv.Statistic.UpTimeMins) + ' minutes ' +
    IntToStr(Serv.Statistic.UpTimeSecs) + ' seconds';
  Label2.Caption := 'Version: ' + Serv.Variables.GetValue('SERVER_SOFTWARE') + ' from ' + Serv.Variables.GetValue('SERVER_LAST_UPDATE');
end;

procedure TMainForm.ConfigBtnClick(Sender: TObject);
begin
  Config := TConfig.Create(nil);
  Config.fsSyntaxMemo1.Lines.LoadFromFile(ConfFile);
  if Config.ShowModal = mrOk then
    Config.fsSyntaxMemo1.Lines.SaveToFile(ConfFile);
  Config.Free;
end;

procedure TMainForm.DesignBtnClick(Sender: TObject);
begin
  OpenDialog1.InitialDir := Serv.Configuration.ReportPath;
  if OpenDialog1.Execute then
  begin
    frReport1 := TfrxReport.Create(nil);
    frReport1.LoadFromFile(OpenDialog1.FileName);
    frReport1.Variables['PathToDataBase'] := '''' + DATABASE_FILE + '''';
    frReport1.DesignReport;
    frReport1.Free;
  end;
end;

procedure TMainForm.Label3Click(Sender: TObject);
begin
  ShellExecute(GetDesktopWindow, 'open', PChar(Label3.Caption), nil, nil, SW_SHOW);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -