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

Posted 2020-08-21 那里的天空

 

Delphi下检查SQL Server服务器当前运行状态！
要求：Ｄｅｌｐｈｉ下随时监控ＳＱＬ　Ｓｅｒｖｅｒ状态。
１、命令提示符下可用：TELNET <SQL Server IP> 1433　　检查。
２、Ｄｅｌｐｈｉ下如何模拟实现上述功能。
----------
原来做过：
function GetSqlServerStatus(lpszComputerName: LPCTSTR): Integer;
var
  ssStatus: SERVICE_STATUS;
  dwOldCheckPoint: DWORD;
  dwStartTickCount: DWORD;
  dwWaitTime: DWORD;
  dwStatus: DWORD;
  lpszServiceName: LPCTSTR;
  schSCManager: SC_HANDLE;
  schService: SC_HANDLE;
begin
  if (lpszComputerName <> nil) and
      ((StrComp(lpszComputerName, ‘127.0.0.1‘) = 0) or (StrComp(lpszComputerName, ‘.‘) = 0)) then
    lpszComputerName := nil;
  lpszServiceName := ‘MSSQLServer‘;
  schSCManager := OpenSCManager(
    lpszComputerName,         //Computer name
    nil,          // ServicesActive database
    SC_MANAGER_ALL_ACCESS);  // full access rights

  if schSCManager = 0 then
    GetSqlServerStatus := -1;        //Machine not exists
  schService := OpenService(
    schSCManager,          // SCM database
    lpszServiceName,          // service name
    SERVICE_ALL_ACCESS);
  if schService = 0 then  begin
    CloseServiceHandle(schService);
    GetSqlServerStatus := -2;  //SqlServer Service not Exists
  end;
  if not QueryServiceStatus(
    schService,   // handle to service
    ssStatus) then begin  // address of status information structure
    GetSqlServerStatus := -3;   //MyErrorExit(‘QueryServiceStatus‘);
  Result := ssStatus.dwCurrentState;
end;
//----------
网上找的,看看有用不
uses   Registry,   ShellAPI,   FileCtrl,   Unit2;  
  {$R   *.DFM}  
   
  function   IsNT:   Boolean;  
  begin  
      Result   :=   (Win32MajorVersion   >=   4)   and   (Win32Platform   =   VER_PLATFORM_WIN32_NT);  
  end;  
  var  
      IsExists:   Boolean   =   False;  
  function   IsExistsMSSQL:   Boolean;  
  const  
      MSSQLSERVER   =   ‘SOFTWARE/Microsoft/MSSQLServer‘;  
      Reg:   TRegistry;  
      Result   :=   IsExists;  
      if   Result   then   Exit;  
      if   not   IsNT   then  
          Reg   :=   TRegistry.Create   else  
          Reg   :=   TRegistry.Create(KEY_READ);  
      with   Reg   do  
      try  
          Reg.RootKey   :=   HKEY_LOCAL_MACHINE;  
          Result   :=   KeyExists(MSSQLSERVER);  
          IsExists   :=   Result;  
      finally  
          Free;  
      end;  
      MSSQL_98StartCommand   =   ‘scm   -action   1   -pwd   "%s"‘;  
      MSSQL_NTStartCommand   =   ‘net   start   mssqlserver‘;  
      MSSQL_98StopCommand   =   ‘scm   -action   6‘;  
      MSSQL_NTStopCommand   =   ‘net   stop   mssqlserver‘;  
  function   StartMSSQL(Pass:   string):   Boolean;  
      S:   string;  
      Screen.Cursor   :=   crHourGlass;  
          if   not   IsNT   then  
          S   :=   Format(MSSQL_98StartCommand,   [Pass])   else  
          S   :=   MSSQL_NTStartCommand;  
          try  
          WinExec(PChar(S),   SW_HIDE);  
          Result   :=   True;  
          except  
          Result   :=   False;  
          end;  
          Screen.Cursor   :=   crDefault;  
  function   StopMSSQL:   Boolean;  
          WinExec(MSSQL_98StopCommand,   SW_HIDE)   else  
          WinExec(MSSQL_NTStopCommand,   SW_HIDE);  
  procedure   TForm1.Button2Click(Sender:   TObject);  
      if   StartMSSQL(edPass.Text)   then  
          MessageBox(Handle,   ‘启动完成‘,   ‘完成‘,   MB_OK   +   MB_ICONINFORMATION);  
----------------------------------------------
program Project1;
uses
Windows,
WinSvc;
procedure RunMSSQLSERVICE;
SrvHandle: SC_HANDLE;
Service_Status: _SERVICE_STATUS;
SrvStatus : Integer;
try
SrvHandle := OpenSCManager(‘‘, SERVICES_ACTIVE_DATABASE, SC_MANAGER_ALL_ACCESS);
SrvHandle := OpenService(SrvHandle, PChar(‘MSSQLServer‘), SERVICE_QUERY_STATUS or SERVICE_START);
if QueryServiceStatus(SrvHandle, Service_Status)
then
SrvStatus := Service_Status.dwCurrentState;
if SrvStatus = SERVICE_STOPPED
Winexec(‘scm -action 1 -slient 1 -service mssqlserver ‘,sw_Normal);
except
RunMSSQLSERVICE;
end.
获取SQL Server服务器列表的几种方法
 
一、      SQL DMO
描述：SQL Distributed Management Objects（SQL分布式管理对象），存在于SQLDMO.dll文件中，实际上是一个COM 对象，通过调用SQL DMO的ListAvailableSQLServers方法取得。
列表类型：列举装有“客户端”和“服务端”的计算机。
适用条件：装有 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);