Solved

Shut down/Stop/Running/Restarting  IIS 5 From Delphi 7 ?

Posted on 2003-11-17
5
863 Views
Last Modified: 2007-12-19
Hi,
Do this work available for our administrators To
Shut down/stop/restart/start +ing  IIS 5 From his application ?

OS:windows 2000 advanced server

Thanks in advance for your Helps.
0
Comment
Question by:Imbeginner
5 Comments
 
LVL 4

Expert Comment

by:BedouinDN
ID: 9768058
OK, you should be able to use the ControlService function as IIS is a service.

I found this code on the web (http://www.elists.org/pipermail/delphi/2003-April/023621.html) and have tested it on 2K and XP and it seems to work quite well. (Used Messenger service as I do not run IIS)
You will need to include WinSvc.pas and the user must have the appropriate priveledges for this to work.

//-----------------------------IsServiceRunning---------------------------------------------------------------
function IsServiceRunning(ServiceName: PChar): Boolean;
var
  ServerStatus  : SERVICE_STATUS;
  SCMHandle     : SC_HANDLE;
  QryResult     : Integer;
begin
  Result := False;
   try
     { Open the Service Control Manager }
     SCMHandle := OpenSCManager(nil, nil, GENERIC_EXECUTE);
     if (SCMHandle <> 0) then
     begin
       { Open and Query the specified Service }
       QryResult := OpenService(SCMHandle,
ServiceName,SERVICE_QUERY_STATUS);
       QueryServiceStatus(QryResult, ServerStatus);
       if (ServerStatus.dwCurrentState = SERVICE_RUNNING) then
         Result := True
       else
         Result := False;
       CloseServiceHandle(QryResult);
       CloseServiceHandle(SCMHandle);
     end
     else
       (*MessageDlg('Error opening Service Manager.', mtError, [mbOK], 0);*)
   except
     (*MessageDlg('Error checking status of service', mtError, [mbOK], 0);*)
   end;
end;

//-------------------------------StartService--------------------------------------------------------------------------------

function ServiceStart(sMachine, sService: String) : Boolean;
var
  schm,
  schs: SC_Handle;
  ss: TServiceStatus;
  psTemp: PChar;
  dwChkP: DWord;
begin
  ss.dwCurrentState := 0;
  schm := OpenSCManager(PChar(sMachine), nil, SC_MANAGER_CONNECT);
  if (schm>0) then
  begin
    schs := OpenService(schm, PChar(sService), SERVICE_START or
      SERVICE_QUERY_STATUS);
    if (schs>0) then
    begin
      psTemp := nil;
      if (StartService(schs, 0, psTemp)) then
        if (QueryServiceStatus(schs, ss)) then
          while (SERVICE_RUNNING<>ss.dwCurrentState) do
          begin
            dwChkP := ss.dwCheckPoint;
            Sleep(ss.dwWaitHint);
            if (not QueryServiceStatus(schs, ss)) then
              Break;
            if (ss.dwCheckPoint < dwChkP) then
              Break;
          end;
      CloseServiceHandle(schs);
    end;
    CloseServiceHandle(schm);
  end;
  Result := SERVICE_RUNNING=ss.dwCurrentState;
end;

//-----------------------------------StopService--------------------------------------------------------------------------------


function ServiceStop(sMachine, sService: String) : Boolean;
var
  schm,
  schs: SC_Handle;
  ss: TServiceStatus;
  dwChkP: DWord;
begin
  schm := OpenSCManager(PChar(sMachine), nil, SC_MANAGER_CONNECT);
  if (schm>0) then
  begin
    schs := OpenService(schm, PChar(sService), SERVICE_STOP or
      SERVICE_QUERY_STATUS);
    if (schs>0) then
    begin
      if (ControlService(schs, SERVICE_CONTROL_STOP, ss)) then
        if (QueryServiceStatus(schs, ss)) then
          while (SERVICE_STOPPED<>ss.dwCurrentState) do
          begin
            dwChkP := ss.dwCheckPoint;
            Sleep(ss.dwWaitHint);
            if (not QueryServiceStatus(schs, ss)) then
              Break;
            if (ss.dwCheckPoint < dwChkP) then
              Break;
          end;
      CloseServiceHandle(schs);
    end;
    CloseServiceHandle(schm);
  end;
  Result := SERVICE_STOPPED=ss.dwCurrentState;
end;

Cheers.
Bedouin..
0
 

Author Comment

by:Imbeginner
ID: 9773920
one problem
when you start service, you can t say that your web site is started too.your coding only fire servicing for a special service.
0
 
LVL 17

Accepted Solution

by:
Wim ten Brink earned 50 total points
ID: 9777999
Oh, I have something better. The source of a nice trayicon application written in Delphi. Save the following code to a file called IIS.DPR and open it in Delphi. See how Delphi complains about a missing resource file but don't worry, it will generate a new one for you. Next, compile the thingie and you'll have something about 22 kb in size. Run it and you have a new trayicon installed.

program IIS;

{$R *.RES}

uses
  Windows,
  Messages,
  ShellAPI,
  WinSvc;

const
  UWM_TRAYICON = WM_USER + 10;
  MENUITEM_START = 101;
  MENUITEM_STOP = 102;
  MENUITEM_EXIT = 199;
  ID_TRAYICON = 1;
  ExStyle = WS_EX_TOOLWINDOW;
  Style = WS_CAPTION or WS_SYSMENU or WS_MINIMIZEBOX;
  StopApp: Boolean = False;
  sService = 'IIS Admin Service';
  sServiceWndClass = sService + ' TrayIcon';
  ServiceWndClass: TWndClass = (
    style: CS_CLASSDC or CS_PARENTDC;
    lpfnWndProc: nil;
    cbClsExtra: 0;
    cbWndExtra: 0;
    hInstance: 0;
    hIcon: 0;
    hCursor: 0;
    hbrBackground: color_btnface + 1;
    lpszMenuName: nil;
    lpszClassName: sServiceWndClass);
  DefaultNotify: TNotifyIconData = (
    cbSize: SizeOf(TNotifyIconData);
    Wnd: 0;
    uID: ID_TRAYICON;
    uFlags: NIF_MESSAGE or NIF_ICON or NIF_TIP;
    uCallBackMessage: UWM_TRAYICON;
    hIcon: 0;
    szTip: sService;
    );
  sServiceName = 'IISADMIN';

type
  TService = record
    Name: string;
    Service: string;
    Start: DWord;
    Stop: DWORD;
  end;

const
  Services: array[0..3] of TService = (
    (Name: 'IIS Admin Service'; Service: 'IISADMIN'; Start: 101; Stop: 102),
    (Name: 'FTP Publishing Service'; Service: 'MSFTPSVC'; Start: 103; Stop: 104),
    (Name: 'Simple Mail Transport Protocol (SMTP)'; Service: 'SMTPSVC'; Start: 105; Stop: 106),
    (Name: 'World Wide Web Publishing Service'; Service: 'W3SVC'; Start: 107; Stop: 108)
    );

function AddTrayIcon(AHandle: THandle): Boolean;
var
  NotifyIconData: TNotifyIconData;
begin
  NotifyIconData := DefaultNotify;
  NotifyIconData.Wnd := AHandle;
  NotifyIconData.hIcon := LoadIcon(hInstance, 'MAINICON');
  Result := Shell_NotifyIcon(NIM_ADD, @NotifyIconData);
end;

function DeleteTrayIcon(AHandle: THandle): Boolean;
var
  NotifyIconData: TNotifyIconData;
begin
  NotifyIconData := DefaultNotify;
  NotifyIconData.Wnd := AHandle;
  Result := Shell_NotifyIcon(NIM_DELETE, @NotifyIconData);
end;

var
  FManager: SC_HANDLE;
  FService: SC_HANDLE;
  AHandle: THandle;
  AMsg: TMsg;
  MutexHandle: THandle;
  ServiceStatus: TServiceStatus;

function ServiceRunning(const FServiceName: string = sServiceName): Boolean;
begin
  Result := False;
  FManager := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
  if (FManager <> 0) then begin
    FService := OpenService(FManager, PChar(FServiceName), SERVICE_ALL_ACCESS);
    if (FService = 0) then begin
      CloseServiceHandle(FManager);
      FManager := 0;
    end
    else begin
      if QueryServiceStatus(FService, ServiceStatus) then begin
        Result := (ServiceStatus.dwCurrentState = SERVICE_RUNNING);
      end;
    end;
    CloseServiceHandle(FManager);
    FManager := 0;
    if (FService <> 0) then begin
      CloseServiceHandle(FService);
      FService := 0;
    end;
  end;
end;

procedure ServiceFlip(const FServiceName: string = sServiceName);
var
  Wait: Integer;
  AllOK: Boolean;
  lpServiceArgVectors: PChar;
begin
  FManager := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
  if (FManager <> 0) then begin
    FService := OpenService(FManager, PChar(FServiceName), SERVICE_ALL_ACCESS);
    if (FService = 0) then begin
      CloseServiceHandle(FManager);
      FManager := 0;
    end
    else begin
      if (ServiceStatus.dwCurrentState = SERVICE_RUNNING) then begin
        if ControlService(FService, SERVICE_CONTROL_STOP, ServiceStatus) then begin
          Wait := 150;
          AllOK := QueryServiceStatus(FService, ServiceStatus);
          while AllOK and (Wait > 0) and (ServiceStatus.dwCurrentState <> SERVICE_STOPPED) do begin
            Sleep(100);
            dec(Wait);
            AllOK := QueryServiceStatus(FService, ServiceStatus);
          end;
        end;
      end
      else if (ServiceStatus.dwCurrentState = SERVICE_STOPPED) then begin
        lpServiceArgVectors := nil;
        StartService(FService, 0, lpServiceArgVectors);
        Wait := 150;
        AllOK := QueryServiceStatus(FService, ServiceStatus);
        while AllOK and (Wait > 0) and (ServiceStatus.dwCurrentState <> SERVICE_RUNNING) do begin
          Sleep(100);
          dec(Wait);
          AllOK := QueryServiceStatus(FService, ServiceStatus);
        end;
      end;
    end;
    CloseServiceHandle(FManager);
    FManager := 0;
    if (FService <> 0) then begin
      CloseServiceHandle(FService);
      FService := 0;
    end;
  end;
end;

function WindowProc(hWnd, uMsg, wParam, lParam: Integer): Integer; stdcall;
const
  FirstCall: Boolean = True;
  OldRunning: Boolean = True;
var
  Menu: HMENU;
  Pt: TPoint;
  I: Integer;
begin
  Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
  if (uMsg = WM_CONTEXTMENU) then begin
    GetCursorPos(Pt);
    Menu := CreatePopupMenu;
    for I := low(Services) to High(Services) do begin
      if ServiceRunning(Services[I].Service) then begin
        AppendMenu(Menu, MFT_STRING, MENUITEM_STOP, PChar('Stop ' + Services[I].Name));
      end
      else begin
        AppendMenu(Menu, MFT_STRING, MENUITEM_START, PChar('Start ' + Services[I].Name));
      end;
    end;
    AppendMenu(Menu, MFT_SEPARATOR, WM_NULL, '-');
    AppendMenu(Menu, MFT_STRING, MENUITEM_EXIT, 'E&xit');
    TrackPopupMenu(Menu, TPM_RIGHTBUTTON or TPM_TOPALIGN or TPM_LEFTALIGN, Pt.x, Pt.y, 0, hWnd, nil);
    DestroyMenu(Menu);
  end
  else if (uMsg = UWM_TRAYICON) then begin
    if (lParam = WM_LBUTTONDOWN) or (lParam = WM_RBUTTONDOWN) then begin
      PostMessage(hWnd, WM_CONTEXTMENU, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN));
    end;
  end
  else if (uMsg = WM_TIMER) then begin
    // Check if server is running.
  end
  else if (uMsg = WM_COMMAND) then begin
    if (LOWORD(wParam) = MENUITEM_EXIT) then begin
      PostQuitMessage(0);
    end
    else if (uMsg = WM_DESTROY) then begin
      StopApp := True;
    end
    else begin
      I := low(Services) - 1;
      repeat
        inc(I);
      until (I > High(Services)) or (LOWORD(wParam) = Services[I].Start) or (LOWORD(wParam) = Services[I].Stop);
      if (LOWORD(wParam) = Services[I].Start) or (LOWORD(wParam) = Services[I].Stop) then begin
        ServiceFlip(Services[I].Service);
      end;
    end;
  end;
