Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Conexiσn con bases de datos
Registrarse FAQ Miembros Calendario Guνa de estilo Buscar Temas de Hoy Marcar Foros Como Leνdos

Conexiσn con bases de datos

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 27-10-2004
Avatar de AGAG4
AGAG4 AGAG4 is offline
Miembro
 
Registrado: ago 2004
Ubicaciσn: Los Mochis, Sinaloa, Mιxico
Posts: 1.419
Poder: 15
AGAG4 Va por buen camino
Alguien sabe como hacer un ShotDown a Firebird 1.51????

Alguien sabe como hacer un ShotDown y volver a Abrir Firebird 1.51 por Cσdigo Delphi????

Agradezco cualquier comentario.
Responder Con Cita
  #2  
Antiguo 27-10-2004
Avatar de roman
roman roman is offline
Moderador
 
Registrado: may 2003
Ubicaciσn: Ciudad de Mιxico
Posts: 20.075
Poder: 10
roman Tiene un aura espectacularroman Tiene un aura espectacular
Yo no, pero cadetill sν

// Saludos
Responder Con Cita
  #3  
Antiguo 28-10-2004
Avatar de AGAG4
AGAG4 AGAG4 is offline
Miembro
 
Registrado: ago 2004
Ubicaciσn: Los Mochis, Sinaloa, Mιxico
Posts: 1.419
Poder: 15
AGAG4 Va por buen camino
Gracias Roman, pero ya lo habνa visto , el inconveniente es que se le olvido poner el cuerpo de las Siguientes Funciones:
Cσdigo Delphi [-]
    function GetEnumPriv : boolean;
    function GetSysDirectory : string;
    function GetServices(sMachine: string; sServices: TStrings): boolean;
    function IsNT : boolean;
    function IsAdmin: Boolean;
    function Display_status(status_code: DWORD) : string;
    function ExistService(sMachine, sService : string) : boolean;
    function ProcessRunning(Proces: string): boolean;
    function ServiceCreate(sMachine, sService, sDisplayName, sBinFile : string;
                 StartType : integer) : boolean;

σ bien en donde los puedo localizar????
Que tenga buen dνa.
Responder Con Cita
  #4  
Antiguo 28-10-2004
Avatar de AGAG4
AGAG4 AGAG4 is offline
Miembro
 
Registrado: ago 2004
Ubicaciσn: Los Mochis, Sinaloa, Mιxico
Posts: 1.419
Poder: 15
AGAG4 Va por buen camino
Ya los Encontre y lo muestro por si a alguien le sea de utilidad....
Cσdigo Delphi [-]
unit FireBirdUtils;


interface
  function ServiceStart(sMachine, sService : string ) : boolean;
  function ServiceStop(sMachine, sService : string ) : boolean;
  function IsNT: boolean;
  function FireBirdInstalled : boolean;
  function InterbaseInstalled : boolean;
  function GetSysDirectory: string;
  function StartInterbase: boolean;
  function GetInterbaseGuardianFile: string;
  function ShutDownInterbase: boolean;
  function IsWinNT: Boolean;
  function IsServerRunning: Boolean;
  function InterbaseRunning : boolean;
  function GetServerVersion: string;
  function GetServerVersionInsRun: string;

implementation
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, WinSvc, StdCtrls, registry,IBServices;
Const
  {Constante para FireBird}
  FB_ServerExeName = 'fbserver.exe';
  FB_RegKey = '\Software\Firebird Project\Firebird Server\Instances';
  IB_RegKey = '\Software\Borland\InterBase\CurrentVersion';
  FB_IB_RootDir = 'RootDirectory';
  FB_IB_ServerDir = 'ServerDirectory';
  FB_IB_ServerClass = 'IB_Server';
  FB_ServerClass = 'FB_Server';
  FB_IB_ServiceName = 'InterBaseServer';
  FB_AutoStartName = 'FirebirdServer';
  IB_Version = 'Version';
  FB_Version = 'Version';
  FDBAName = 'SYSDBA';
  FDBAPwd = 'masterkey';
  FDBALoginPrompt = false;
  
var
  VersionInfoAvailable: boolean;
  FIBInfo: TIBServerProperties;
  FServer, FDatabaseName: string;
  FUserName, FUserPwd: string;
  FCharSet: string;
  FSQLDialect: Integer;
  FProtocol: TProtocol;
  LastDBInfoRefresh: TDateTime;

function GetServerVersionInsRun: string;
begin
     result := '';
     try
          result := GetServerVersion;
     except result := '';
     end;
end;

function RefreshIBinfo(AnOption: TPropertyOption): boolean;
begin
  {crιι le composant ΰ la volιe}
     if FIBInfo = nil then FIBInfo := TIBServerProperties.Create(nil);
  {effectue la restauration}
     with FIBInfo, Params do
     try
          ServerName := FServer;
          if FServer = '' then Protocol := Local else Protocol := FProtocol;
          Clear;
          Add('user_name=' + FDBAName);
          Add('password=' + FDBAPwd);
          LoginPrompt := FDBALoginPrompt;
          Options := [AnOption];
          Active := True;
          case AnOption of
               Database:
                    begin
                         FetchDatabaseInfo;
                         LastDBInfoRefresh := Now;
                    end;
               ConfigParameters: FetchConfigParams;
               Version: FetchVersionInfo;
          end;
          Active := False;
          Result := True;
     except
          Result := False;
     end;
