Bilgisayarda Firebird Kurulu mu Nasıl Öğreniriz ÇÖZÜLDÜ

[shochan]

S.a
Yaptığımız programda ilk açılışında bilgisayarda firebird kurulu olup olmadığını nasıl öğreniriz eğer kurulu değilse kullanıcıya bilgisayarda firebird kurulu değil şeklinde bi uyarı gelmesini nasıl sağlarız?

Umarım sorumu yeterince açıklamışımdır şimdiden ilgilenen arkadaşlara tşkler.

[azs]

Kod: Tümünü seç

Unit FbSetup;

Interface

uses Forms, Registry, Windows, Messages, Dialogs, WinSvc, SysUtils,variants,Strutils,  ShellAPI;


function  StopServer: Boolean;
function  InstallAndStartGuardian : Boolean;
function  StopAndDeinstallGuardian: Boolean;

// ekleme
function GetSysDirectory: string;
function IsAdmin: Boolean;
function IsNT: Boolean;
function ServiceStart(sMachine, sService: string): boolean;
function ServiceStop(sMachine, sService: string): boolean;

function GetFBRootDir: string;
function GetFBGuardianFile: string;
function GetFBIsqlFilePath: string;
function FBRunning : boolean;
function ShutDownFB: boolean;
function StartFB: boolean;
function FBInstalled: boolean;
// ekleme sonu

const
  SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
  SECURITY_BUILTIN_DOMAIN_RID = $00000020;
  DOMAIN_ALIAS_RID_ADMINS     = $00000220;

implementation

function FBInstalled: boolean;
var
     Filename: string;
     Running: boolean;
begin
     Running := FBRunning;
     if Running = false then begin
        filename := GetFBGuardianFile;
        if FileExists(Filename) then begin
           if FileExists(GetSysDirectory + '\gds32.dll') then result := true else result := false;
        end else result := false;
     end else result := true;
end;

function GetFBRootDir: string;
var
     Reg: TRegistry;
begin
     Reg := TRegistry.Create(KEY_READ);
     try
       Reg.RootKey := HKEY_LOCAL_MACHINE;
         if Reg.KeyExists('\Software\Firebird Project\Firebird Server\Instances') then begin
            if Reg.OpenKeyReadOnly('\Software\Firebird Project\Firebird Server\Instances') then begin
               if Reg.ValueExists('DefaultInstance') then begin
                  result := Reg.ReadString('DefaultInstance');
               end;
               Reg.CloseKey;
            end else result := '';
         end else result := '';
     finally
       Reg.free;
     end;
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;

function GetFBGuardianFile: string;
begin
     result := GetFBRootDir+'bin\fbguard.exe';
end;

function GetFBIsqlFilePath: string;
begin
     result := GetFBRootDir + 'bin';
end;

function IsNT: Boolean;
var
     OSVersion: TOSVersionInfo;
begin
     Result := False;
     OSVersion.dwOSVersionInfoSize := SizeOf(OSVersion);
     if (GetVersionEx(OSVersion)) then begin
        case OSVersion.dwPlatformID of
           VER_PLATFORM_WIN32_NT: Result := True;
        else
           Result := False;
        end;
     end;
end;

function IsAdmin: Boolean;
var
     hAccessToken: THandle;
     ptgGroups: PTokenGroups;
     dwInfoBufferSize: DWORD;
     psidAdministrators: PSID;
     x: Integer;
     bSuccess: BOOL;
begin
     if IsNT then begin
        Result := False;
        bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, hAccessToken);
        if not bSuccess then begin
           if GetLastError = ERROR_NO_TOKEN then
              bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, hAccessToken);
        end;
        if bSuccess then begin
           GetMem(ptgGroups, 1024);
           bSuccess := GetTokenInformation(hAccessToken, TokenGroups, ptgGroups, 1024, dwInfoBufferSize);
           CloseHandle(hAccessToken);
           if bSuccess then begin
              AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2, SECURITY_BUILTIN_DOMAIN_RID,
              DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, psidAdministrators);
              {$R-}
              for x := 0 to ptgGroups.GroupCount - 1 do begin
                    if EqualSid(psidAdministrators, ptgGroups.Groups[X].Sid) then begin
                    Result := True;
                    Break;
                 end;
              end;
              {$R+}
              FreeSid(psidAdministrators);
           end;
           FreeMem(ptgGroups);
        end;
     end else result := true; // If not running on Windows NT then admin = ok
end;

function StopServer: Boolean;
var
     lHWND: HWND;
     sFBPath, sExecName: string;
     lArray: array[0..255] of Char;
