uodbclistsqlservers.pas

MD5加密与解密的说明文件与,烦琐的加密不能解密

unit uODBCListSqlServers;
interface
Uses
  Classes,Windows,Sysutils;

Type
  TServersSearcher= Class(TThread)
  
    pEnv,pHdbc,pHenv:Pointer;
    StrBuffer:Pchar;
    cbStrOutCount:Integer;
    StrIn:String;
    Servers:TStrings;
  Public
    property Terminated;
    Constructor Create(InList:TStrings);
    Destructor Destroy ;Override;
    Procedure Execute;Override;
    Function GetServersFromString(Str:String):Boolean;
  End;
  SQLHANDLE    = Pointer;
  SQLSMALLINT  = SHORT;
  SQLINTEGER   = LongInt;
  PSQLHANDLE   = ^SQLHANDLE;
  SQLHENV      = SQLHANDLE;
  SQLHDBC      = SQLHANDLE;
  SQLRETURN    = SQLSMALLINT;
  SQLCHAR      = UCHAR;
  PSQLCHAR     = ^SQLCHAR;
  SQLPOINTER   = Pointer;
  PSQLSMALLINT = ^SQLSMALLINT;
const
  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 SQLAllocHandle(HandleType: SmallInt; InHandle: Pointer;  OutHandle: PPointer): SmallInt; stdcall; external 'odbc32.dll' name  'SQLAllocHandle';
Function SQLSetEnvAttr(EnvHandle: Pointer; Attribute: LongInt;  Value: Integer; StringLength: LongInt): SmallInt; stdcall; external  'odbc32.dll' name 'SQLSetEnvAttr';
function SQLBrowseConnect(HDBC: Pointer; szConnStrIn: Pchar;  cbConnStrIn: SmallInt; szConnStrOut: PChar;  cbConnStrOutMax: SmallInt; pcbConnStrOut: Pointer): SmallInt;  stdcall; external 'odbc32.dll' name 'SQLBrowseConnect';
function SQLDisconnect(ConHandle: Pointer): SmallInt; stdcall; external  'odbc32.dll' name 'SQLDisconnect';
function SQLFreeHandle(HandleType: SmallInt; Handle: Pointer): SmallInt;  stdcall; external  'odbc32.dll' name 'SQLFreeHandle';
implementation


{ TServersSearcher }
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
// 过程名称: TServersSearcher.Create
// 日期    : 2005-11-25 14:12:52 
// 参数    : Servers: TStrings
// 功能    : 创建
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
constructor TServersSearcher.Create(InList: TStrings);
Begin
  If Assigned(InList) Then
  Begin
    Servers:= InList;
    Self.FreeOnTerminate :=True;
    Inherited Create(True);
  End;
End;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
// 过程名称: TServersSearcher.Execute           
// 日期    : 2005-11-25 14:13:23 
// 参数    : 无
// 功能    :
//ReturnValue
// 0 :Terminate By User
// 1 :Success
// -1:Failure
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TServersSearcher.Execute;
Const
  BufferCount=5120;
begin
  inherited;
  ReturnValue:=0;
  Try
    Try
      // 分配ODBC环境句柄
      if SQLAllocHandle(SQL_HANDLE_ENV, Nil, @pHenv)=SQL_ERROR Then
        Exit;
      // 设置ODBC的版本
      If SQLSetEnvAttr(pHenv, SQL_ATTR_ODBC_VERSION, SQL_OV_ODBC3, 0)<> SQL_SUCCESS Then
        Exit;
      //分配连接句柄
      if SQLAllocHandle(SQL_HANDLE_DBC, pHenv, @pHdbc)<>SQL_SUCCESS Then
        Exit;
      GetMem(StrBuffer, BufferCount);
      StrIn:='Driver={SQL Server}';
      If SQLBrowseConnect(pHdbc,Pchar(StrIn), SQL_NTS, StrBuffer, BufferCount, @cbStrOutCount)<>SQL_ERROR Then
        If GetServersFromString(StrBuffer) Then
          Exit;
    Except
      ReturnValue:=-1;
    End;
  Finally
    FreeMem(StrBuffer,BufferCount);
    if Assigned(pHdbc) then
    begin
      SQLDisconnect(pHdbc);
      SQLFreeHandle(SQL_HANDLE_DBC, pHdbc);
      pHdbc := nil;
    end;
    if Assigned(pHenv) then
    begin
      SQLFreeHandle(SQL_HANDLE_ENV, pHenv);
      pHenv := nil;
    end;                   
  End;
  ReturnValue:=1;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
// 过程名称: TServersSearcher.Destroy           
// 日期    : 2005-11-25 14:24:55 
// 参数    : 无
// 功能    : 销毁
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
destructor TServersSearcher.Destroy;
begin
  Servers:=Nil;
  inherited;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
// 过程名称: TServersSearcher.GetServersFromString
// 日期    : 2005-11-25 15:21:20
// 参数    : Str: String
// 功能    : 从字符串里提取服务器名称 
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function TServersSearcher.GetServersFromString(Str: String): Boolean;
Var  
  iStart:Integer;
begin
  Result:=False;
  Servers.BeginUpdate;
  Try
    Servers.Clear;
    Delete(Str,1,Pos('={',Str)+1);
    Delete(Str,Pos('};',Str),Length(Str));
    iStart:=Pos(',',Str);
    While iStart>0 do
    Begin
      Servers.Add(Copy(Str,1,iStart-1));
      Delete(Str,1,iStart);
      iStart:=Pos(',',Str);
    End;
    If Str<>'' Then Servers.Add(Str);
    Result:=True;
  Finally
    Servers.EndUpdate;
  End;
end;

end.