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

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);