Gönderen Konu: Yüklü MS SQL Server İsimlerini (instancename) Alma (Okunma sayısı 2657 defa)

dynamo · « : 30 Mayıs 2007 14:07:49 »

local bilgisyarda ve yerel ağda yüklü olan birden fazla SQL Server'lerin listesini alır:

unit SQLServerLists;

interface

uses Windows,Classes,Types;

type
   NET_API_STATUS = DWORD;
   PServerInfo100 = ^TServerInfo100;
   _SERVER_INFO_100 = record
   sv100_platform_id: DWORD;
   sv100_name: LPWSTR;
end;

{$EXTERNALSYM _SERVER_INFO_100}
TServerInfo100 = _SERVER_INFO_100;
SERVER_INFO_100 = _SERVER_INFO_100;
{$EXTERNALSYM SERVER_INFO_100}

const
   NERR_Success = 0;
   MAX_PREFERRED_LENGTH = DWORD(-1);
   SV_TYPE_SQLSERVER = $00000004;

function NetApiBufferAllocate(ByteCount: DWORD; var Buffer: Pointer):
NET_API_STATUS; stdcall; external 'netapi32.dll' name 'NetApiBufferAllocate';

function NetServerEnum(ServerName: LPCWSTR; Level: DWORD; var BufPtr: Pointer;
PrefMaxLen: DWORD; var EntriesRead: DWORD; var TotalEntries: DWORD;
ServerType: DWORD; Domain: LPCWSTR; ResumeHandle: PDWORD): NET_API_STATUS;
stdcall; external 'netapi32.dll' name 'NetServerEnum';

function NetApiBufferFree(Buffer: Pointer): NET_API_STATUS; stdcall; external
'netapi32.dll' name 'NetApiBufferFree';

function GetSQLServerList(var AList: TStrings; pwcServerName: PWChar = nil;
pwcDomain: PWChar = nil): Boolean;

implementation

//çalışabilir durumdaki sql server instance listesi
function GetSQLServerList(var AList: TStrings; pwcServerName: PWChar = nil;pwcDomain: PWChar = nil): Boolean;
var
   NetAPIStatus: DWORD;
   dwLevel: DWORD;
   pReturnSvrInfo: Pointer;
   dwPrefMaxLen: DWORD;
   dwEntriesRead: DWORD;
   dwTotalEntries: DWORD;
   dwServerType: DWORD;
   dwResumeHandle: PDWORD;
   pCurSvrInfo: PServerInfo100;
   i, j: Integer;
begin
   Result := True;
   try
      dwLevel := 100;
      pReturnSvrInfo := nil;
      dwPrefMaxLen := MAX_PREFERRED_LENGTH;
      dwEntriesRead := 0;
      dwTotalEntries := 0;
      dwServerType := SV_TYPE_SQLSERVER;
      dwResumeHandle := nil;

      NetApiBufferAllocate(SizeOf(pReturnSvrInfo), pReturnSvrInfo);
      try
         NetAPIStatus := NetServerEnum(pwcServerName, dwLevel, pReturnSvrInfo,
         dwPrefMaxLen, dwEntriesRead, dwTotalEntries, dwServerType, pwcDomain,
         dwResumeHandle);
         if ((NetAPIStatus = NERR_Success) or (NetAPIStatus = ERROR_MORE_DATA)) and (pReturnSvrInfo <> nil) then
         begin
            pCurSvrInfo := pReturnSvrInfo;

            i := 0;
            j := dwEntriesRead;
            while i < j do
            begin
               if pCurSvrInfo = nil then
                  Break;

               AList.Add (pCurSvrInfo^.sv100_name);
               Inc(i);
               Inc(pCurSvrInfo);
            end;
         end;
      finally
         if Assigned(pReturnSvrInfo) then
            NetApiBufferFree(pReturnSvrInfo);
      end;
   except
      Result := False;
   end;
end;


end.

bu uniti projede uses kısmına ekleyin.ComboBox'a sql server listesini doldurur :

Kod: [Seç]

procedure TForm1.Button1Click(Sender: TObject);
var
   sqlServerName:TStrings;
   i:Integer;
begin
   sqlServerName:=TStringList.Create;
   GetSQLServerList(sqlServerName);
   for i := 0 to sqlServerName.Count-1 do
      ComboBox1.Items.Add(sqlServerName.Strings[i]);
   sqlServerName.Free;

end;

mıstık_karaca · « **Yanıtla #1 :** 14 Mart 2008 15:32:43 »

emeğine sağlık çok işime yaradı

Kodbank İndir

Gönderen Konu: Yüklü MS SQL Server İsimlerini (instancename) Alma (Okunma sayısı 2657 defa)

dynamo

Yüklü MS SQL Server İsimlerini (instancename) Alma

mıstık_karaca

Ynt: Yüklü MS SQL Server İsimlerini (instancename) Alma