end;

  //—————————————————————————————————————————————————————————————————————————————
// Versiσn FireBird
//—————————————————————————————————————————————————————————————————————————————

function GetServerVersion: string;
begin
  if not VersionInfoAvailable then
    VersionInfoAvailable := RefreshIBInfo(Version);
  if VersionInfoAvailable then
    Result := FIBInfo.VersionInfo.ServerVersion
  else Result := '';
end;

//—————————————————————————————————————————————————————————————————————————————
// 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 FireBird estα en marcha
//—————————————————————————————————————————————————————————————————————————————

function InterbaseRunning : boolean;
begin
     result := boolean(FindWindow('fbServer','FireBird Server')
               or FindWindow('IB_Guard','FireBird Guardian'));
end;
//—————————————————————————————————————————————————————————————————————————————
// Returns true if applications runs on NT/2000
//—————————————————————————————————————————————————————————————————————————————
function IsNT: boolean;
var osv: TOSVERSIONINFO;
begin
     fillchar(osv, sizeof(TOSVERSIONINFO), 0);
     osv.dwOSVersionInfoSize := sizeof(TOSVERSIONINFO);
     GetVersionEx(osv);
     if (osv.dwPlatformId = VER_PLATFORM_WIN32_NT) then
          result := true
     else result := false;
end;

function IsServerRunning: Boolean;
//try to find the Firebird server window
begin
     Result := (FindWindow({FB_IB_ServerClass}FB_ServerClass, nil) <> 0);
end;

function IsWinNT: Boolean;
begin
     Result := (Win32Platform = VER_PLATFORM_WIN32_NT);
end;

//—————————————————————————————————————————————————————————————————————————————
// Shuts down Interbase
//—————————————————————————————————————————————————————————————————————————————
function ShutDownInterbase: boolean;
var IBSRVHandle, IBGARHandle: THandle;
begin
     if IsNT then
     begin
          result := ServiceStop('', 'InterBaseGuardian');
     end else
     begin
          IBGARHandle := FindWindow('FB_Guard', 'FireBird Guardian');
          if IBGARHandle > 0 then
          begin
               PostMessage(IBGARHandle, 31, 0, 0);
               PostMessage(IBGARHandle, 16, 0, 0);
          end;
          IBSRVHandle := FindWindow('FB_Server', 'FireBird Server');
          if IBSRVHandle > 0 then
          begin
               PostMessage(IBSRVHandle, 31, 0, 0);
               PostMessage(IBSRVHandle, 16, 0, 0);
          end;
          result := IsServerRunning;
     end;
end;
//—————————————————————————————————————————————————————————————————————————————
// Returns the full name to the Interbase guardian EXE file
//—————————————————————————————————————————————————————————————————————————————
function GetInterbaseGuardianFile: string;
var Filename: string;
     Reg: TRegistry;
begin
     result := '';
     Filename := '';
     Reg := TRegistry.Create(KEY_READ);
     try
          Reg.RootKey := HKEY_LOCAL_MACHINE;
          if Reg.KeyExists('Software\Borland\InterBase\CurrentVersion') then
          begin
               if Reg.OpenKeyReadOnly('Software\Borland\InterBase\CurrentVersion') then
               begin
                    //Filename := FixPath(Reg.ReadString('ServerDirectory')) + 'ibguard.exe';
                    Filename := Reg.ReadString('ServerDirectory') + '\ibguard.exe';
                    Reg.CloseKey;
               end;
          end
          else begin
               if Reg.KeyExists(FB_RegKey) then
               begin
                    if Reg.OpenKeyReadOnly(FB_RegKey) then
                    begin
                         //Filename := FixPath(Reg.ReadString('ServerDirectory')) + 'ibguard.exe';
                         Filename := Reg.ReadString('DefaultInstance') + 'bin\fbguard.exe';
                         Reg.CloseKey;
                    end;
               end;
          end;
     finally
          Reg.free;
     end;
     result := filename;
end;


//—————————————————————————————————————————————————————————————————————————————
// Starts 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;
     end
     else result := false;
end;

function GetSysDirectory: string;
var SysDir: Pchar;
begin
     SysDir := StrAlloc(255);
     try
          fillchar(SysDir^, 255, 0);
          GetSystemDirectory(SysDir, 255); // Get the "windows\system" directory
          result := SysDir;
     finally
          StrDispose(SysDir);
     end;
end;

//—————————————————————————————————————————————————————————————————————————————
// Saber si Interbase estα instalado
//—————————————————————————————————————————————————————————————————————————————
function InterbaseInstalled : boolean;
var Filename : string;
    Running : boolean;
begin
     Running := IsServerRunning;
     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;

function FireBirdInstalled : boolean;
var Filename : string;
    Running : boolean;
begin
     Running := IsServerRunning;
     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;

end.

Saludos.
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Bϊsqueda Avanzada
Desplegado

Normas de Publicaciσn
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El cσdigo vB estα habilitado
Las caritas estαn habilitado
Cσdigo [IMG] estα habilitado
Cσdigo HTML estα deshabilitado
Saltar a Foro


La franja horaria es GMT +2. Ahora son las 03:50:42.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Traducciσn al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi