sqlapi.~pas

自己写的一个动态访问SQL数据的程序

  unit   sqlapi;
    
  interface   
    
  uses   Windows,   Classes,   Sysutils,   Dialogs;   
    
  type   UShort       =   Word;   
  type   PShort       =   ^Short;
  type   LPShort     =   PShort;   
  type   PUShort     =   ^UShort;   
  type   LPUShort   =   PUShort;   
    
  const   LOC_SEARCH                   =   $0001;   
  const   NET_SEARCH                   =   $0002;   
    
  const   ENUM_SUCCESS               =   $0000;   
  const   MORE_DATA                     =   $0001;   
  const   NET_NOT_AVAIL             =   $0002;   
  const   OUT_OF_MEMORY             =   $0004;   
  const   NOT_SUPPORTED             =   $0008;   
  const   ENUM_INVALID_PARAM   =   $0010;   
    
  function   SQLServerAvailable(const   ServerName:   string):   Boolean;   
  function   GetSQLServerNames(const   AList:   TStrings):   Integer;   
    
  implementation   
    
  function   GetSQLServerNames(const   AList:   TStrings):   Integer;   
  var   Entries:   UShort;   
          Buffer:   array[0..4095]   of   Char;       //4K缓冲区，我想足够了   
          nLoop:   Integer;   
          pServer:   PChar;   
          hInst:   HModule;   
          _dbserverenum:   function(SearchMode:   UShort;   szBuff:   PChar;   
                                                          cbSizeBuff:   UShort;   nEntries:   LPUShort):   Integer;   stdcall;   
    
  begin   
      Result   :=   NOT_SUPPORTED;   
      hInst   :=   LoadLibrary('ntwdblib.dll');   
      if   hInst   <>   0   then   
      begin   
          Entries   :=   Length(Buffer);   
          ZeroMemory(@Buffer,   Entries);   
          try   
              @_dbserverenum   :=   GetProcAddress(hInst,   'dbserverenum');   
              if   Assigned(_dbserverenum)   then   
                  Result   :=   _dbserverenum(NET_SEARCH   or   LOC_SEARCH,   Buffer,   Entries,   @Entries);   
          finally   
              FreeLibrary(hInst);   
          end;   
          if   (Result   =   ENUM_SUCCESS)   and   (Entries   >   0)   then   
          begin   
              pServer   :=   Buffer;   
              for   nLoop   :=   1   to   Entries   do   
              begin   
                  AList.Add(UpperCase(pServer));   
                  Inc(pServer,   StrLen(pServer)   +   1);   
              end;   
          end   else   Result   :=   NOT_SUPPORTED;   
      end   else   MessageBox(GetDesktopWindow,   '可能没有安装SQL   Server客户端程序',   '错误提示'   ,   
                                              MB_OK   or   MB_ICONWARNING   or   MB_TOPMOST   or   MB_SETFOREGROUND);   
  end;   
    
  function   SQLServerAvailable(const   ServerName:   string):   Boolean;   
  var   AList:   TStringList;   
          AServer:   String;   
  begin   
      AServer   :=   UpperCase(ServerName);   
      AList   :=   TStringList.Create;   
      Result   :=   GetSQLServerNames(AList)   =   ENUM_SUCCESS;   
      if   Result   then   
      try   
          Result   :=   AList.IndexOf(AServer)   <>   -1;   
      finally   
          FreeAndNil(AList);   
      end;   
  end;