unit ApacheFrame;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, StdCtrls, ActnList, ExtCtrls,
  JwaWinSvc, Dialogs, Menus, LCLIntf;

type

  { TApacheModule }

  TApacheModule = class(TFrame)
    acStart: TAction;
    acStop: TAction;
    acRestart: TAction;
    acAdd: TAction;
    acDelete: TAction;
    acOpenSite: TAction;
    acUninstall: TAction;
    ApacheAction: TActionList;
    btnApacheVhostsConf: TButton;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    btnApacheConf: TButton;
    btnOpenSite: TButton;
    cbApacheVersion: TComboBox;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    Label1: TLabel;
    leDomain: TLabeledEdit;
    lbApacheStatus: TLabel;
    lbDomains: TListBox;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    Panel1: TPanel;
    pmWebsite: TPopupMenu;
    procedure acAddExecute(Sender: TObject);
    procedure acAddUpdate(Sender: TObject);
    procedure acDeleteExecute(Sender: TObject);
    procedure acDeleteUpdate(Sender: TObject);
    procedure acOpenSiteExecute(Sender: TObject);
    procedure acOpenSiteUpdate(Sender: TObject);
    procedure acRestartExecute(Sender: TObject);
    procedure acRestartUpdate(Sender: TObject);
    procedure acStartExecute(Sender: TObject);
    procedure acStartUpdate(Sender: TObject);
    procedure acStopExecute(Sender: TObject);
    procedure acStopUpdate(Sender: TObject);
    procedure acUninstallExecute(Sender: TObject);
    procedure acUninstallUpdate(Sender: TObject);
    procedure btnApacheConfClick(Sender: TObject);
    procedure cbApacheVersionChange(Sender: TObject);
    procedure MenuItem1Click(Sender: TObject);
  private
    { private declarations }
    ServiceName: String;
    FServiceStatus: Boolean;
    FServiceInstalledStatus: Boolean;
    function GetServiceStatus: Boolean;
    function GetServiceInstalledStatus: Boolean;
    procedure SetServiceStatus(Status: Boolean);
    procedure SetServiceInstalledStatus(Status: Boolean);
  public
    { public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure ServiceInstall;
    procedure ServiceStart;
    procedure ServiceStop;
    procedure ServiceRestart;
    procedure ServiceUninstall;
    procedure VhostsAdd(Domain: String);
    procedure VhostsDelete(Domain: String);
  published
    property ServiceStatus: Boolean read FServiceStatus write SetServiceStatus;
    property ServiceInstalledStatus: Boolean read FServiceInstalledStatus write SetServiceInstalledStatus;
  end;

implementation
uses functions, MainForm;

{$R *.lfm}

{ TApacheModule }

procedure TApacheModule.acDeleteUpdate(Sender: TObject);
begin
  acDelete.Enabled := lbDomains.ItemIndex >= 0;
end;

procedure TApacheModule.acOpenSiteExecute(Sender: TObject);
begin
  PMWebSite.PopUp;
end;

procedure TApacheModule.acOpenSiteUpdate(Sender: TObject);
begin
  acOpenSite.Enabled := ServiceStatus;
end;

procedure TApacheModule.acRestartExecute(Sender: TObject);
begin
  ServiceRestart;
  Log('重启Apache');
end;

procedure TApacheModule.acRestartUpdate(Sender: TObject);
begin
  acRestart.Enabled := ServiceStatus;
end;

procedure TApacheModule.acStartExecute(Sender: TObject);
begin
  ServiceStart;
  Log('启动Apache');
  if not ServiceInstalledStatus then
  begin
    MessageDlg('错误','服务安装失败，请检查运行库是否安装，具体请看说明！', mtError, [mbOK], 0)
  end
  else
  begin
    if not ServiceStatus then
    begin
      MessageDlg('错误','服务启动失败，可能是配置文件错误！',mtError,[mbOK],0);
    end;
  end;
end;

procedure TApacheModule.acStartUpdate(Sender: TObject);
begin
  acStart.Enabled := not ServiceStatus;
end;

procedure TApacheModule.acStopExecute(Sender: TObject);
begin
  ServiceStop;
  Log('停止启动Apache');
end;

procedure TApacheModule.acStopUpdate(Sender: TObject);
begin
  acStop.Enabled := ServiceStatus;
end;

procedure TApacheModule.acUninstallExecute(Sender: TObject);
begin
  ServiceUninstall;
  Log('卸载Apache');
end;

procedure TApacheModule.acUninstallUpdate(Sender: TObject);
begin
  acUninstall.Enabled := not ServiceStatus and ServiceInstalledStatus;
end;

procedure TApacheModule.btnApacheConfClick(Sender: TObject);
var
  CMD: String;
begin
  case (Sender as TButton).Tag of
    0: CMD := 'notepad.exe ..\program\apache\'+ApacheStatus.version+'\conf\httpd.conf';
    1: CMD := 'explorer.exe ..\conf\apache\vhosts';
  end;
  RunCMD(CMD);
  //LCLIntf.OpenDocument(CMD);
end;

procedure TApacheModule.cbApacheVersionChange(Sender: TObject);
begin
  if not LoadingDataStatus then
  begin
    LoadingDataStatus := True;
    Log('Apache版本从'+ApacheStatus.version+'切换为：'+cbApacheVersion.Text);
    ServiceStop;
    ServiceUninstall;
    ApacheStatus.version := cbApacheVersion.Text;
    ChangeProgramVersion(0);
    ServiceStart;
    LoadingDataStatus := False;
  end;
end;

procedure TApacheModule.MenuItem1Click(Sender: TObject);
var
  url: String;
begin
  case (Sender as TMenuItem).Tag of
    0: url := 'http://localhost';
    1: url := 'http://localhost/tz.php';
    2: url := 'http://localhost/phpmyadmin/';
    3: url := 'http://localhost/info.php';
  end;
  LCLIntf.OpenUrl(url);
end;

constructor TApacheModule.Create(AOwner: TComponent);
var
  DirPath, SearchWord, FileName: String;
  searchRec: TSearchRec;
  found: Longint;
  TSL: TStringList;
  i: Integer;
begin
  inherited Create(AOwner);

  ServiceName := 'Away_Apache';
  ServiceInstalledStatus := GetServiceInstalledStatus;
  ServiceStatus := GetServiceStatus;


  // 获取vhost列表
  DirPath := ExpandFileName(ExtractFilePath(ParamStr(0))+'..\conf\apache\vhosts');
  SearchWord := DirPath + '\*.conf';
  found := FindFirst(SearchWord, faAnyFile, searchRec);
  while found = 0 do
  begin
    if (searchRec.Attr and faDirectory) = 0 then
    begin
      FileName := searchRec.Name;
      FileName := copy(FileName, 1, Length(FileName) - 5);
      lbDomains.Items.Add(FileName);
    end;
    found := FindNext(searchRec);
  end;
  FindClose(searchRec);

  // 检测不存在的版本，并删除
  TSL := TStringList.Create;
  DirPath := ExpandFileName(ExtractFilePath(ParamStr(0))+'..\program\apache') + '\';
  for i := 0 to cbApacheVersion.Items.Count - 1 do
  begin
    if DirectoryExists(DirPath + cbApacheVersion.Items[i]) then
      TSL.Add(cbApacheVersion.Items[i]);
  end;
  cbApacheVersion.Items.Text:=TSL.Text;
  TSL.Free;

  cbApacheVersion.ItemIndex := cbApacheVersion.Items.IndexOf(ApacheStatus.version);

  // 当前版本不存在
  if cbApacheVersion.ItemIndex = -1 then
  begin
    if cbApacheVersion.Items.Count > 0 then
    begin
      cbApacheVersion.ItemIndex := 0;
      ApacheStatus.version := cbApacheVersion.Items[0];
      ChangeProgramVersion(3);
    end;
  end;
end;

procedure TApacheModule.acAddExecute(Sender: TObject);
begin
  Log('添加虚拟主机:'+leDomain.Text);
  VhostsAdd(leDomain.Text);
  cbApacheVersion.Enabled := lbDomains.Items.Count = 0;
end;

procedure TApacheModule.acAddUpdate(Sender: TObject);
begin
  acAdd.Enabled := Trim(leDomain.Text) <> '';
end;

procedure TApacheModule.acDeleteExecute(Sender: TObject);
begin
  if MessageDlg('提示','您确定要删除"'+lbDomains.Items[lbDomains.ItemIndex]+
      '这个虚拟目录么？'#13#10'请注意，文件目录不会被删除',mtInformation, [mbYes, mbNo], 0) = mrYes then
  begin
    Log('删除虚拟主机：'+lbDomains.Items[lbDomains.ItemIndex]);
    VhostsDelete(lbDomains.Items[lbDomains.ItemIndex]);
    lbDomains.Items.Delete(lbDomains.ItemIndex);
  end;
  cbApacheVersion.Enabled := lbDomains.Items.Count = 0;
end;

function TApacheModule.GetServiceInstalledStatus: Boolean;
var
  schm, schs: SC_Handle;
  ss: TServiceStatus;
  dwStat: DWord;
begin
  Result := False;
  dwstat := 0;
  schm := OpenSCManager(PChar(''), Nil, SC_MANAGER_CONNECT);
  { Connect to Machine }
  if schm > 0 then
  begin
    schs := OpenService(schm, PChar(ServiceName), SERVICE_QUERY_STATUS);
    { Open Service }
    if schs > 0 then
      begin
        if(QueryServiceStatus(schs, ss))then
        begin
          dwStat := ss.dwCurrentState;
        end;
        CloseServiceHandle(schs);
      end;
    CloseServiceHandle(schm);
  end;
  Result := dwstat <> 0;
end;

procedure TApacheModule.SetServiceStatus(Status: Boolean);
begin
  FServiceStatus := Status;
  if Status then
  begin
    lbApacheStatus.Caption := '状态：运行';
    ApacheStatus.status := 1;
    PHPStatus.status := 1;
  end
  else
  begin
    lbApacheStatus.Caption := '状态：停止';
    ApacheStatus.status := 0;
    PHPStatus.status := 0;
  end;
  Main.updateStatus;
end;

procedure TApacheModule.SetServiceInstalledStatus(Status: Boolean);
begin
  FServiceInstalledStatus := Status;
end;

procedure TApacheModule.ServiceInstall;
var
  FileName, CMD: String;
begin
  // Service Exe File
  FileName := ExtractFilePath(ParamStr(0))+'..\program\apache\'+ApacheStatus.version+'\bin\httpd.exe';

  if not ServiceInstalledStatus then
  begin
    CMD := FileName + ' -n ' + ServiceName + ' -k install';
    RunCMD(CMD);
    ServiceInstalledStatus := GetServiceInstalledStatus;
  end;
end;

procedure TApacheModule.ServiceStart;
var
  CMD, FileName, Dir: String;
begin
  // Service Exe File
  Dir := ExpandFileName(ExtractFilePath(ParamStr(0))+'..\program\apache\'+ApacheStatus.version);
  FileName := Dir+'\bin\httpd.exe';
  if not ServiceInstalledStatus then
    ServiceInstall;

  if ServiceInstalledStatus then
  begin
    CMD := FileName + ' -n ' + ServiceName + ' -k start';
    RunCMDInDir(CMD, Dir);
    ServiceStatus := GetServiceStatus;
  end;
end;

procedure TApacheModule.ServiceStop;
var
  CMD, FileName, Dir: String;
begin
  // Service Exe File
  Dir := ExpandFileName(ExtractFilePath(ParamStr(0))+'..\program\apache\'+ApacheStatus.version);
  FileName := Dir+'\bin\httpd.exe';

  if ServiceInstalledStatus then
  begin
    CMD := FileName + ' -n ' + ServiceName + ' -k stop';
    RunCMDInDir(CMD, Dir);
    ServiceStatus := GetServiceStatus;
  end;
end;

procedure TApacheModule.ServiceRestart;
var
  CMD, FileName, Dir: String;
begin
  // Service Exe File
  Dir := ExpandFileName(ExtractFilePath(ParamStr(0))+'..\program\apache\'+ApacheStatus.version);
  FileName := Dir+'\bin\httpd.exe';

  if ServiceInstalledStatus then
  begin
    CMD := FileName + ' -n ' + ServiceName + ' -k restart';
    RunCMDInDir(CMD, Dir);
    ServiceStatus := GetServiceStatus;
  end;
end;

procedure TApacheModule.ServiceUninstall;
var
  CMD, FileName, Dir: String;
begin
  // Service Exe File
  Dir := ExpandFileName(ExtractFilePath(ParamStr(0))+'..\program\apache\'+ApacheStatus.version);
  FileName := Dir+'\bin\httpd.exe';

  if ServiceInstalledStatus then
  begin
    CMD := FileName + ' -n ' + ServiceName + ' -k uninstall';
    RunCMDInDir(CMD, Dir);
    ServiceInstalledStatus := GetServiceInstalledStatus;
  end;
end;

procedure TApacheModule.VhostsAdd(Domain: String);
const VHOST = '<VirtualHost *:80>'#13#10+
'    DocumentRoot "{PATH}"'#13#10+
'    ServerName {DOMAIN}'#13#10+
'    ServerAlias www.{DOMAIN}'#13#10+
'    ErrorLog "{LOGPATH}/{DOMAIN}-error.log"'#13#10+
'    CustomLog "{LOGPATH}/{DOMAIN}-access.log" common'#13#10+
'</VirtualHost>'#13#10+
'<Directory "{PATH}">'#13#10+
'      Options Indexes MultiViews'#13#10+
'      AllowOverride None'#13#10+
'      Order allow,deny'#13#10+
'      Allow from all'#13#10+
'      {APACHE2_4}'#13#10+
'</Directory>'#13#10;
var
  ExPath, LogPath, Path, ConfPath, ConfStr:String;
  TSL: TStringList;
begin
  ExPath := ExpandFileName(ExtractFilePath(ParamStr(0))+ '..');
  LogPath := ExPath + '\logs';
  Path := ExPath + '\vhosts\'+Domain;
  ConfPath := ExPath + '\conf\apache\vhosts';
  // 生成vhost配置文件
  ConfStr := StringReplace(VHOST, '{PATH}', Path, [rfReplaceAll]);
  ConfStr := StringReplace(ConfStr, '{DOMAIN}', Domain, [rfReplaceAll]);
  ConfStr := StringReplace(ConfStr, '{LOGPATH}', LogPath, [rfReplaceAll]);
  if (ApacheStatus.version = '2.4_VC9') or (ApacheStatus.version = '2.4_VC11') then
    ConfStr := StringReplace(ConfStr, '{APACHE2_4}', 'Require all granted', [rfReplaceAll])
  else
    ConfStr := StringReplace(ConfStr, '{APACHE2_4}', '', [rfReplaceAll]);
  ConfStr := StringReplace(ConfStr, '\', '/', [rfReplaceAll]);
  // 创建目录
  if not ForceDirectories(Path) then
    MessageDlg('错误','创建目录:'+Path+'失败，您可以手动建立这个目录！',mtError,
          [mbOK], 0);
  // 写入配置文件
  TSL := TStringList.Create;
  TSL.Text := ConfStr;
  TSL.SaveToFile(ConfPath+'\'+Domain+'.conf');
  TSL.Free;
  lbDomains.Items.Add(Domain);
  leDomain.Text := '';

  if ServiceStatus then ServiceRestart;
end;

procedure TApacheModule.VhostsDelete(Domain: String);
var
  ExPath, ConfPath:String;
begin
  ExPath := ExpandFileName(ExtractFilePath(ParamStr(0))+ '..');
  ConfPath := ExPath + '\conf\apache\vhosts\'+Domain+'.conf';

  DeleteFile(ConfPath);

  if ServiceStatus then ServiceRestart;
end;

function TApacheModule.GetServiceStatus: Boolean;
var
  schm, schs: SC_Handle;
  ss: TServiceStatus;
  dwStat: DWord;
begin
  dwstat := 0;
  schm := OpenSCManager(PChar(''), Nil, SC_MANAGER_CONNECT);
  { Connect to Machine }
  if schm > 0 then
  begin
    schs := OpenService(schm, PChar(ServiceName), SERVICE_QUERY_STATUS);
    { Open Service }
    if schs > 0 then
    begin
      if(QueryServiceStatus(schs, ss))then
      begin
        dwStat := ss.dwCurrentState;
      end;
      CloseServiceHandle(schs);
    end;
    CloseServiceHandle(schm);
  end;
  Result := dwstat = SERVICE_RUNNING;
end;
end.