Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

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

Posted on 2003-11-17
5
Medium Priority
?
883 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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 150 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 does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Video by: ITPro.TV
In this episode Don builds upon the troubleshooting techniques by demonstrating how to properly monitor a vSphere deployment to detect problems before they occur. He begins the show using tools found within the vSphere suite as ends the show demonst…
This is my first video review of Microsoft Bookings, I will be doing a part two with a bit more information, but wanted to get this out to you folks.
Suggested Courses

705 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