Gecko [ edgpens.lpkmn.gov.my ]

Name	Size	Permission
gfx	[ DIR ]	drwxrwxrwx
locale	[ DIR ]	drwxrwxrwx
.mad-root	0 B	-rw-rw-rw-
VersInfo.pas	42.97 KB	-rw-rw-rw-
default.po	32.22 KB	-rw-rw-rw-
ggexclude.cfg	227 B	-rw-rw-rw-
gnugettext.pas	114.84 KB	-rw-rw-rw-
ignore.po	7.28 KB	-rw-rw-rw-
sonar-project.properties	464 B	-rw-rw-rw-
uApache.pas	15.79 KB	-rw-rw-rw-
uBaseModule.pas	2.25 KB	-rw-rw-rw-
uConfig.dfm	14.81 KB	-rw-rw-rw-
uConfig.pas	4.43 KB	-rw-rw-rw-
uConfigUserDefined.dfm	14.73 KB	-rw-rw-rw-
uConfigUserDefined.pas	3.36 KB	-rw-rw-rw-
uExceptionDialog.dcu	32.71 KB	-rw-rw-rw-
uExceptionDialog.dfm	2.08 KB	-rw-rw-rw-
uExceptionDialog.pas	27.37 KB	-rw-rw-rw-
uFileZilla.pas	14.85 KB	-rw-rw-rw-
uGetWinVersionInfo.dcu	8.09 KB	-rw-rw-rw-
uGetWinVersionInfo.pas	11.13 KB	-rw-rw-rw-
uHelp.dfm	3.18 KB	-rw-rw-rw-
uHelp.pas	1.81 KB	-rw-rw-rw-
uJclSysInfo.pas	22.05 KB	-rw-rw-rw-
uLanguage.dfm	12.95 KB	-rw-rw-rw-
uLanguage.pas	2 KB	-rw-rw-rw-
uLogOptions.dfm	6.42 KB	-rw-rw-rw-
uLogOptions.pas	2.1 KB	-rw-rw-rw-
uMain.dfm	217.14 KB	-rw-rw-rw-
uMain.pas	39.26 KB	-rw-rw-rw-
uMercury.pas	11.42 KB	-rw-rw-rw-
uMySQL.pas	13.95 KB	-rw-rw-rw-
uNetstat.dfm	3.53 KB	-rw-rw-rw-
uNetstat.pas	7.95 KB	-rw-rw-rw-
uNetstatTable.pas	7.58 KB	-rw-rw-rw-
uProcesses.pas	6.25 KB	-rw-rw-rw-
uProcesses_new.pas	2.14 KB	-rw-rw-rw-
uServiceSettings.dfm	16.89 KB	-rw-rw-rw-
uServiceSettings.pas	8.26 KB	-rw-rw-rw-
uServices.pas	6.14 KB	-rw-rw-rw-
uTomcat.pas	15.9 KB	-rw-rw-rw-
uTools.pas	26.61 KB	-rw-rw-rw-
xampp_control3.dpr	2.21 KB	-rw-rw-rw-
xampp_control3.dproj	30.02 KB	-rw-rw-rw-
xampp_control3.dproj.local	38.45 KB	-rw-rw-rw-
xampp_control3.drc	78.46 KB	-rw-rw-rw-
xampp_control3.dres	37.08 KB	-rw-rw-rw-
xampp_control3.identcache	1.29 KB	-rw-rw-rw-
xampp_control3.stat	170 B	-rw-rw-rw-
xampp_control3Resource.rc	341 B	-rw-rw-rw-
xampp_control3_project.tvsconf...	72 B	-rw-rw-rw-

Code Editor : uMercury.pas

unit uMercury;

interface

uses GnuGettext, uBaseModule, SysUtils, Classes, Windows, ExtCtrls, StdCtrls,
  Buttons,
  uNetstatTable, uTools, uProcesses_new, uServices;

type
  tMercury = class(tBaseModule)
    OldPIDs, OldPorts: string;
    GlobalStatus: string;
    procedure ServiceInstall; override;
    procedure ServiceUnInstall; override;
    procedure Start; override;
    procedure Stop; override;
    procedure Admin; override;
    procedure CheckPorts;
    procedure UpdateStatus; override;
    procedure AddLog(Log: string; LogType: tLogType = ltDefault); reintroduce;
    constructor Create(pbbService: TBitBtn; pStatusPanel: tPanel; pPIDLabel, pPortLabel: tLabel; pStartStopButton, pAdminButton: TBitBtn);
    destructor Destroy; override;
  end;

