Ver Mensaje Individual
  #2  
Antiguo 18-05-2004
__cadetill __cadetill is offline
Miembro
 
Registrado: may 2003
Posts: 3.387
Reputaciσn: 25
__cadetill Va por buen camino
Cσdigo Delphi [-]
//—————————————————————————————————————————————————————————————————————————————
// Parar un servicio en NT
//—————————————————————————————————————————————————————————————————————————————
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 begin
     if (QueryServiceStatus(schs,ss)) then begin
      while (SERVICE_STOPPED <> ss.dwCurrentState) do begin
       dwChkP := ss.dwCheckPoint;
       Sleep(ss.dwWaitHint);
       if (not QueryServiceStatus(schs,ss))then begin
        break;
       end;
       if (ss.dwCheckPoint < dwChkP) then begin
        break;
       end;
      end;
     end;
    end;
    CloseServiceHandle(schs);
   end;
   CloseServiceHandle(schm);
  end;
  Result := (SERVICE_STOPPED = ss.dwCurrentState);
end;

//—————————————————————————————————————————————————————————————————————————————
// Arrancar un servicio en NT
//—————————————————————————————————————————————————————————————————————————————
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 begin
     if (QueryServiceStatus(schs,ss)) then begin
      while (SERVICE_RUNNING <> ss.dwCurrentState) do begin
       dwChkP := ss.dwCheckPoint;
       Sleep(ss.dwWaitHint);
       if (not QueryServiceStatus(schs,ss)) then begin
        break;
       end;
       if (ss.dwCheckPoint < dwChkP) then begin
        break;
       end;
      end;
     end;
    end;
    CloseServiceHandle(schs);
   end;
   CloseServiceHandle(schm);
  end;
  Result := SERVICE_RUNNING = ss.dwCurrentState;
end;

//—————————————————————————————————————————————————————————————————————————————
// Saber si Interbase estα en marcha
//—————————————————————————————————————————————————————————————————————————————
function InterbaseRunning : boolean;
begin
     result := boolean(FindWindow('IB_Server','InterBase Server')
               or FindWindow('IB_Guard','InterBase Guardian'));
end;

//—————————————————————————————————————————————————————————————————————————————
// Parar Interbase
//—————————————————————————————————————————————————————————————————————————————
function ShutDownInterbase : boolean;
var IBSRVHandle,IBGARHandle : THandle;
begin
     if IsNT then begin
       result := ServiceStop('','InterBaseGuardian');
     end
     else
     begin
          IBGARHandle := FindWindow('IB_Guard','InterBase Guardian');
          if IBGARHandle > 0 then
          begin
               PostMessage(IBGARHandle,31,0,0);
               PostMessage(IBGARHandle,16,0,0);
          end;
          IBSRVHandle := FindWindow('IB_Server','InterBase Server');
          if IBSRVHandle > 0 then
          begin
               PostMessage(IBSRVHandle,31,0,0);
               PostMessage(IBSRVHandle,16,0,0);
          end;
          result := InterbaseRunning;
     end;

     try
        CreaFicheroFlag;
     except
     end
end;

//—————————————————————————————————————————————————————————————————————————————
// Arrancar Interbase
//—————————————————————————————————————————————————————————————————————————————
function StartInterbase : boolean;
var Filename : string;
    StartupInfo: TStartupInfo;
    ProcessInformation: TProcessInformation;
begin
     filename := GetInterbaseGuardianFile;
     if FileExists(Filename) then
     begin
       if IsNT then begin
          result := ServiceStart('','InterBaseGuardian');
       end
       else
       begin
            Fillchar(StartupInfo,Sizeof(TStartupInfo),0);
            StartupInfo.cb := sizeof(StartupInfo);
            StartupInfo.lpReserved := nil;
            StartupInfo.lpTitle:= nil;
            StartupInfo.lpDesktop := nil;
            StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
            StartupInfo.wShowWindow := SW_SHOWNA;
            StartupInfo.cbReserved2 := 0;
            StartupInfo.lpReserved2 := nil;
            result := CreateProcess(nil,PChar(filename),nil,nil,False,NORMAL_PRIORITY_CLASS,
             nil,PChar(ExtractFilePath(filename)),StartupInfo,ProcessInformation);
       end;
       BorraFicheroFlag;
     end
     else result := false;
end;

//—————————————————————————————————————————————————————————————————————————————
// Saber si Interbase estα instalado
//—————————————————————————————————————————————————————————————————————————————
function InterbaseInstalled : boolean;
var Filename : string;
    Running : boolean;
begin
     Running := InterbaseRunning;
     if Running = false then
     begin
          filename := GetInterbaseGuardianFile;
          if FileExists(Filename) then
             result := FileExists(IncludeTrailingPathDelimiter(GetSysDirectory)+'gds32.dll')
          else result := false;
     end
     else result := true;
end;

Creo que es todo

Ϊltima ediciσn por __cadetill fecha: 18-05-2004 a las 09:31:18.
Responder Con Cita