end;

begin
  MutexHandle := CreateMutex(nil, True, sServiceWndClass);
  if (GetLastError = ERROR_ALREADY_EXISTS) then begin
    CloseHandle(MutexHandle);
  end
  else begin
    try
      ServiceWndClass.lpfnWndProc := @WindowProc;
      RegisterClass(ServiceWndClass);
      AHandle := CreateWindowEx(ExStyle, sServiceWndClass, nil, Style, 0, 0, 10, 10, GetDesktopWindow, 0, hInstance, nil);
      AddTrayIcon(AHandle);
      UpdateWindow(AHandle);
      while (GetMessage(aMsg, AHandle, 0, 0)) and not StopApp do begin
        TranslateMessage(aMsg);
        DispatchMessage(aMsg);
      end;
      DeleteTrayIcon(AHandle);
    finally
      ReleaseMutex(MutexHandle)
    end;
  end;
end.
0
 

Author Comment

by:Imbeginner
ID: 9780828
workshop_alex:
hi, I used delphi7 for my works,
I think this program has some errors in WindowProc  Function
On these lines
1-
line-196
else if (uMsg = WM_DESTROY) then begin
      StopApp := True;  <---- left side cannot be assigned

2-
line-217
 ServiceWndClass.lpfnWndProc := @WindowProc; <---- left side can not be assigned.