implementation

uses uMain;

const
  cModuleName = 'Mercury';

var
  hWindow: HWND;

{ tMercury }

procedure tMercury.AddLog(Log: string; LogType: tLogType);
begin
  inherited AddLog('mercury', Log, LogType);
end;

function EnumProcess(hHwnd: HWND; lParam: integer): boolean; stdcall;
var
  pPid: DWORD;
  title, ClassName: string;
begin
  if (hHwnd = 0) then
  begin
    result := false;
  end
  else
  begin
    GetWindowThreadProcessId(hHwnd, pPid);
    SetLength(ClassName, 255);
    SetLength(ClassName, GetClassName(hHwnd, PChar(ClassName), Length(ClassName)));
    SetLength(title, 255);
    SetLength(title, GetWindowText(hHwnd, PChar(title), Length(title)));
    if title = 'Mercury/32' then
    begin
      hWindow := hHwnd;
    end;

result := true;
  end;
end;

procedure tMercury.Admin;
begin
  hWindow := 0;
  EnumWindows(@EnumProcess, 0);
  if hWindow <> 0 then
    ShowWindow(hWindow, SW_SHOW);
end;

constructor tMercury.Create;
var
  ServerApp: string;
begin
  inherited;
  ModuleName := cModuleName;
  isService := false;
  GlobalStatus := 'starting';
  AddLog(_('Initializing module...'), ltDebug);
  ServerApp := basedir + 'MercuryMail\' + Config.BinaryNames.Mercury;
  AddLog(_('Checking for module existence...'), ltDebug);
  if not FileExists(ServerApp) then
  begin
    pStatus.Color := cErrorColor;
    AddLog(Format(_('Problem detected: %s Not Found!'),[cModuleName]), ltError);
    AddLog(Format(_('Disabling %s buttons'),[cModuleName]), ltError);
    AddLog(_('Run this program from your XAMPP root directory!'), ltError);
    bAdmin.Enabled := False;
    bbService.Enabled := False;
    bStartStop.Enabled := False;
  end;

AddLog(_('Checking for required tools...'), ltDebug);

CheckPorts;
end;

destructor tMercury.Destroy;
begin
  inherited;
end;

procedure tMercury.CheckPorts;
var
  PortBlocker: string;
  PortBlockerPID: integer;
  p: integer;
  ServerApp: string;
  pbpath: string;
  pbspath: string;
  Ports: array [0 .. 6] of integer;
begin
  ServerApp := basedir + 'MercuryMail\' + Config.BinaryNames.Mercury;
  Ports[0] := Config.ServicePorts.Mercury1;
  Ports[1] := Config.ServicePorts.Mercury2;
  Ports[2] := Config.ServicePorts.Mercury3;
  Ports[3] := Config.ServicePorts.Mercury4;
  Ports[4] := Config.ServicePorts.Mercury5;
  Ports[5] := Config.ServicePorts.Mercury6;
  Ports[6] := Config.ServicePorts.Mercury7;

if Config.EnableChecks.CheckDefaultPorts then
  begin
    AddLog(_('Checking default ports...'), ltDebug);
    for p := Low(Ports) to High(Ports) do
    begin
      PortBlockerPID := NetStatTable.isPortInUsePID(Ports[p]);
      if (PortBlockerPID > 0) then
      begin
        PortBlocker := Processes.GetProcessName(PortBlockerPID);
        AddLog(Format(_('Portblocker Detected: %s'), [PortBlocker]), ltDebug);
        AddLog(Format(_('Checking for App: %s'), [ServerApp]), ltDebug);
        //if (Pos(LowerCase(ServerApp), LowerCase(PortBlocker)) <> 0) then
        pbpath := Processes.GetProcessPath(PortBlockerPID);
        pbspath := GetServiceWithPid(PortBlockerPID);
        AddLog(Format(_('Portblocker Path: %s'), [pbpath]), ltDebug);
        AddLog(Format(_('Portblocker Service Path: %s'), [pbspath]), ltDebug);
        if (Pos(LowerCase(ServerApp), LowerCase(pbpath)) <> 0) then
        begin
          AddLog(Format(_('XAMPP %s is already running on port %d'), [cModuleName, Ports[p]]), ltInfo);
        end
        else
        begin
          pStatus.Color := cErrorColor;
          if (pbspath <> '') then
            PortBlocker := pbspath
          else
            PortBlocker := pbpath;
          AddLog(_('Problem detected!'), ltError);
          AddLog(Format(_('Port %d in use by "%s" with PID %d!'), [Ports[p], PortBlocker, PortBlockerPID]), ltError);
          AddLog(Format(_('%s WILL NOT start without the configured ports free!'), [cModuleName]), ltError);
          AddLog(_('You need to uninstall/disable/reconfigure the blocking application'), ltError);
          AddLog(Format(_('or reconfigure %s and the Control Panel to listen on a different port'), [cModuleName]), ltError);
        end;
      end;
    end;
  end;
