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

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.
ImbeginnerAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

BedouinDNCommented:
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
ImbeginnerAuthor Commented:
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
Wim ten BrinkSelf-employed developerCommented:
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
ImbeginnerAuthor Commented:
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
TheLeaderCommented:
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
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.