___________________

another thing is:
suppose that the IIS was started,sometimes when we openend iis manager in administrator
folder we saw that our default web site was not started(remain in stopped state) ,
do any way existed for starting my web default site or restarting IIS ?
0
 
LVL 2

Expert Comment

by:TheLeader
ID: 9829019
unit ServiceManager;

interface

uses Windows, Sysutils, WinSvc;


{
 this class requires the following access rights :

 SERVICE_CHANGE_CONFIG
 SERVICE_START
 SERVICE_STOP
 SC_MANAGER_CONNECT
 SC_MANAGER_ENUMERATE_SERVICE
 SC_MANAGER_QUERY_LOCK_STATUS

you must be an administrator

 }

type
  TServiceManager = class (TObject)
  private
    FServiceHandle: SC_Handle;
    FServiceManagerHandle: Int64;
    FServiceName: string;
    procedure SetServiceName(Value: string);
  public
    constructor Create;
    destructor Destroy; override;
    procedure SetServiceDescription(description: String);
    procedure StartService;
    procedure StopService;
    property ServiceName: string read FServiceName write SetServiceName;
  end;


  LPSERVICE_DESCRIPTIONA = ^SERVICE_DESCRIPTIONA;
  {$EXTERNALSYM LPSERVICE_DESCRIPTIONA}
  _SERVICE_DESCRIPTIONA = record
    lpDescription: LPSTR;
  end;
  {$EXTERNALSYM _SERVICE_DESCRIPTIONA}
  SERVICE_DESCRIPTIONA = _SERVICE_DESCRIPTIONA;
  {$EXTERNALSYM SERVICE_DESCRIPTIONA}
  TServiceDescriptionA = SERVICE_DESCRIPTIONA;
  PServiceDescriptionA = LPSERVICE_DESCRIPTIONA;

