当前位置:Gxlcms > 数据库问题 > Delphi下检查SQL Server服务器当前运行状态!

Delphi下检查SQL Server服务器当前运行状态!

时间:2021-07-01 10:21:17 帮助过:31人阅读


适用条件:装有 SQL Server,且有SQLDMO.dll文件。
速度:中
调用示例:GetSQLServerList(ListBox1.items);
代码:
  ComObj;
function GetSQLServerList(var AList: TStrings): Boolean;
  SQLServerApp: Variant;
  ServerList: Variant;
  i: Integer;
  Result := True;
  try
    SQLServerApp := CreateOleObject(‘SQLDMO.Application‘);
    ServerList := SQLServerApp.ListAvailableSQLServers;
    for i := 1 to ServerList.Count do
      AList.Add(ServerList.Item(i));
    SQLServerApp := Unassigned;
    ServerList := Unassigned;
  except
    Result := False;
二、      NetServerEnum
描述:网络服务函数,存在于NetApi32.dll文件中;通过NetServerEnum函数可取得装有SQL Server服务端的计算机列表,只装有SQL Server客户端的计算机将不会被列举其中;如果一台计算机的SQL Server服务刚刚启动,那么此函数将会过很久才能取到该计算机。
列表类型:仅列举装有“服务端”的计算机。
适用条件:有NetApi32.dll文件。
速度:快
type
  NET_API_STATUS = DWORD;
  PServerInfo100 = ^TServerInfo100;
  _SERVER_INFO_100 = record
    sv100_platform_id: DWORD;
    sv100_name: LPWSTR;
  {$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;
  NetAPIStatus: DWORD;
  dwLevel: DWORD;
  pReturnSvrInfo: Pointer;
  dwPrefMaxLen: DWORD;
  dwEntriesRead: DWORD;
  dwTotalEntries: DWORD;
  dwServerType: DWORD;
  dwResumeHandle: PDWORD;
  pCurSvrInfo: PServerInfo100;
  i, j: Integer;
    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;
        // 循环取得所有SQL Server服务器
        i := 0;
        j := dwEntriesRead;
        while i < j do
        begin
          if pCurSvrInfo = nil then
            Break;
          with AList do
            Add(pCurSvrInfo^.sv100_name);
          Inc(i);
          Inc(pCurSvrInfo);
        end;
      end;
    finally
      if Assigned(pReturnSvrInfo) then
        NetApiBufferFree(pReturnSvrInfo);
    end;
三、      SQLBrowseConnect
描述:ODBC函数(Microsoft Open Database Connectivity,开放式数据库连接),存在于odbc32.dll文件中;通过SQLBrowseConnect函数可返回连接字符串信息,包括DSN、DRIVER、SERVER、UID、PWD、APP、WSID、DATABASE、LANGUAGE等信息。在函数GetODBCInfo 中传入itServer、itDatabase、itLanguage可分别取得“服务器”、“数据库”及“语言”等信息列表,其中 itDatabase、itLanguage默认取本地信息,取远程信息请自行修改“‘Driver={SQL Server};SERVER=(local);UID=sa;PWD=‘”连接字符串。
适用条件:由于MDAC 2.6 、2.6 SP1、2.7和Microsoft ODBC Driver for SQL Server 2000 2000.80.194有Bug,因此在这些版本中此函数无法取得Microsoft SQL Server 7.0的服务器。
调用示例:GetODBCInfo(ListBox1.items, itServer);
  TInfoType = (itServer, itDatabase, itLanguage);
  SQLHANDLE    = Pointer;
  SQLSMALLINT  = SHORT;
  SQLINTEGER   = LongInt;
  PSQLHANDLE   = ^SQLHANDLE;
  SQLHENV      = SQLHANDLE;
  SQLHDBC      = SQLHANDLE;
  SQLRETURN    = SQLSMALLINT;
  SQLCHAR      = UCHAR;
  PSQLCHAR     = ^SQLCHAR;
  SQLPOINTER   = Pointer;
  PSQLSMALLINT = ^SQLSMALLINT;
function SQLAllocHandle(HandleType: SQLSMALLINT; InputHandle: SQLHANDLE;
  OutputHandle: PSQLHANDLE): SQLRETURN; stdcall; external ‘odbc32.dll‘ name
  ‘SQLAllocHandle‘;
function SQLSetEnvAttr(EnvironmentHandle: SQLHENV; Attribute: SQLINTEGER;
  Value: SQLPOINTER; StringLength: SQLINTEGER): SQLRETURN; stdcall; external
  ‘odbc32.dll‘ name ‘SQLSetEnvAttr‘;
function SQLBrowseConnect(hdbc: SQLHDBC; szConnStrIn: PSQLCHAR;
  cbConnStrIn: SQLSMALLINT; szConnStrOut: PSQLCHAR;
  cbConnStrOutMax: SQLSMALLINT; pcbConnStrOut: PSQLSMALLINT): SQLRETURN;
  stdcall; external ‘odbc32.dll‘ name ‘SQLBrowseConnect‘;
function SQLDisconnect(ConnectionHandle: SQLHDBC): SQLRETURN; stdcall; external
  ‘odbc32.dll‘ name ‘SQLDisconnect‘;
function SQLFreeHandle(HandleType: SQLSMALLINT; Handle: SQLHANDLE): SQLRETURN;
  stdcall; external  ‘odbc32.dll‘ name ‘SQLFreeHandle‘;
  SQL_HANDLE_ENV        = 1;
  SQL_HANDLE_DBC        = 2;
  SQL_NULL_HANDLE       = LongInt(0);
  SQL_SUCCESS           = 0;
  SQL_ERROR             = -1;
  SQL_ATTR_ODBC_VERSION = 200;
  SQL_OV_ODBC3          = ULONG(3);
  SQL_NTS               = -3;
function GetODBCInfo(var AList: TStrings; InfoType: TInfoType): Boolean;
  ConnStrOutMax = 4824;
  SplitterStr = ‘={‘;
  HENV: SQLHENV;
  HDBC: SQLHDBC;
  RetCode: SQLRETURN;
  ConnStrOut: PSQLCHAR;
  cbConnStrOut: SQLSMALLINT;
  ConnStrIn, TmpStr: string;
  TmpPos: Integer;
  case InfoType of
    itServer: ConnStrIn := ‘Driver={SQL Server}‘;
    itDatabase, itLanguage: ConnStrIn := ‘Driver={SQL Server};SERVER=(local);UID=sa;PWD=‘;
  Result := False;
    // 分配 ODBC 环境句柄
    RetCode := SQLAllocHandle(SQL_HANDLE_ENV, SQLPOINTER(SQL_NULL_HANDLE), @HENV);
    if RetCode = SQL_ERROR then
      Exit;
    // 设置 ODBC 版本
    RetCode := SQLSetEnvAttr(HENV, SQL_ATTR_ODBC_VERSION, SQLPointer(SQL_OV_ODBC3), 0);
    if RetCode <> SQL_SUCCESS then
    // 分配数据库连接句柄
    RetCode := SQLAllocHandle(SQL_HANDLE_DBC, HENV, @HDBC);
    GetMem(ConnStrOut, ConnStrOutMax);
    RetCode := SQLBrowseConnect(HDBC, PSQLCHAR(ConnStrIn), SQL_NTS, ConnStrOut,
      ConnStrOutMax, @cbConnStrOut);
    if RetCode <> SQL_ERROR then
    begin
      TmpStr := PChar(ConnStrOut);
      if InfoType = itLanguage then
        Delete(TmpStr, 1, AnsiPos(‘};‘, TmpStr) + 1);
      Delete(TmpStr, 1, AnsiPos(SplitterStr, TmpStr) + 1);
      Delete(TmpStr, AnsiPos(‘}‘, TmpStr), Length(TmpStr));
      while TmpStr <> ‘‘ do
        TmpPos := AnsiPos(‘,‘, TmpStr);
        if TmpPos > 0 then
          AList.Add(Copy(TmpStr, 1, TmpPos - 1))
        else
          AList.Add(TmpStr);
          TmpStr := ‘‘;
        Delete(TmpStr, 1, TmpPos)
      Result := True;
    FreeMem(ConnStrOut, ConnStrOutMax);
  finally
    if Assigned(HDBC) then
      SQLDisconnect(HDBC);
      SQLFreeHandle(SQL_HANDLE_DBC, HDBC);
      HDBC := nil;
    if Assigned(HENV) then
      SQLFreeHandle(SQL_HANDLE_ENV, HENV);
      HENV := nil;