begin
     Result := False;
     if (IsNT = True) then begin
        sFBPath := GetFBRootDir;
        if (sFBPath <> '') then begin
           sExecName := Format('%s%s', [sFBPath, 'bin\instsvc.exe stop']);
           if (WinExec(StrPCopy(lArray, sExecName), 2) > 31) then  Result := True;
        end;
     end else begin
        lHWND := FindWindow('FB_Server', 'Firebird Server');
        if (PostMessage(lHWND, WM_CLOSE, 0, 0) <> Null) then Result := True;
        Application.ProcessMessages;
     end;
end;

function InstallAndStartGuardian: Boolean;
var
     sFBPath, sExecName: string;
     lArray: array[0..255] of Char;
     bResultInstall, bResultStart: Boolean;
begin
     Result := False;
     if (IsNT = True) then begin
        sFBPath := GetFBRootDir;
        if (sFBPath <> '') then begin
           //service install
           sExecName := Format('%s%s', [sFBPath,'bin\instsvc.exe i -s -g -a']);
           if (WinExec(StrPCopy(lArray, sExecName), 2) > 31) then result := True;
        end;
     end else begin
        bResultInstall := False;
        bResultStart   := False;
        sFBPath        := GetFBRootDir;
        with TRegistry.Create do
          try
            RootKey := HKEY_LOCAL_MACHINE;
            if (OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', False)=True) then begin
               WriteString('Firebird Guardian', sFBPath + 'bin\fbguard.exe -a');
               bResultInstall := True;
            end;
          finally
            CloseKey;
            Free;
          end;
          if (sFBPath <> '') then begin
             sExecName := Format('%s%s', [sFBPath, 'bin\fbguard.exe']);
             if (WinExec(StrPCopy(lArray, sExecName), 2) > 31) then bResultStart := True;
          end;
          if ((bResultInstall = True) and (bResultStart = True)) then Result := True;
     end;
end;

function StopAndDeinstallGuardian: Boolean;
var
     lHWND: HWND;
     sFBPath, sExecName: string;
     lArray: array[0..255] of Char;
     bResultDeInstall, bResultStop: Boolean;
begin
     Result := False;
     if (IsNT = True) then begin
        sFBPath := GetFBRootDir;
        if (sFBPath <> '') then begin
           //service stop and uninstall
           sExecName := Format('%s%s', [sFBPath, 'bin\instsvc.exe stop']);
           if (WinExec(StrPCopy(lArray, sExecName), 2) > 31) then begin
              sExecName := Format('%s%s', [sFBPath, 'bin\instsvc.exe r']);
              if (WinExec(StrPCopy(lArray, sExecName), 2) > 31) then Result := True;
           end;
        end;
     end else begin
        bResultStop := False;
        bResultDeinstall := False;
        lHWND := FindWindow('FB_Server', 'Firebird Server');
        if (PostMessage(lHWND, WM_CLOSE, 0, 0) <> Null) then bResultStop := True;
           Application.ProcessMessages;
           with TRegistry.Create do
              try
                RootKey := HKEY_LOCAL_MACHINE;
                if (OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', False) = True) then
                   bResultDeinstall := DeleteValue('Firebird Guardian');
              finally
                CloseKey;
                Free;
              end;
           if ((bResultStop = True) and (bResultDeinstall = True)) then Result := True;
     end;
end;

function FBRunning: boolean;
begin
     result := boolean(FindWindow('FB_Server', 'FireBird Server')
               or FindWindow('FB_Guard', 'FireBird Guardian'));
end;

function ShutDownFB: boolean;
var
     IBSRVHandle,
     IBGARHandle: THandle;
begin
     if IsNT then begin
        result := ServiceStop('', 'FirebirdGuardianDefaultInstance');
     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 := FBRunning;
     end;
end;

function StartFB: boolean;
var
     Filename: string;
     StartupInfo: TStartupInfo;
     ProcessInformation: TProcessInformation;
begin
     filename := GetFBGuardianFile;
     if FileExists(Filename) then begin
        if IsNT then begin
           result := ServiceStart('','FirebirdGuardianDefaultInstance');
        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;

// Ek fonksiyonlar

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;

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;

end.

Kullanımı:
IF FbSetup.FBInstalled= False THEN
Begin
Application.MessageBox('Firebird Kurulu Değil!!!','Mesaj Kutusu',mb_ok+mb_ICONWARNING);
End;

İçindeki diğer fonksiyonlarıda sen incele....

Bu benim ilk mesajım herkese hayırlı olsun...

[shochan]

@azs öncelikle hoşgeldin (:
ve yardımın için teşekkür ederim tam istediğim gibi oldu program