//
// Service description string
//

  LPSERVICE_DESCRIPTIONW = ^SERVICE_DESCRIPTIONW;
  {$EXTERNALSYM LPSERVICE_DESCRIPTIONW}
  _SERVICE_DESCRIPTIONW = record
    lpDescription: LPWSTR;
  end;
  {$EXTERNALSYM _SERVICE_DESCRIPTIONW}
  SERVICE_DESCRIPTIONW = _SERVICE_DESCRIPTIONW;
  {$EXTERNALSYM SERVICE_DESCRIPTIONW}
  TServiceDescriptionW = SERVICE_DESCRIPTIONW;
  PServiceDescriptionW = LPSERVICE_DESCRIPTIONW;

{$IFDEF UNICODE}
  SERVICE_DESCRIPTION = SERVICE_DESCRIPTIONW;
  {$EXTERNALSYM SERVICE_DESCRIPTION}
  LPSERVICE_DESCRIPTION = LPSERVICE_DESCRIPTIONW;
  {$EXTERNALSYM LPSERVICE_DESCRIPTION}
  TServiceDescription = TServiceDescriptionW;
  PServiceDescription = PServiceDescriptionW;
{$ELSE}
  SERVICE_DESCRIPTION = SERVICE_DESCRIPTIONA;
  {$EXTERNALSYM SERVICE_DESCRIPTION}
  LPSERVICE_DESCRIPTION = LPSERVICE_DESCRIPTIONA;
  {$EXTERNALSYM LPSERVICE_DESCRIPTION}
  TServiceDescription = TServiceDescriptionA;
  PServiceDescription = PServiceDescriptionA;
{$ENDIF}


