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

📄 umain.~pas

📁 delphi写的windows服务控制程序.
💻 ~PAS
字号:
unit UMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ActnList, Menus, ComCtrls, shellApi, winsvc, UServiceClass,
  ExtCtrls, ImgList;

type
  TfrmMain = class(TForm)
    lvService: TListView;
    menuPop: TPopupMenu;
    actList: TActionList;
    menuMain: TMainMenu;
    act_start: TAction;
    act_stop: TAction;
    act_remove: TAction;
    act_install: TAction;
    act_exit: TAction;
    act_refresh: TAction;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    R1: TMenuItem;
    statusBar: TStatusBar;
    tmrTime: TTimer;
    tmrServiceStatus: TTimer;
    imgStatus: TImageList;
    imgAction: TImageList;

    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure act_exitExecute(Sender: TObject);
    procedure act_refreshExecute(Sender: TObject);
    procedure act_stopExecute(Sender: TObject);
    procedure act_removeExecute(Sender: TObject);
    procedure act_startExecute(Sender: TObject);
    procedure lvServiceColumnClick(Sender: TObject; Column: TListColumn);
    procedure lvServiceSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure tmrTimeTimer(Sender: TObject);
    procedure tmrServiceStatusTimer(Sender: TObject);
  private
    { Private declarations }
  public
     procedure UpdateView(AManager: TWin32SCManager); overload;
     procedure UpdateView(AService: TWin32Service); overload;
     procedure EnabledActions();
  end;

var
  frmMain: TfrmMain;

  ascendingCompareName: Boolean = True;
  ascendingCompareDisplayName: Boolean = True;
  ascendingCompareState: Boolean = True;

//比较函数(用于排序)
function CompareName(Item1, Item2: Pointer): Integer;
function CompareDisplayName(Item1, Item2: Pointer): Integer;
function CompareStatus(Item1, Item2: Pointer): Integer;

implementation


var
  SCManager_: TWin32SCManager;
  CurrentService_: TWin32Service = nil;
  CurrentCount_ : Integer = 0;
  SuperMode_: Boolean = False;
{$R *.dfm}


function CompareName(Item1, Item2: Pointer): Integer;
begin
  if Assigned(Item1) and Assigned(Item2) then
  begin
    if ascendingCompareName then
      Result := CompareText(TWin32Service(Item1).Name, TWin32Service(Item2).Name)
    else
      Result := CompareText(TWin32Service(Item2).Name, TWin32Service(Item1).Name);
  end
  else
    Result := 0;

end;

function CompareDisplayName(Item1, Item2: Pointer): Integer;
begin
  if Assigned(Item1) and Assigned(Item2) then
  begin
    if ascendingCompareDisplayName then
      Result := CompareText(TWin32Service(Item1).DisplayName,
                          TWin32Service(Item2).DisplayName)
    else
      Result := CompareText(TWin32Service(Item2).DisplayName,
                          TWin32Service(Item1).DisplayName);
  end
  else
    Result := 0;
end;

function CompareStatus(Item1, Item2: Pointer): Integer;
var
  srvItem1, srvItem2: TWin32Service;
begin
  if Assigned(Item1) and Assigned(Item1) then
  begin
    srvItem1 := TWin32Service(Item1);
    srvItem2 := TWin32Service(Item2);
    if ascendingCompareState then
      Result := srvItem1.ServiceStatus.dwCurrentState
              - srvItem2.ServiceStatus.dwCurrentState
    else
      Result := srvItem2.ServiceStatus.dwCurrentState
              - srvItem1.ServiceStatus.dwCurrentState;

  end
  else
    Result := 0;
end;

procedure TfrmMain.act_exitExecute(Sender: TObject);
begin
  Close;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  strParam: string;
begin
  SCManager_ := TWin32SCManager.Create;
  SCManager_.OnSCManagerChanged := UpdateView;
  SCManager_.OnServiceChanged := UpdateView;
  SCManager_.Open;
  SCManager_.Sort(CompareDisplayName);
  ascendingCompareDisplayName := not ascendingCompareDisplayName;
  EnabledActions;

  lvService.PopupMenu := menuPop;


  if (ParamCount >= 1) then
  begin
     strParam := ParamStr(1);
     SuperMode_ := (CompareText(strParam, 'super') = 0)
                 or (CompareText(strParam, '-super') = 0);

  end;

end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  SCManager_.Close;
  SCManager_.Free;
end;

