{*********************************************************} {* Main window for server *} {*********************************************************} (* ***** BEGIN LICENSE BLOCK ***** * Version: MPL 1.1 * * The contents of this file are subject to the Mozilla Public License Version * 1.1 (the "License"); you may not use this file except in compliance with * the License. You may obtain a copy of the License at * http://www.mozilla.org/MPL/ * * Software distributed under the License is distributed on an "AS IS" basis, * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License * for the specific language governing rights and limitations under the * License. * * The Original Code is TurboPower FlashFiler * * The Initial Developer of the Original Code is * TurboPower Software * * Portions created by the Initial Developer are Copyright (C) 1996-2002 * the Initial Developer. All Rights Reserved. * * Contributor(s): * * ***** END LICENSE BLOCK ***** *) unit uFFSMain; {$I FFDEFINE.INC} {$IFDEF SingleEXE} !! Error: This application should not be compiled with SingleEXE mode enabled {$ENDIF} {$DEFINE UseTrayIcon} interface uses Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, Menus, Buttons, Windows, {$IFDEF UseTrayIcon} ShellAPI, {$ENDIF} ffconst, ffnetmsg, ffdtmsgq, ffllbase, fflllgcy, fflleng, ffhash, ffllprot, ffsrbase, ffsrcfg, ffsreng, ffsrcmd, ffllthrd, uffegmgr, ffsrintm, ComCtrls, {$IFDEF DCC4ORLATER} ImgList, {$ENDIF} ToolWin; type TffServerState = ( ssInitializing, ssDown, ssComingUp, ssUp, ssUpMinimized); const {$IFDEF UseTrayIcon} ffc_tiCallBack = WM_USER + $300; {$ENDIF} ffc_Activate = WM_USER + $301; ffc_Minimize = WM_USER + $302; type TfrmFFServer = class(TForm) pnlBottom: TPanel; Timer1: TTimer; PopupMenu: TPopupMenu; pumDownServer: TMenuItem; N3: TMenuItem; pumExit: TMenuItem; MainMenu: TMainMenu; mnuServer: TMenuItem; mnuServerUp: TMenuItem; mnuServerDown: TMenuItem; N1: TMenuItem; mnuServerExit: TMenuItem; mnuConfig: TMenuItem; mnuConfigGeneral: TMenuItem; mnuConfigNetwork: TMenuItem; mnuConfigUsers: TMenuItem; mnuConfigAliases: TMenuItem; mnuConfigIndexes: TMenuItem; mnuDebug: TMenuItem; mnuDebugLog: TMenuItem; mnuResetCounters: TMenuItem; mnuHelp: TMenuItem; mnuHelpAbout: TMenuItem; mnuHelpWWW: TMenuItem; mnuHelpEmail: TMenuItem; pnlBig: TPanel; pnlServers: TPanel; gbServers: TGroupBox; lvServers: TListView; Splitter1: TSplitter; pnlTransports: TPanel; gbTransports: TGroupBox; lvTransports: TListView; pmuTrans: TPopupMenu; pmuTransLog: TMenuItem; pmuTransLogAll: TMenuItem; pmuTransLogSep: TMenuItem; pmuTransLogErr: TMenuItem; pmuTransLogReq: TMenuItem; pmuTransLogRep: TMenuItem; ToolBar: TToolBar; btnProps: TToolButton; ToolButton2: TToolButton; btnStart: TToolButton; btnStop: TToolButton; ImageList: TImageList; pnlTray: TPanel; imgUnlocked: TImage; imgStarted: TImage; lblTime: TLabel; imgStopped: TImage; imgLocked: TImage; imgLogging: TImage; HelpTopics1: TMenuItem; N2: TMenuItem; procedure mnuConfigAliasesClick(Sender: TObject); procedure mnuDebugLogClick(Sender: TObject); procedure mnuServerExitClick(Sender: TObject); procedure pumDownServerClick(Sender: TObject); procedure pumExitClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormCreate(Sender: TObject); procedure FormHide(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure mnuResetCountersClick(Sender: TObject); procedure mnuHelpAboutClick(Sender: TObject); procedure mnuConfigUsersClick(Sender: TObject); procedure mnuHelpWWWClick(Sender: TObject); procedure mnuHelpEmailClick(Sender: TObject); procedure mnuConfigGeneralClick(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormPaint(Sender: TObject); procedure mnuConfigIndexesClick(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure FormShow(Sender: TObject); procedure mnuConfigNetworkClick(Sender: TObject); procedure lvServersClick(Sender: TObject); procedure pmuTransLogAllClick(Sender: TObject); procedure pmuTransLogErrClick(Sender: TObject); procedure pmuTransLogReqClick(Sender: TObject); procedure pmuTransLogRepClick(Sender: TObject); procedure lvTransportsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure btnStartClick(Sender: TObject); procedure btnStopClick(Sender: TObject); procedure btnPropsClick(Sender: TObject); procedure FormResize(Sender: TObject); procedure HelpTopics1Click(Sender: TObject); private { Private d procedure FormResize(Sender: TObject);eclarations } FIgnoreNextLogin : Boolean; FState : TffServerState; FStartTime : TDateTime; FMsgStartTime : TDateTime; cuIsGreen : Boolean; FCloseClick : Boolean; FElapsedTime : TDateTime; FMustClose : Boolean; FClosingFromTray : Boolean; {$IFDEF UseTrayIcon} tiActive : Boolean; tiNotifyData : TNotifyIconData; tiPresent : Boolean; {$ENDIF} procedure AppException(Sender : TObject; E : Exception); procedure DisplayHint(Sender : TObject); function Login : Boolean; procedure MainFormMinimize(Sender : TObject); procedure MainFormRestore(Sender : TObject); procedure PaintPadlockBitmap; {$IFDEF UseTrayIcon} procedure tiAdd; procedure tiCallBack(var Msg : TMessage); message ffc_tiCallBack; procedure tiDelete; function tiGetIconHandle : hIcon; procedure tiInitNotifyData; {$ENDIF} public { Public declarations } ServerName : TffNetAddress; procedure BringServerUp; procedure BringServerDown; procedure CreateEngineMgr; procedure FreeEngineMgr; {!!.06} procedure DownServer; function ElapsedTimeToStr(T : TDateTime) : string; procedure FFCActivate(var Msg : TMessage); message ffc_Activate; procedure FFCMinimize(var Msg : TMessage); message ffc_Minimize; function GetMsgsPerSecAsString(aMsgCount : Longint) : string; procedure LoadServers; procedure LoadTransports; procedure ResetStatistics; procedure SetControls; procedure SetServerName; procedure SetServerPriority(aPriority : longint); procedure SetState(S : TffServerState); procedure UpdateServers; procedure UpdateTransports; procedure UpServer; procedure WMSysCommand(var Msg : TMessage); message WM_SYSCOMMAND; procedure WMQueryEndSession(var msg : TMessage); message WM_QUERYENDSESSION; property State : TffServerState read FState write SetState; end; var frmFFServer: TfrmFFServer; implementation uses FFAbout, FFLLComm, FFLLComp, uFFSAlas, uFFSUser, uFFSGenl, uFFSIndx, uFFSNet, FFSrJour, FFLogDlg, uFFsCfg; {$R *.DFM} {===Main Menu options================================================} procedure TfrmFFServer.mnuConfigAliasesClick(Sender: TObject); begin CreateEngineMgr; with TFFAliasForm.Create(Application) do try ServerEngine := TffServerEngine(lvServers.Selected.Data); ShowModal; finally Free; end; end; {--------} procedure TfrmFFServer.mnuConfigGeneralClick(Sender: TObject); begin CreateEngineMgr; with TFFGenConfigForm.Create(Application) do try ServerEngine := TffServerEngine(lvServers.Selected.Data); ShowModal; { Get the bits in which we're interested. } with ServerEngine.Configuration.GeneralInfo^ do begin ServerName := giServerName; ServerEngine.MaxRAM := giMaxRAM; {!!.01} // ServerEngine.CollectGarbage := giCollectEnabled; {Deleted !!.01} // ServerEngine.CollectFrequency := giCollectFreq; {Deleted !!.01} SetServerName; mnuDebugLog.Checked := giDebugLog; FFEngineManager.EventLogEnabled := giDebugLog; imgLogging.Visible := (giDebugLog and (not giReadOnly)); SetServerPriority(giPriority); PaintPadlockBitmap; end; SetControls; finally Free; end; lvServers.Selected.Caption := ServerName; end; {--------} procedure TfrmFFServer.mnuConfigNetworkClick(Sender: TObject); begin CreateEngineMgr; with TffNetConfigForm.Create(Application) do try ServerEngine := TffServerEngine(lvServers.Selected.Data); ShowModal; if (State = ssUp) then with ServerEngine.Configuration.GeneralInfo^ do begin if Assigned(FFEngineManager.IPXSPXTransport) then FFEngineManager.IPXSPXTransport.RespondToBroadcasts := giIPXSPXLFB; if Assigned(FFEngineManager.TCPIPTransport) then FFEngineManager.TCPIPTransport.RespondToBroadcasts := giTCPIPLFB; end; finally Free; end; end; {--------} procedure TfrmFFServer.mnuConfigIndexesClick(Sender: TObject); begin CreateEngineMgr; with TffIndexForm.Create(Application) do try ServerEngine := TffServerEngine(lvServers.Selected.Data); ShowModal; finally Free; end; end; {--------} procedure TfrmFFServer.mnuConfigUsersClick(Sender: TObject); begin CreateEngineMgr; with TFFUserForm.Create(Application) do try ServerEngine := TffServerEngine(lvServers.Selected.Data); ShowModal; finally Free; end; end; {--------} procedure TfrmFFServer.mnuDebugLogClick(Sender: TObject); begin CreateEngineMgr; mnuDebugLog.Checked := not mnuDebugLog.Checked; with TffServerEngine(lvServers.Selected.Data) do begin Configuration.GeneralInfo^.giDebugLog := mnuDebugLog.Checked; WriteGeneralInfo(False); FFEngineManager.EventLogEnabled := mnuDebugLog.Checked; imgLogging.Visible := (mnuDebugLog.Checked and (not Configuration.GeneralInfo^.giReadOnly)); end; end; {--------} procedure TfrmFFServer.mnuHelpAboutClick(Sender: TObject); var AboutBox : TFFAboutBox; begin AboutBox := TFFAboutBox.Create(Application); try AboutBox.IsServer := true; AboutBox.Caption := 'About FlashFiler Server'; AboutBox.ProgramName.Caption := 'FlashFiler Server'; AboutBox.ShowModal; finally AboutBox.Free; end; end; {--------} procedure TfrmFFServer.mnuHelpWWWClick(Sender: TObject); begin ShellToWWW; end; {--------} procedure TfrmFFServer.mnuHelpEmailClick(Sender: TObject); begin ShellToEmail; end; {--------} procedure TfrmFFServer.mnuResetCountersClick(Sender : TObject); begin FMsgStartTime := Now; ResetStatistics; end; {--------} procedure TfrmFFServer.mnuServerExitClick(Sender : TObject); begin Close; end; {====================================================================} {===Popup menu options===============================================} procedure TfrmFFServer.pumDownServerClick(Sender : TObject); begin if not Login then Exit; FIgnoreNextLogin := True; Application.Restore; Application.ProcessMessages; BringServerDown; // FreeEngineMgr; {!!.06}{Deleted !!.13} end; {--------} procedure TfrmFFServer.pumExitClick(Sender : TObject); begin FClosingFromTray := True; Application.Restore; Close; end; {====================================================================} {===Message handlers=================================================} procedure TfrmFFServer.FFCActivate(var Msg : TMessage); begin Update; BringServerUp; end; {--------} procedure TfrmFFServer.FFCMinimize(var Msg : TMessage); begin Application.Minimize; end; {--------} procedure TfrmFFServer.WMQueryEndSession(var msg : TMessage); begin FMustClose := true; inherited; end; {--------} procedure TfrmFFServer.WMSysCommand(var Msg : TMessage); begin if (((Msg.wParam) and $FFF0) = SC_CLOSE) then FCloseClick := true; inherited; end; {====================================================================} {===Timer handler====================================================} procedure TfrmFFServer.Timer1Timer(Sender: TObject); begin if State = ssUpMinimized then {!!.11} Exit; {!!.11} UpdateServers; UpdateTransports; case State of ssComingUp : begin cuIsGreen := not cuIsGreen; if cuIsGreen then begin imgStarted.Visible := True; imgStopped.Visible := False; end else begin imgStarted.Visible := False; imgStopped.Visible := True; end; end; ssUp : begin FElapsedTime := Now - FStartTime; lblTime.Caption := ElapsedTimeToStr(FElapsedTime); end; end;{case} end; {====================================================================} {===Form events======================================================} procedure TfrmFFServer.FormActivate(Sender: TObject); {$IFDEF UseTrayIcon} var OSVerInfo : TOSVersionInfo; {$ENDIF} begin {$IFDEF UseTrayIcon} tiPresent := false; OSVerInfo.dwOSVersionInfoSize := sizeof(OSVerInfo); if GetVersionEx(OSVerInfo) then begin {Note: Windows95 returns version major:minor = 4:0} if (OSVerInfo.dwPlatformID = VER_PLATFORM_WIN32_WINDOWS) or {Windows95} (OSVerInfo.dwPlatformID = VER_PLATFORM_WIN32_NT) then {WindowsNT} tiPresent := OSVerInfo.dwMajorVersion > 3 end; {$ENDIF} if Assigned(FFEngineManager) and Assigned(lvServers.Selected) then {!!.13} if TffServerEngine(lvServers.Selected.Data).Configuration.GeneralInfo^.giAutoMini {!!.13} and (State = ssInitializing) then FIgnoreNextLogin := true; {!!.13} if not Login then begin PostMessage(Handle, WM_QUIT, 0, 0); Exit; end; try if assigned(FFEngineManager) and assigned(lvServers.Selected) then {!!.02} with TffServerEngine(lvServers.Selected.Data).Configuration.GeneralInfo^ do begin {..server name, etc} ServerName := giServerName; TffServerEngine(lvServers.Selected.Data).BufferManager.MaxRAM := giMaxRAM; {..ports} FFSetTCPPort(giTCPPort); FFSetUDPPortServer(giUDPPortSr); FFSetUDPPortClient(giUDPPortCl); FFSetIPXSocketServer(giIPXSocketSr); FFSetIPXSocketClient(giIPXSocketCl); FFSetSPXSocket(giSPXSocket); {..keepalive stuff} ffc_LastMsgInterval := giLastMsgInterval; ffc_KeepAliveInterval := giKAInterval; ffc_KeepAliveRetries := giKARetries; {..priority} SetServerPriority(giPriority); {..auto up} if giAutoUp and (ServerName <> '') then PostMessage(Handle, ffc_Activate, 0, 0); {..auto minimize} if giAutoMini then PostMessage(Handle, ffc_Minimize, 0, 0); end; Application.ShowHint := true; State := ssDown; SetServerName; {$IFDEF UseTrayIcon} if tiPresent then tiAdd; {$ENDIF} except {????} raise; end; (****** {parse out the command line} ActivateIt := false; MinimizeIt := false; ParmCount := ParamCount; if (ParmCount > 0) then begin {the server name is parameter 1} ServerName := ParamStr(1); {whether to make the server active is parameter 2: the value should be either 'Up' or 'Down', but actually all other values are ignored and assumed to be 'Down'} if (ParmCount > 1) then begin ParmValue := ParamStr(2); if (FFCmpShStrUC(ParmValue, 'UP', length(ParmValue)) = 0) then ActivateIt := true; end; if (ParmCount > 2 ) then begin ParmValue := ParamStr(3); if ( FFCmpShStrUC( ParmValue, 'WINSOCK', length( ParmValue) ) = 0 ) then mnuConfigWinsockClick( Self ) else if ( FFCmpShStrUC( ParmValue, 'NETBIOS', length( ParmValue) ) = 0 ) then mnuConfigNetBIOSClick( Self ); Application.ProcessMessages; end; if ( ParmCount > 3 ) then begin ParmValue := ParamStr(4); if (FFCmpShStrUC(ParmValue, 'MINIMIZE', length(ParmValue)) = 0) then MinimizeIt := true; end; end; *****) end; {--------} procedure TfrmFFServer.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin if FMustClose then begin if (State <> ssDown) then begin if (State = ssUpMinimized) then Application.Restore; BringServerDown; end; CanClose := true; end else begin if (State = ssUp) and FCloseClick then begin FCloseClick := false; Application.Minimize; end else if (State <> ssDown) then begin if Login then begin if (State = ssUpMinimized) then Application.Restore; BringServerDown; end; end; CanClose := (State = ssDown); end; end; {--------} procedure TfrmFFServer.FormClose(Sender: TObject; var Action: TCloseAction); begin {$IFDEF UseTrayIcon} tiDelete; {$ENDIF} end; {--------} procedure TfrmFFServer.FormCreate(Sender : TObject); begin FClosingFromTray := False; FIgnoreNextLogin := False; State := ssInitializing; Application.OnMinimize := MainFormMinimize; Application.OnRestore := MainFormRestore; Application.OnException := AppException; Application.OnHint := DisplayHint; FFEngineManager := nil; IsMultiThread := True; pumDownServer.Enabled := False; {!!.01 Added} FFSConfigGetFormPos('Main', Self); {!!.06} end; {--------} procedure TfrmFFServer.AppException(Sender : TObject; E : Exception); begin Application.ShowException(E) end; {--------} procedure TfrmFFServer.DisplayHint(Sender : TObject); begin if Application.MainForm.Active then pnlBottom.Caption := ' ' + Application.Hint; {!!.06} end; {--------} procedure TfrmFFServer.FormDestroy(Sender: TObject); begin FFSConfigSaveFormPrefs('Main', Self); FreeEngineMgr; {!!.06} end; {--------} procedure TfrmFFServer.FormHide(Sender : TObject); begin ShowWindow(Application.Handle, SW_HIDE); end; {--------} procedure TfrmFFServer.FormPaint(Sender : TObject); begin PaintPadlockBitmap; end; {--------} procedure TfrmFFServer.FormShow(Sender : TObject); begin FFSConfigGetFormPrefs('Main', Self); { Create the engine manager. } CreateEngineMgr; {Begin !!.02} try LoadServers; LoadTransports; finally SetControls; end; {End !!.02} end; {--------} function TfrmFFServer.Login : Boolean; var LoginDlg : TFFLoginDialog; Hash : TffWord32; Pwd : TffName; Server : TffServerEngine; User : TffUserItem; UserInx : integer; UserID : TffName; begin if FMustClose then begin {!!.11} Result := True; {!!.11} Exit; {!!.11} end; {!!.11} if FIgnoreNextLogin then begin FIgnoreNextLogin := False; Result := True; Exit; end; Server := nil; if lvServers.SelCount > 0 then Server := TffServerEngine(lvServers.Selected.Data); if (not assigned(Server)) or (not Server.Configuration.GeneralInfo^.giIsSecure) then begin Result := true; Exit; end; Result := false; LoginDlg := TFFLoginDialog.Create(Application); try if (LoginDlg.ShowModal = mrOK) then begin UserID := LoginDlg.edtUserName.Text; Pwd := LoginDlg.edtPassword.Text; UserInx := Server.Configuration.UserList.UserIndex(UserID); if (UserInx <> -1) then begin User := Server.Configuration.UserList[UserInx]; Hash := FFCalcShStrElfHash(Pwd); if (Hash = User.PasswordHash) and (arAdmin in User.Rights) then Result := true; end end; finally LoginDlg.Free; end;{try..finally} end; {--------} procedure TfrmFFServer.MainFormMinimize(Sender : TObject); begin if (State = ssUp) then State := ssUpMinimized; {$IFDEF UseTrayIcon} if tiPresent and (State = ssUpMinimized) then begin Hide; end; {$ENDIF} end; {--------} procedure TfrmFFServer.MainFormRestore(Sender : TObject); begin {$IFDEF UseTrayIcon} if tiPresent and (State = ssUpMinimized) then begin Show; SetForegroundWindow(Handle); end; {$ENDIF} if (State = ssUpMinimized) then State := ssUp; if (not FClosingFromTray) and (not Login) then Application.Minimize; end; {--------} procedure TfrmFFServer.PaintPadlockBitmap; begin if lvServers.SelCount > 0 then begin imgLocked.Visible := TffServerEngine(lvServers.Selected.Data).Configuration.GeneralInfo^.giIsSecure; imgUnlocked.Visible := not imgLocked.Visible; end else begin imgLocked.Visible := False; imgUnlocked.Visible := False; end; end; {====================================================================} {===property handlers================================================} procedure TfrmFFServer.SetState(S : TffServerState); begin if (S = FState) and (S <> ssInitializing) then Exit; FState := S; case S of ssInitializing : begin {..edit controls} lblTime.Caption := ElapsedTimeToStr(0.0); end; ssDown : begin {..menu items} if (ServerName = '') then mnuServerUp.Enabled := false else mnuServerUp.Enabled := true; mnuServerDown.Enabled := false; if ((assigned(FFEngineManager)) and (lvServers.SelCount > 0)) then with TffServerEngine(lvServers.Selected.Data).Configuration do begin FFEngineManager.EventLogEnabled := mnuDebugLog.Checked; end; {..speedbutton actions} if (ServerName = '') then btnStart.Enabled := false else btnStart.Enabled := true; btnStop.Enabled := false; {..online indicator} imgStarted.Visible := False; imgStopped.Visible := True; {..timer} Timer1.Enabled := false; end; ssComingUp : begin {..menu items} mnuServerUp.Enabled := false; {..speedbutton actions} btnStart.Enabled := false; {..edit controls} lblTime.Caption := ElapsedTimeToStr(0.0); {..form fields} FStartTime := Now; FMsgStartTime := Now; {..timer} Timer1.Enabled := true; end; ssUp : begin {..menu items} mnuServerUp.Enabled := false; mnuServerDown.Enabled := true; {..speedbutton actions} btnStart.Enabled := false; btnStop.Enabled := true; {..online indicator} imgStarted.Visible := True; imgStopped.Visible := False; {..timer} Timer1.Enabled := true; end; ssUpMinimized : begin {..timer} Timer1.Enabled := false; end; end;{case} end; {====================================================================} {===Utility methods==================================================} procedure TfrmFFServer.BringServerDown; begin if (State = ssUp) then begin DownServer; State := ssDown; end; end; {--------} procedure TfrmFFServer.BringServerUp; begin if (State = ssDown) then begin Timer1.Interval := 250; cuIsGreen := false; State := ssComingUp; try UpServer; Timer1.Interval := 1000; State := ssUp; except State := ssDown; raise; end;{try..except} end; LoadServers; LoadTransports; end; {--------} procedure TfrmFFServer.CreateEngineMgr; begin if not assigned(FFEngineManager) then begin FFEngineManager := TffEngineManager.Create(nil); if ParamCount > 0 then FFEngineManager.ScriptFile := ParamStr(1); end; end; {--------} procedure TfrmFFServer.FreeEngineMgr; {!!.06} begin if assigned(FFEngineManager) then try FFEngineManager.ShutDown; finally FFEngineManager.Free; FFEngineManager := nil; end; end; {--------} procedure TfrmFFServer.DownServer; {Deleted !!.01} {var Idx : Integer;} begin Screen.Cursor := crHourGlass; try {free all server engines} {Begin !!.01} if assigned(FFEngineManager) then begin pumDownServer.Enabled := False; FFEngineManager.ShutDown; { for Idx := 0 to Pred(lvServers.Items.Count) do with TffServerEngine(lvServers.Items[Idx].Data) do State := ffesInactive; } end; {End !!.01} finally Screen.Cursor := crDefault; end; {redisplay the counters} ResetStatistics; Timer1Timer(Self); end; {--------} function TfrmFFServer.ElapsedTimeToStr(T : TDateTime) : string; var Dy : integer; Hr : integer; Mi : integer; Se : integer; WorkSt : string[9]; begin Dy := trunc(T); T := frac(T) * 24.0; Hr := trunc(T); T := frac(T) * 60.0; Mi := trunc(T); Se := trunc(frac(T) * 60.0); {123456789012345678} Result := 'Up: 0:00:00:00'; Result[10] := TimeSeparator; Result[12] := TimeSeparator; Result[16] := TimeSeparator; Str(Dy:5, WorkSt); Move(WorkSt[1], Result[5], 5); Str(Hr:2, WorkSt); Result[12] := WorkSt[2]; if (Hr > 9) then Result[11] := WorkSt[1]; Str(Mi:2, WorkSt); Result[15] := WorkSt[2]; if (Mi > 9) then Result[14] := WorkSt[1]; Str(Se:2, WorkSt); Result[18] := WorkSt[2]; if (Se > 9) then Result[17] := WorkSt[1]; end; {--------} function TfrmFFServer.GetMsgsPerSecAsString(aMsgCount: Integer): string; var MsgsPerSec : double; begin if (FElapsedTime > 0.0) then MsgsPerSec := aMsgCount / (FElapsedTime * 86400.0) else MsgsPerSec := 0.0; Str(MsgsPerSec:0:4, Result); end; {--------} procedure TfrmFFServer.LoadServers; var ListItem : TListItem; SelServIdx : Integer; Servers : TffList; i : Integer; begin if assigned(FFEngineManager) then begin if lvServers.SelCount > 0 then SelServIdx := lvServers.Selected.Index else SelServIdx := 0; lvServers.Items.BeginUpdate; Servers := TffList.Create; try lvServers.Items.Clear; FFEngineManager.GetServerEngines(Servers); for i := 0 to Pred(Servers.Count) do begin ListItem := lvServers.Items.Add; with TffServerEngine(TffIntListItem(Servers[i]).KeyAsInt) do begin ListItem.Caption := Configuration.ServerName; ListItem.Data := Pointer(TffIntListItem(Servers[i]).KeyAsInt); ListItem.SubItems.Add(FFMapStateToString(State)); ListItem.SubItems.Add(FFCommaizeChL(ClientList.ClientCount, ThousandSeparator)); ListItem.SubItems.Add(FFCommaizeChL(SessionList.SessionCount, ThousandSeparator)); ListItem.SubItems.Add(FFCommaizeChL(DatabaseList.DatabaseCount, ThousandSeparator)); ListItem.SubItems.Add(FFCommaizeChL(TableList.TableCount, ThousandSeparator)); ListItem.SubItems.Add(FFCommaizeChL(CursorList.CursorCount, ThousandSeparator)); ListItem.SubItems.Add(FFCommaizeChL(BufferManager.RAMUsed, ThousandSeparator)); end; if i = SelServIdx then lvServers.Selected := ListItem; end; finally Servers.Free; lvServers.Items.EndUpdate; end; end; end; {--------} procedure TfrmFFServer.LoadTransports; var i : Integer; NewTransItem : TListItem; Transports : TffList; begin Transports := TffList.Create; try lvTransports.Items.Clear; if lvServers.SelCount > 0 then begin if assigned(FFEngineManager) then begin FFEngineManager.GetTransports(TffServerEngine(lvServers.Selected.Data), Transports); lvTransports.Items.BeginUpdate; try lvTransports.Items.Clear; for i := 0 to Pred(Transports.Count) do begin with TffBaseTransport(TffIntListItem(Transports[i]).KeyAsInt) do begin NewTransItem := lvTransports.Items.Add; NewTransItem.Caption := GetName; NewTransItem.Data := Pointer(TffIntListItem(Transports[i]).KeyAsInt); NewTransItem.SubItems.Add(ServerName); NewTransItem.SubItems.Add(FFMapStateToString(State)); NewTransItem.SubItems.Add(FFCommaizeChL(ConnectionCount, ThousandSeparator)); NewTransItem.SubItems.Add(FFCommaizeChL(MsgCount, ThousandSeparator)); NewTransItem.SubItems.Add(GetMsgsPerSecAsString(MsgCount)); end; end; finally lvTransports.Items.EndUpdate; end; end; end; finally Transports.Free; end; end; {--------} procedure TfrmFFServer.lvServersClick(Sender: TObject); begin LoadTransports; SetControls; PaintPadlockBitmap; end; {--------} procedure TfrmFFServer.ResetStatistics; var i : Integer; begin for i := 0 to pred(lvTransports.Items.Count) do begin with TffBaseTransport(lvTransports.Items[i].Data) do begin ResetMsgCount; end; end; end; {--------} procedure TfrmFFServer.SetControls; var SelectedServer : TffServerEngine; IsServerSelected : Boolean; begin SelectedServer := nil; IsServerSelected := lvServers.SelCount > 0; if IsServerSelected then begin SelectedServer := TffServerEngine(lvServers.Selected.Data); gbTransports.Caption := format(' Transports for %s ', [lvServers.Selected.Caption]); imgLogging.Visible := SelectedServer.Configuration.GeneralInfo^.giDebugLog; mnuDebugLog.Checked := imgLogging.Visible; end else begin gbTransports.Caption := ' Transports for selected server '; imgLogging.Visible := False; mnuDebugLog.Checked := False; end; mnuConfigGeneral.Enabled := IsServerSelected; mnuConfigNetwork.Enabled := IsServerSelected; mnuConfigAliases.Enabled := IsServerSelected; mnuConfigIndexes.Enabled := IsServerSelected; mnuConfigUsers.Enabled := IsServerSelected; btnProps.Enabled := IsServerSelected; if IsServerSelected and Assigned(SelectedServer) then mnuDebugLog.Enabled := not SelectedServer.Configuration.GeneralInfo^.giReadOnly else mnuDebugLog.Enabled := False; mnuResetCounters.Enabled := IsServerSelected; end; {--------} procedure TfrmFFServer.SetServerName; begin if assigned(FFEngineManager) and assigned(lvServers.Selected)then {!!.02} with TffServerEngine(lvServers.Selected.Data) do Configuration.GeneralInfo^.giServerName := ServerName; if (ServerName <> '') then begin Caption := 'TurboPower FlashFiler [' + ServerName + ']'; Application.Title := Caption; if (State = ssDown) then begin mnuServerUp.Enabled := true; btnStart.Enabled := true; end; {$IFDEF UseTrayIcon} tiInitNotifyData; {$ENDIF} end else begin Caption := 'FlashFiler Server'; mnuServerUp.Enabled := false; btnStart.Enabled := false; end; end; {--------} procedure TfrmFFServer.SetServerPriority(aPriority : longint); const ThreadPriority : array [0..4] of integer = (THREAD_PRIORITY_LOWEST, THREAD_PRIORITY_BELOW_NORMAL, THREAD_PRIORITY_NORMAL, THREAD_PRIORITY_ABOVE_NORMAL, THREAD_PRIORITY_HIGHEST); begin if (aPriority < -2) or (aPriority > 2) then aPriority := 2 else inc(aPriority, 2); SetThreadPriority(GetCurrentThread, ThreadPriority[aPriority]); end; {--------} procedure TfrmFFServer.UpdateServers; var i : Integer; begin for i := 0 to Pred(lvServers.Items.Count) do begin with lvServers.Items[i], TffServerEngine(lvServers.Items[i].Data) do begin SubItems[0] := FFMapStateToString(State); SubItems[1] := FFCommaizeChL(ClientList.ClientCount, ThousandSeparator); SubItems[2] := FFCommaizeChL(SessionList.SessionCount, ThousandSeparator); SubItems[3] := FFCommaizeChL(DatabaseList.DatabaseCount, ThousandSeparator); SubItems[4] := FFCommaizeChL(TableList.TableCount, ThousandSeparator); SubItems[5] := FFCommaizeChL(CursorList.CursorCount, ThousandSeparator); SubItems[6] := FFCommaizeChL(BufferManager.RAMUsed, ThousandSeparator); end; end; end; {--------} procedure TfrmFFServer.UpdateTransports; var i : Integer; begin for i := 0 to pred(lvTransports.Items.Count) do begin with lvTransports.Items[i], TffBaseTransport(lvTransports.Items[i].Data) do begin SubItems[0] := ServerName; SubItems[1] := FFMapStateToString(State); SubItems[2] := FFCommaizeChL(ConnectionCount, ThousandSeparator); SubItems[3] := FFCommaizeChL(MsgCount, ThousandSeparator); SubItems[4] := GetMsgsPerSecAsString(MsgCount); end; end; end; {--------} procedure TfrmFFServer.UpServer; var SaveCursor : TCursor; begin SaveCursor := Cursor; Cursor := crHourglass; try { Create & set up the transports. } with FFEngineManager.ServerEngine.Configuration.GeneralInfo^ do begin FFEngineManager.SUPTransport.Enabled := giSingleUser; if giSingleUser then begin FFEngineManager.SUPTransport.BeginUpdate; try FFEngineManager.SUPTransport.ServerName := giServerName; FFEngineManager.SUPTransport.Mode := fftmListen; FFEngineManager.SUPTransport.EndUpdate; except FFEngineManager.SUPTransport.CancelUpdate; end; end; FFEngineManager.IPXSPXTransport.Enabled := giIPXSPX; if giIPXSPX then begin FFEngineManager.IPXSPXTransport.BeginUpdate; try FFEngineManager.IPXSPXTransport.ServerName := giServerName; FFEngineManager.IPXSPXTransport.RespondToBroadcasts := giIPXSPXLFB; FFEngineManager.IPXSPXTransport.Mode := fftmListen; FFEngineManager.IPXSPXTransport.EndUpdate; except FFEngineManager.IPXSPXTransport.CancelUpdate; end; end; FFEngineManager.TCPIPTransport.Enabled := giTCPIP; if giTCPIP then begin FFEngineManager.TCPIPTransport.BeginUpdate; try FFEngineManager.TCPIPTransport.ServerName := giServerName; FFEngineManager.TCPIPTransport.RespondToBroadcasts := giTCPIPLFB; FFEngineManager.TCPIPTransport.Mode := fftmListen; FFEngineManager.TCPIPTransport.EndUpdate; ffc_TCPInterface := giTCPInterface; {!!.01 Added} except FFEngineManager.TCPIPTransport.CancelUpdate; end; end; pumDownServer.Enabled := True; {!!.01 Added} end; { Start the engine manager. } FFEngineManager.StartUp; finally Cursor := SaveCursor; end; end; {====================================================================} {===Transport logging================================================} procedure TfrmFFServer.lvTransportsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var anItem : TListItem; aTransport : TffBaseTransport; MousePos : TPoint; begin if Button <> mbRight then exit; { Find the transport under the mouse. } anItem := lvTransports.GetItemAt(X, Y); if assigned(anItem) then begin aTransport := TffBaseTransport(anItem.Data); { Attach the transport to the popup menu so that the popup menu handlers may quickly access the transport. } lvTransports.Selected := anItem; pmuTrans.Tag := longInt(aTransport); { Update the menu options to reflect the transport. } pmuTransLogErr.Checked := fftpLogErrors in aTransport.EventLogOptions; pmuTransLogReq.Checked := fftpLogRequests in aTransport.EventLogOptions; pmuTransLogRep.Checked := fftpLogReplies in aTransport.EventLogOptions; pmuTransLogAll.Checked := (pmuTranslogErr.Checked and pmuTransLogReq.Checked and pmuTransLogRep.Checked); MousePos := lvTransports.ClientToScreen(Point(X, Y)); pmuTrans.Popup(MousePos.X, MousePos.Y); end; end; {--------} procedure TfrmFFServer.pmuTransLogAllClick(Sender: TObject); var aTransport : TffBaseTransport; begin { Enable/Disable logging of all options on the selected transport. } pmuTransLogAll.Checked := not pmuTransLogAll.Checked; pmuTransLogErr.Checked := pmuTransLogAll.Checked; pmuTransLogReq.Checked := pmuTransLogAll.Checked; pmuTransLogRep.Checked := pmuTransLogAll.Checked; { Get the transport of interest. } aTransport := TffBaseTransport(pmuTrans.Tag); { Update the transport as required. } if pmuTransLogAll.Checked then begin aTransport.EventLogOptions := [fftpLogErrors, fftpLogRequests, fftpLogReplies]; aTransport.EventLogEnabled := True; end else begin aTransport.EventLogOptions := []; aTransport.EventLogEnabled := False; end; end; {--------} procedure TfrmFFServer.pmuTransLogErrClick(Sender: TObject); var aTransport : TffBaseTransport; aSet : TffTransportLogOptions; begin pmuTransLogErr.Checked := not pmuTransLogErr.Checked; if not pmuTransLogErr.Checked then pmuTransLogAll.Checked := False; { Get the transport of interest. } aTransport := TffBaseTransport(pmuTrans.Tag); aSet := aTransport.EventLogOptions; if pmuTransLogErr.Checked then begin Include(aSet, fftpLogErrors); aTransport.EventLogEnabled := True; end else Exclude(aSet, fftpLogErrors); aTransport.EventLogOptions := aSet; end; {--------} procedure TfrmFFServer.pmuTransLogReqClick(Sender: TObject); var aTransport : TffBaseTransport; aSet : TffTransportLogOptions; begin pmuTransLogReq.Checked := not pmuTransLogReq.Checked; if not pmuTransLogReq.Checked then pmuTransLogAll.Checked := False; { Get the transport of interest. } aTransport := TffBaseTransport(pmuTrans.Tag); aSet := aTransport.EventLogOptions; if pmuTransLogReq.Checked then begin Include(aSet, fftpLogRequests); aTransport.EventLogEnabled := True; end else Exclude(aSet, fftpLogRequests); aTransport.EventLogOptions := aSet; end; {--------} procedure TfrmFFServer.pmuTransLogRepClick(Sender: TObject); var aTransport : TffBaseTransport; aSet : TffTransportLogOptions; begin pmuTransLogRep.Checked := not pmuTransLogRep.Checked; if not pmuTransLogRep.Checked then pmuTransLogAll.Checked := False; { Get the transport of interest. } aTransport := TffBaseTransport(pmuTrans.Tag); aSet := aTransport.EventLogOptions; if pmuTransLogRep.Checked then begin Include(aSet, fftpLogReplies); aTransport.EventLogEnabled := True; end else Exclude(aSet, fftpLogReplies); aTransport.EventLogOptions := aSet; {!!.03} end; {====================================================================} {===Tray Icon stuff==================================================} {$IFDEF UseTrayIcon} procedure TfrmFFServer.tiAdd; begin if tiPresent and (not tiActive) then begin tiInitNotifyData; tiActive := Shell_NotifyIcon(NIM_ADD, @tiNotifyData); end; end; {--------} procedure TfrmFFServer.tiCallBack(var Msg : TMessage); var P : TPoint; begin if (State = ssUpMinimized) then begin with Msg do begin case lParam of WM_RBUTTONDOWN : begin GetCursorPos(P); SetForegroundWindow(Application.Handle); Application.ProcessMessages; PopupMenu.Popup(P.X, P.Y); end; WM_LBUTTONDBLCLK : Application.Restore; end;{case} end; end else begin case Msg.lParam of WM_LBUTTONDOWN : SetForegroundWindow(Handle); WM_RBUTTONDOWN : begin SetForegroundWindow(Handle); GetCursorPos(P); Application.ProcessMessages; PopupMenu.Popup(P.X, P.Y); end; end; end; end; {--------} procedure TfrmFFServer.tiDelete; begin if tiPresent and tiActive then begin tiActive := not Shell_NotifyIcon(NIM_DELETE, @tiNotifyData); end; end; {--------} function TfrmFFServer.tiGetIconHandle : hIcon; begin Result := Application.Icon.Handle; if Result = 0 then Result := LoadIcon(0, IDI_Application); end; {--------} procedure TfrmFFServer.tiInitNotifyData; var Tip : string; begin if tiPresent then begin FillChar(tiNotifyData, sizeof(tiNotifyData), 0); with tiNotifyData do begin cbSize := sizeof(tiNotifyData); Wnd := Handle; uID := 1; uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP; Tip := 'TurboPower FlashFiler [' + ServerName + ']'; StrCopy(szTip, @Tip[1]); uCallBackMessage := ffc_tiCallBack; hIcon := tiGetIconHandle; Shell_NotifyIcon(NIM_MODIFY, @tiNotifyData) end; end; end; {$ENDIF} {====================================================================} procedure TfrmFFServer.btnStartClick(Sender: TObject); begin CreateEngineMgr; if not Login then Exit; BringServerUp; SetControls; end; procedure TfrmFFServer.btnStopClick(Sender: TObject); begin if not Login then Exit; BringServerDown; // FreeEngineMgr; {!!.06}{Deleted !!.13} SetControls; end; procedure TfrmFFServer.btnPropsClick(Sender : TObject); begin mnuConfigGeneralClick(Sender); end; procedure TfrmFFServer.FormResize(Sender: TObject); {begin !!.06} begin if Width < 605 then Width := 605; if Height < 300 then Height := 300; end; {end !!.06} procedure TfrmFFServer.HelpTopics1Click(Sender: TObject); begin Application.HelpCommand(HELP_FINDER, 0); end; end.