LPVOID = Pointer;
{$EXTERNALSYM LPVOID}

const
  SERVICE_CONFIG_DESCRIPTION     = 1;
  {$EXTERNALSYM SERVICE_CONFIG_DESCRIPTION}


implementation


{
******************************* TServiceManager ********************************
}
constructor TServiceManager.Create;
var
  sMachine: string;
begin
  FServiceName := '';
  FServiceHandle := 0;

  sMachine := ''; // localhost is used when empty
  FServiceManagerHandle := OpenSCManager(PChar(sMachine), Nil, SC_MANAGER_CONNECT);


end;

destructor TServiceManager.Destroy;
begin

  if FServiceHandle <> 0 then
    CloseServiceHandle(FServiceHandle);

  CloseServiceHandle(FServiceManagerHandle);

  inherited;
end;


procedure TServiceManager.SetServiceDescription(description: String);
type
TFnc_ChangeServiceConfig2 = function(hService: SC_HANDLE; dwInfoLevel: DWORD;
                                     lpInfo: LPVOID): BOOL; stdcall;
var
  srvDesc: TServiceDescription;
  csc2: TFnc_ChangeServiceConfig2;
  dllHandle: THandle;
begin

  if FServiceHandle = 0 then begin
    Raise Exception.Create('TServiceManager.SetServiceDescription: Service not selected');
    Exit;
  end;

  srvDesc.lpDescription := pChar(Description);

  { this ChangeServiceConfigA doesn't exist on NT 4 and lover}
  dllHandle := 0;
  try
    dllHandle := LoadLibrary('advapi32');
    @csc2 := GetProcAddress(dllHandle, 'ChangeServiceConfig2A')
  except
    csc2 := nil;
  end;

  if Assigned(csc2) then begin
    try
      csc2(FServiceHandle, SERVICE_CONFIG_DESCRIPTION, @srvDesc);
    except

    end;
  end;

  try
    FreeLibrary(dllHandle);
  except

  end;



end;

procedure TServiceManager.SetServiceName(Value: string);
begin

  if Value = FServiceName then
    Exit;

  FServiceName := Value;

  if FServiceHandle <> 0 then
    CloseServiceHandle(FServiceHandle);

  FServiceHandle := OpenService(FServiceManagerHandle, PChar(FServiceName),
                    SERVICE_CHANGE_CONFIG or SERVICE_START or SERVICE_STOP);

end;

procedure TServiceManager.StartService;
var
  dummy: PChar;
begin

  if FServiceHandle = 0 then begin
    Raise Exception.Create('TServiceManager.StartService: Service not selected');
    Exit;
  end;

  winsvc.StartService(FServiceHandle, 0, dummy);

end;

procedure TServiceManager.StopService;
var
  stat: TServiceStatus;
begin

  if FServiceHandle = 0 then begin
    Raise Exception.Create('TServiceManager.StopService: Service not selected');
    Exit;
  end;

  ControlService(FServiceHandle, SERVICE_CONTROL_STOP, stat);
end;
end.


hope it helped...
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now