-------------------
构造一个连接字串,从一个ini文件读取参数。
var AppIni: TIniFile;
  IniFile, TFStr,: string;
  Source, User, Passwd, DBase: string;
  IniFile := ChangeFileExt(Application.ExeName, ‘.INI‘);
  if FileExists(IniFile) then
  begin
    AppIni := TIniFile.Create(IniFile);
      Source := AppIni.ReadString(‘DataBaseSet‘, ‘Source‘, ‘‘);
      User := AppIni.ReadString(‘DataBaseSet‘, ‘User‘, ‘‘);
      Passwd := AppIni.ReadString(‘DataBaseSet‘, ‘Passwd‘, ‘‘);
      DBase := AppIni.ReadString(‘DataBaseSet‘, ‘DBase‘, ‘‘);
      Provider := AppIni.ReadString(‘DataBaseSet‘, ‘Provider‘, ‘‘);
      //Provider := ‘SQLOLEDB.1‘
    if Ado.Passwd = ‘‘ then TFStr := ‘False‘ else TFStr := ‘True‘;
    ADOCon.Close();
    ADOCon.ConnectionString :=
      ‘Locale Identifier=2052‘ +
      ‘;Use Procedure for Prepare=1‘ +
      ‘;Auto Translate=True‘ +
      ‘;Packet Size=4096‘ +
      ‘;Persist Security Info=‘ + TFStr +
      ‘;Provider=‘ + Ado.Provider +
      ‘;Password=‘ + Ado.Passwd +
      ‘;Workstation ID=‘ + Ado.Source +
      ‘;Connect Timeout=‘ + IntToStr(Ado.Time) +
      ‘;User ID=‘ + Ado.User +
      ‘;Data Source=‘ + Ado.Source +
      ‘;Initial Catalog=‘ + ADO.DBase;
    ADOCon.Open();
      Application.MessageBox(‘数据库连接失败,请通知系统管理员‘, ‘提示‘, MB_ICONWARNING);

     

Delphi下检查SQL Server服务器当前运行状态!

标签:分布式   prepare   修改   const   etc   2.7   win32   lis   cursor   

人气教程排行