end;

procedure tMercury.ServiceInstall;
begin
  inherited;
end;

procedure tMercury.ServiceUnInstall;
begin
  inherited;
end;

procedure tMercury.Start;
var
  App: string;
  RC : Cardinal;
begin
  GlobalStatus := 'starting';
  CheckPorts;
  App := basedir + 'MercuryMail\' + Config.BinaryNames.Mercury;
  AddLog(Format(_('Attempting to start %s app...'), [cModuleName]));
  AddLog(Format(_('Executing "%s"'), [App]), ltDebug);
  RC := RunProcess(App, SW_HIDE, false);
  if RC = 0 then
    AddLog(Format(_('Return code: %d'), [RC]), ltDebug)
  else
    AddLog(Format(_('There may be an error, return code: %d - %s'), [RC, SystemErrorMessage(RC)]), ltError);
end;

procedure tMercury.Stop;
var
  i, pPID: Integer;
begin
  GlobalStatus := 'stopping';
  if PIDList.Count > 0 then
    begin
      for i := 0 to PIDList.Count - 1 do
      begin
        pPID := Integer(PIDList[i]);
        AddLog(_('Attempting to stop') + ' ' + cModuleName + ' ' + Format('(PID: %d)', [pPID]));
        if not TerminateProcessByID(pPID) then
        begin
          AddLog(Format(_('Problem killing PID %d'), [pPID]), ltError);
          AddLog(_('Check that you have the proper privileges'), ltError);
        end;
      end;
    end
    else
    begin
      AddLog(_('No PIDs found?!'));
    end;
end;

procedure tMercury.UpdateStatus;
var
  p: integer;
  //ProcInfo: TProcInfo;
  s: string;
  Ports: string;
  pname: string;
  ppath: string;
  currPID: integer;
  ErrorStatus: integer;
begin
  isRunning := false;
  PIDList.Clear;
  ErrorStatus := 0;

//  for p := 0 to Processes.ProcessList.Count - 1 do
//  begin
//    ProcInfo := Processes.ProcessList[p];
//    if (pos(Config.BinaryNames.Mercury, ProcInfo.Module) = 1) then
//    begin
//      if (pos(IntToStr(Config.ServicePorts.Mercury1),NetStatTable.GetPorts4PID(ProcInfo.PID)) <> 0) or
//      (pos(IntToStr(Config.ServicePorts.Mercury2),NetStatTable.GetPorts4PID(ProcInfo.PID)) <> 0) or
//      (pos(IntToStr(Config.ServicePorts.Mercury3),NetStatTable.GetPorts4PID(ProcInfo.PID)) <> 0) or
//      (pos(IntToStr(Config.ServicePorts.Mercury4),NetStatTable.GetPorts4PID(ProcInfo.PID)) <> 0) or
//      (pos(IntToStr(Config.ServicePorts.Mercury5),NetStatTable.GetPorts4PID(ProcInfo.PID)) <> 0) or
//      (pos(IntToStr(Config.ServicePorts.Mercury6),NetStatTable.GetPorts4PID(ProcInfo.PID)) <> 0) or
//      (pos(IntToStr(Config.ServicePorts.Mercury7),NetStatTable.GetPorts4PID(ProcInfo.PID)) <> 0) or
//      (pos(BaseDir, ProcInfo.ExePath) <> 0) then
//      begin
//        isRunning := true;
//        PIDList.Add(Pointer(ProcInfo.PID));
//      end;
//    end;
//  end;

