Слияние кода завершено, страница обновится автоматически
unit MainForm;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
StdCtrls, ExtCtrls, Grids, Menus, ActnList, ApacheFrame, PHPFrame, MySQLFrame,
windows, registry;
type
{ TMain }
TMain = class(TForm)
acShowWindow: TAction;
acStartAll: TAction;
acStopAll: TAction;
acQuit: TAction;
acRestartAll: TAction;
acStartupRun: TAction;
acTrayIcon: TActionList;
Apache: TApacheModule;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Memo1: TMemo;
Memo2: TMemo;
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
MenuItem6: TMenuItem;
MenuItem7: TMenuItem;
MenuItem8: TMenuItem;
MySQL: TMySQLModule;
PageControl1: TPageControl;
PHP: TPHPModule;
pmTrayIcon: TPopupMenu;
sgStatus: TStringGrid;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
TabSheet6: TTabSheet;
TabSheet7: TTabSheet;
tiMain: TTrayIcon;
tmAutoHide: TTimer;
procedure acQuitExecute(Sender: TObject);
procedure acRestartAllExecute(Sender: TObject);
procedure acShowWindowExecute(Sender: TObject);
procedure acShowWindowUpdate(Sender: TObject);
procedure acStartAllExecute(Sender: TObject);
procedure acStartupRunExecute(Sender: TObject);
procedure acStartupRunUpdate(Sender: TObject);
procedure acStopAllExecute(Sender: TObject);
procedure ButtonClick(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormWindowStateChange(Sender: TObject);
procedure PageControl1Change(Sender: TObject);
procedure sgStatusDrawCell(Sender: TObject; aCol, aRow: Integer;
aRect: TRect; aState: TGridDrawState);
procedure tmAutoHideTimer(Sender: TObject);
private
{ private declarations }
function getStatusStr(Status: Byte):String;
public
{ public declarations }
procedure updateStatus;
end;
var
Main: TMain;
implementation
uses LCLIntf, functions;
{$R *.lfm}
{ TMain }
procedure TMain.FormCreate(Sender: TObject);
begin
updateStatus;
Log('程序启动');
end;
procedure TMain.FormShow(Sender: TObject);
begin
LoadingDataStatus := False;
if tmAutoHide.Tag = 0 then
tmAutoHide.Enabled := True;
end;
procedure TMain.FormWindowStateChange(Sender: TObject);
begin
if Main.WindowState = wsMinimized then Main.Hide;
end;
procedure TMain.PageControl1Change(Sender: TObject);
begin
Apache.cbApacheVersion.Enabled := Apache.lbDomains.Items.Count = 0;
PHP.cbPHPVersion.Enabled := Apache.lbDomains.Items.Count = 0;
end;
procedure TMain.ButtonClick(Sender: TObject);
var
CMD: String;
begin
case (Sender as TButton).Tag of
0: CMD := 'mmc.exe services.msc';
1: CMD := 'cmd.exe /k cd ..';
2: CMD := 'explorer.exe ..';
3: CMD := 'rundll32.exe shell32.dll,Control_RunDLL SYSDM.CPL,,3';
4: {$IFDEF CPU64}
CMD := '..\program\vcr\vc9_x64.exe';
{$ELSE}
CMD := '..\program\vcr\vc9_x86.exe';
{$ENDIF}
5: {$IFDEF CPU64}
CMD := '..\program\vcr\vc11_x64.exe';
{$ELSE}
CMD := '..\program\vcr\vc11_x86.exe';
{$ENDIF}
end;
RunCMD(CMD);
//LCLIntf.OpenDocument(CMD);
end;
procedure TMain.acQuitExecute(Sender: TObject);
begin
Close;
end;
procedure TMain.acRestartAllExecute(Sender: TObject);
begin
if Apache.ServiceStatus then Apache.ServiceRestart
else Apache.ServiceStart;
if MySQL.ServiceStatus then MySQL.ServiceRestart
else MySQL.ServiceStart;
end;
procedure TMain.acShowWindowExecute(Sender: TObject);
begin
if Main.Showing then Main.Hide
else
begin
if Main.WindowState = wsMinimized then Main.WindowState := wsNormal;
Main.Show;
end;
end;
procedure TMain.acShowWindowUpdate(Sender: TObject);
begin
if Main.Showing then acShowWindow.Caption := '隐藏窗口(&H)'
else acShowWindow.Caption := '显示窗口(&H)';
end;
procedure TMain.acStartAllExecute(Sender: TObject);
begin
if not Apache.ServiceStatus then Apache.ServiceStart;
if not MySQL.ServiceStatus then MySQL.ServiceStart;
end;
procedure TMain.acStartupRunExecute(Sender: TObject);
var
Reg:TRegistry;
begin
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_LOCAL_MACHINE;
Reg.OpenKey('SOFTWARE\Microsoft\windows\CurrentVersion\Run',true);
acStartupRun.Checked := not acStartupRun.Checked;
if acStartupRun.Checked then
begin
Reg.WriteString('AwayAMP', ParamStr(0) + ' -m');
end else begin
Reg.DeleteValue('AwayAMP');
end;
Reg.CloseKey;
end;
procedure TMain.acStartupRunUpdate(Sender: TObject);
var
Reg:TRegistry;
begin
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_LOCAL_MACHINE;
Reg.OpenKey('SOFTWARE\Microsoft\windows\CurrentVersion\Run',true);
acStartupRun.Checked := Reg.ValueExists('AwayAMP');
Reg.CloseKey;
end;
procedure TMain.acStopAllExecute(Sender: TObject);
begin
if Apache.ServiceStatus then Apache.ServiceStop;
if MySQL.ServiceStatus then MySQL.ServiceStop;
end;
procedure TMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
Log('程序关闭');
end;
procedure TMain.sgStatusDrawCell(Sender: TObject; aCol, aRow: Integer;
aRect: TRect; aState: TGridDrawState);
var
sText: string;
begin
if aRow > 0 then
with sgStatus do
begin
sText :=Cells[ACol, ARow];
if sText <> ' ' then
begin
//Canvas.Brush.Color:=clWhite;
Canvas.FillRect(aRect);
DrawText(Canvas.Handle, PChar(sText), Length(sText), aRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
end;
end;
end;
procedure TMain.tmAutoHideTimer(Sender: TObject);
begin
if (ParamCount > 0) and (ParamStr(1) = '-m') then
Main.hide;
tmAutoHide.Enabled := False;
tmAutoHide.Tag := 1;
end;
function TMain.getStatusStr(Status: Byte): String;
begin
case Status of
0: result := 'Stopped';
1: result := 'Running';
end;
end;
procedure TMain.updateStatus;
begin
// 名称
sgStatus.Cells[0, 1] := ApacheStatus.name;
sgStatus.Cells[0, 2] := PHPStatus.name;
sgStatus.Cells[0, 3] := MySQLStatus.name;
// 版本号
sgStatus.Cells[1, 1] := ApacheStatus.version;
sgStatus.Cells[1, 2] := PHPStatus.version;
sgStatus.Cells[1, 3] := MySQLStatus.version;
// 状态
sgStatus.Cells[2, 1] := getStatusStr(ApacheStatus.status);
sgStatus.Cells[2, 2] := getStatusStr(PHPStatus.status);
sgStatus.Cells[2, 3] := getStatusStr(MySQLStatus.status);
end;
end.
Вы можете оставить комментарий после Вход в систему
Неприемлемый контент может быть отображен здесь и не будет показан на странице. Вы можете проверить и изменить его с помощью соответствующей функции редактирования.
Если вы подтверждаете, что содержание не содержит непристойной лексики/перенаправления на рекламу/насилия/вульгарной порнографии/нарушений/пиратства/ложного/незначительного или незаконного контента, связанного с национальными законами и предписаниями, вы можете нажать «Отправить» для подачи апелляции, и мы обработаем ее как можно скорее.
Опубликовать ( 0 )