procedure TfrmMain.UpdateView(AManager: TWin32SCManager);
var
  i, cnt: Integer;
  srvItem: TWin32Service;
  lvItem: TListItem;
  strStatus: string;
begin
   strStatus := '未知';
   lvService.Clear;
   if Assigned(AManager) then
   begin
     cnt := AManager.Count;
     for i := 0 to cnt -1 do
     begin
        srvItem := AManager[i];
        if Assigned(srvItem) then
        begin
          lvItem := lvService.Items.Add;
          if Assigned(lvItem) then
          begin
            lvItem.Caption := ' ' + srvitem.DisplayName;
            lvItem.Data := srvItem;
            lvItem.SubItems.Add(srvItem.Name);


            case srvItem.ServiceStatus.dwCurrentState of
              SERVICE_STOPPED:
              begin
                strStatus := '已停止';
                lvItem.ImageIndex := 1;
              end;
              SERVICE_START_PENDING:
              begin
                strStatus := '启动中';
                lvItem.ImageIndex := 2;
              end;
              SERVICE_STOP_PENDING:
              begin
                strStatus := '停止中';
                lvItem.ImageIndex := 2;
              end;
              SERVICE_RUNNING:
              begin
                strStatus := '已启动';
                lvItem.ImageIndex := 4;
              end;
              SERVICE_CONTINUE_PENDING:
              begin
                strStatus := '继续中';
                lvItem.ImageIndex := 2;
              end;
              SERVICE_PAUSE_PENDING:
              begin
                strStatus := '暂停中';
                lvItem.ImageIndex := 2;
              end;
              SERVICE_PAUSED:
              begin
                strStatus := '已暂停';
                lvItem.ImageIndex := 3;
              end;
            end;
            lvItem.SubItems.Add(strStatus);
          end;
        end;
     end;
   end;
end;

procedure TfrmMain.act_refreshExecute(Sender: TObject);
begin
  CurrentService_ := nil;
  CurrentCount_ := 0;
  SCManager_.Refresh;
  ascendingCompareDisplayName := True;
  SCManager_.Sort(CompareDisplayName);
  ascendingCompareDisplayName := not ascendingCompareDisplayName;
  EnabledActions();
end;

procedure TfrmMain.lvServiceColumnClick(Sender: TObject;
  Column: TListColumn);
begin
  EnabledActions();
  case Column.Index of
    0:
    begin
      SCManager_.Sort(CompareDisplayName);
      ascendingCompareDisplayName := not ascendingCompareDisplayName;
    end;
    1:
    begin
      SCManager_.Sort(CompareName);
      ascendingCompareName := not ascendingCompareName;
    end;
    2:
    begin
      SCManager_.Sort(CompareStatus);
      ascendingCompareState := not ascendingCompareState;
    end;

  else
  end;
  lvService.Hint := '';

end;

procedure TfrmMain.act_stopExecute(Sender: TObject);
var
  lvItem: TListItem;
  srvItem: TWin32Service;
begin
  lvItem := lvService.Selected;
  if Assigned(lvItem) then
  begin
     srvItem := TWin32Service(lvItem.Data);
     if Assigned(srvItem) then
     begin
       if Application.MessageBox(PChar('您确定要停止[' + srvItem.DisplayName
             + ']服务吗?'), '提醒', MB_YESNO + MB_ICONWARNING + MB_DEFBUTTON2) = ID_YES  then
       begin
          CurrentService_ := nil;
          CurrentCount_ := 0;
          srvItem.Stop;
       end;
     end;
  end;

end;

procedure TfrmMain.act_removeExecute(Sender: TObject);
var
  lvItem: TListItem;
  srvItem: TWin32Service;
begin
  lvItem := lvService.Selected;
  if Assigned(lvItem) then
  begin
     srvItem := TWin32Service(lvItem.Data);
     if Assigned(srvItem) then
     begin
       if Application.MessageBox(PChar('您确定要卸载[' + srvItem.DisplayName
            + ']服务吗?'), '提醒', MB_YESNO + MB_ICONWARNING + MB_DEFBUTTON2) = ID_YES  then
       begin
         CurrentService_ := nil;
         CurrentCount_ := 0;
         srvItem.Uninstall;
       end;
     end;
  end;
end;

procedure TfrmMain.act_startExecute(Sender: TObject);
var
  lvItem: TListItem;
  srvItem: TWin32Service;