for p := 0 to Processes.ProcessList2.Count - 1 do
  begin
    pname := Processes.ProcessList2[p];
    if (pos(LowerCase(Config.BinaryNames.Mercury), LowerCase(pname)) = 1) then
    begin
      currPID := Integer(Processes.ProcessList2.Objects[p]);
      ppath := LowerCase(Processes.GetProcessPath(currPID));
      if ((pos(IntToStr(Config.ServicePorts.Mercury1),NetStatTable.GetPorts4PID(currPID)) <> 0) and (pos(LowerCase(BaseDir), ppath) <> 0)) or
      ((pos(IntToStr(Config.ServicePorts.Mercury2),NetStatTable.GetPorts4PID(currPID)) <> 0) and (pos(LowerCase(BaseDir), ppath) <> 0)) or
      ((pos(IntToStr(Config.ServicePorts.Mercury3),NetStatTable.GetPorts4PID(currPID)) <> 0) and (pos(LowerCase(BaseDir), ppath) <> 0)) or
      ((pos(IntToStr(Config.ServicePorts.Mercury4),NetStatTable.GetPorts4PID(currPID)) <> 0) and (pos(LowerCase(BaseDir), ppath) <> 0)) or
      ((pos(IntToStr(Config.ServicePorts.Mercury5),NetStatTable.GetPorts4PID(currPID)) <> 0) and (pos(LowerCase(BaseDir), ppath) <> 0)) or
      ((pos(IntToStr(Config.ServicePorts.Mercury6),NetStatTable.GetPorts4PID(currPID)) <> 0) and (pos(LowerCase(BaseDir), ppath) <> 0)) or
      ((pos(IntToStr(Config.ServicePorts.Mercury7),NetStatTable.GetPorts4PID(currPID)) <> 0) and (pos(LowerCase(BaseDir), ppath) <> 0)) or
      (pos(LowerCase(BaseDir), ppath) <> 0) then
      begin
        isRunning := true;
        PIDList.Add(Pointer(currPID));
      end;
    end;
  end;

s := '';
  // Checking processes
  for p := 0 to PIDList.Count - 1 do
  begin
    if p = 0 then
      s := InttoStr(integer(PIDList[p]))
    else
      s := s + #13 + InttoStr(integer(PIDList[p]));
  end;
  if s <> OldPIDs then
  begin
    lPID.Caption := s;
    OldPIDs := s;
  end;
  // Checking netstats
  s := '';
  for p := 0 to PIDList.Count - 1 do
  begin
    Ports := NetStatTable.GetPorts4PID(integer(PIDList[p]));
    if Ports <> '' then
        s := RemoveDuplicatePorts(Ports);
  end;
  if s <> OldPorts then
  begin
    lPort.Caption := s;
    OldPorts := s;
  end;

if byte(isRunning) <> oldIsRunningByte then
  begin

if oldIsRunningByte <> 2 then
    begin
      if isRunning then
        s := _('running')
      else
      begin
        s := _('stopped');
        if GlobalStatus = 'starting' then
         ErrorStatus := 1;
      end;
      AddLog(_('Status change detected:') + ' ' + s);
      if ErrorStatus = 1 then
      begin
        pStatus.Color := cErrorColor;
        AddLog(Format(_('Error: %s shutdown unexpectedly.'),[cModuleName]), ltError);
        AddLog(_('This may be due to a blocked port, missing dependencies, '), ltError);
        AddLog(_('improper privileges, a crash, or a shutdown by another method.'), ltError);
        AddLog(_('Press the Logs button to view error logs and check'), ltError);
        AddLog(_('the Windows Event Viewer for more clues'), ltError);
        AddLog(_('If you need more help, copy and post this'), ltError);
        AddLog(_('entire log window on the forums'), ltError);
      end;
    end;

oldIsRunningByte := byte(isRunning);
    if isRunning then
    begin
      pStatus.Color := cRunningColor;
      bStartStop.Caption := _('Stop');
      bAdmin.Enabled := true;
      fMain.MercuryTray.ImageIndex := 15;
      fMain.MercuryTrayControl.Caption := _('Stop');
    end
    else
    begin
      pStatus.Color := cStoppedColor;
      bStartStop.Caption := _('Start');
      bAdmin.Enabled := false;
      fMain.MercuryTray.ImageIndex := 16;
      fMain.MercuryTrayControl.Caption := _('Start');
    end;
  end;

if AutoStart then
  begin
    AutoStart := false;
    if isRunning then
    begin
      AddLog(Format(_('Autostart aborted: %s is already running'),[cModuleName]), ltInfo);
    end
    else
    begin
      AddLog(_('Autostart active: starting...'));
      Start;
    end;
  end;

end;

end.

${this.title}

Code Editor : uMercury.pas