begin
  lvItem := lvService.Selected;
  if Assigned(lvItem) then
  begin
     srvItem := TWin32Service(lvItem.Data);
     if Assigned(srvItem) then
     begin
       CurrentService_ := nil;
       CurrentCount_ := 0;
       srvItem.Start;
     end;
  end;

end;

procedure TfrmMain.EnabledActions;
var
  lvItem: TListItem;
  srvItem: TWin32Service;
begin

  lvItem := lvService.Selected;
  if Assigned(lvItem) then
  begin
     act_start.Enabled := SuperMode_;
     act_stop.Enabled := SuperMode_;
     act_remove.Enabled := SuperMode_;
     srvItem := TWin32Service(lvItem.Data);
     if Assigned(srvItem) then
     begin
       case srvItem.ServiceStatus.dwCurrentState of
         SERVICE_STOPPED:
         begin
            act_start.Enabled := True;
            act_remove.Enabled := True;
         end;
         SERVICE_RUNNING:
         begin
            act_stop.Enabled := True;
         end;
         SERVICE_PAUSED:
         begin
            act_stop.Enabled := True;
         end;
       end;
     end;
  end;
end;

procedure TfrmMain.lvServiceSelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
var
  lvItem: TListItem;
  srvItem: TWin32Service;
begin
  lvItem := lvService.Selected;
  if Assigned(lvItem) then
  begin
     srvItem := TWin32Service(lvItem.Data);
     if Assigned(srvItem) then
     lvService.Hint := srvItem.DisplayName;
  end;
  EnabledActions();

end;

procedure TfrmMain.tmrTimeTimer(Sender: TObject);
begin
  statusBar.Panels.Items[1].Text := FormatDateTime('yyyy-mm-dd hh:mm:ss   ', Now);
end;

procedure TfrmMain.UpdateView(AService: TWin32Service);
var
  lvItem: TListItem;
  strStatus, strOperStatus: string;
  enableStatusUpdateTmr: Boolean;
  i: Integer;
begin
  strStatus := '未知';
  strOperStatus := '';
  enableStatusUpdateTmr := False;
  if Assigned(AService) then
  begin
    lvItem := lvService.FindData(0, AService, False, True);
    if Assigned(lvItem) then
    begin
      lvItem.SubItems.Clear;
      lvItem.SubItems.Add(AService.Name);

      case AService.ServiceStatus.dwCurrentState of
        SERVICE_STOPPED:
        begin
          strStatus := '已停止';
          lvItem.ImageIndex := 1;
        end;
        SERVICE_START_PENDING:
        begin
          strStatus := '启动中';
          enableStatusUpdateTmr := true;
          lvItem.ImageIndex := 2;
        end;
        SERVICE_STOP_PENDING:
        begin
          strStatus := '停止中';
          enableStatusUpdateTmr := true;
          lvItem.ImageIndex := 2;
        end;
        SERVICE_RUNNING:
        begin
          strStatus := '已启动';
          lvItem.ImageIndex := 4;
        end;
        SERVICE_CONTINUE_PENDING:
        begin
          strStatus := '继续中';
          enableStatusUpdateTmr := true;
          lvItem.ImageIndex := 2;
        end;
        SERVICE_PAUSE_PENDING:
        begin
          strStatus := '暂停中';
          enableStatusUpdateTmr := true;
          lvItem.ImageIndex := 2;
        end;
        SERVICE_PAUSED:
        begin
          strStatus := '已暂停';
          lvItem.ImageIndex := 3;
        end;
      end;
      lvItem.SubItems.Add(strStatus);



      if enableStatusUpdateTmr then
      begin
        if (CurrentService_ = AService) then
        begin
          Inc(CurrentCount_);
          if (CurrentCount_ mod 2) = 0 then
            strOperStatus := '☆ ->'
          else
            strOperStatus := '★ ->';
          for i := 1 to CurrentCount_ do
          begin
            if i > 40 then
              break;
            strOperStatus := strOperStatus + '>>';
          end;

          lvItem.SubItems.Add(strOperStatus);
        end;
        CurrentService_ := AService;
        tmrServiceStatus.Enabled := True;
      end;


      EnabledActions();


    end;
  end;

end;

procedure TfrmMain.tmrServiceStatusTimer(Sender: TObject);
begin
   tmrServiceStatus.Enabled := False;
  if Assigned(CurrentService_) then
  begin
     CurrentService_.QueryStatus;
  end;

end;

end.

⌨️ 快捷键说明

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