使用odbc32.dll查看本机ODBC驱动程序和DSN

hewei

在积木网发现delphi使用odbc32.dll的代码，用以显示本机odbc驱动程序和dsn,我将代码复制到Lazarus中工程中，能成功执行！不敢独享，特与大家分享共同研究提高。
程序执行结果如下：

程序执行，并可查看！但退出是有错误提示，没找到原因，请有知道的朋友回帖。

程序源代码如下：
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
  //Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
  { TForm1 }
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
    function BreakList(const ANullTerminateText: array of Char): String;
  end;
  type USHORT = Word;
  SQLSMALLINT = SHORT;
  SQLRETURN = SQLSMALLINT;
  SQLINTEGER = Longint;
  SQLHANDLE = SQLINTEGER;
  SQLHENV = SQLHANDLE;
  SQLUSMALLINT = USHORT;
  SQLPCHAR = PChar;
const
  // DLL名
  odbc32 = 'odbc32.dll';
  SQL_SUCCESS = 0;
  SQL_SUCCESS_WITH_INFO = 1;
  SQL_INVALID_HANDLE = -2;
  SQL_ERROR = -1;
  SQL_NO_DATA = 100;
  SQL_NO_DATA_FOUND = SQL_NO_DATA;
  SQL_FETCH_NEXT = 1;
  SQL_FETCH_FIRST_USER = 31;
  SQL_FETCH_FIRST_SYSTEM = 32;
  SQL_FETCH_FIRST = 2;
  SQL_MAX_DSN_LENGTH = 32; // SQL_SUCCESS, SQL_SUCCESS_WITH_INFO, SQL_INVALID_HANDLE, SQL_ERROR
  function SQLAllocEnv(var EnvironmentHandle: SQLHENV): SQLRETURN; stdcall; external odbc32 name 'SQLAllocEnv';
  function SQLFreeEnv(EnvironmentHandle: SQLHENV): SQLRETURN; stdcall; external odbc32 name 'SQLFreeEnv'; // SQL_SUCCESS, SQL_SUCCESS_WITH_INFO, SQL_NO_DATA, SQL_ERROR, SQL_INVALID_HANDLE.
  function SQLDrivers( EnvironmentHandle: SQLHENV; Direction: SQLUSMALLINT; DriverDescription: SQLPCHAR; BufferLength1: SQLSMALLINT; var DescriptionLengthPtr: SQLSMALLINT; DriverAttributes: SQLPCHAR; BufferLength2: SQLSMALLINT; var AttributesLengthPtr: SQLSMALLINT): SQLRETURN; stdcall; external odbc32 name 'SQLDrivers'; // SQL_SUCCESS, SQL_SUCCESS_WITH_INFO, SQL_NO_DATA, SQL_ERROR, SQL_INVALID_HANDLE.
  function SQLDataSources( EnvironmentHandle: SQLHENV; Direction: SQLUSMALLINT; ServerName: SQLPCHAR; BufferLength1: SQLSMALLINT; var NameLength1Ptr: SQLSMALLINT; Description: SQLPCHAR; BufferLength2: SQLSMALLINT; var NameLength2Ptr: SQLSMALLINT): SQLRETURN; stdcall; external odbc32 name 'SQLDataSources';
var
  Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
function TForm1.BreakList(const ANullTerminateText: array of Char): String;
var
  LStart: Integer;
  LBuffer: array[0..255] of Char;
  LText: String;
begin
  LStart := 0;
  LText := ANullTerminateText;
  Result := LText;
  Inc(LStart, Length(LText) + 1);
  while (True) do
      begin FillChar(LBuffer, SizeOf(LBuffer), 0);
        Move(ANullTerminateText[LStart], LBuffer, SizeOf(LBuffer));
        LText := LBuffer;
        Inc(LStart, Length(LText) + 1);
        if (LText = '') then Break;
        Result := Result + ',' + AnsiQuotedStr(LText, '"');
      end;
end;

procedure TForm1.Button1Click(Sender: TObject);
const BUF_MAX = 1024;
var
  LEnvironmentHandle: SQLHENV;
  LDriverDescription: array[0..BUF_MAX] of Char;
  LDescriptionLengthPtr: SQLSMALLINT;
  LDriverAttributes: array[0..BUF_MAX] of Char;
  AttributesLengthPtr: SQLSMALLINT;
  LReturn: SQLRETURN;
  LText: String;
begin
  Memo1.Clear();
  try
    if (SQLAllocEnv(LEnvironmentHandle) = SQL_ERROR) then Exit;
       try
         FillChar(LDriverDescription, SizeOf(LDriverDescription), 0);
         FillChar(LDriverAttributes, SizeOf(LDriverAttributes), 0);
         LReturn := SQLDrivers(LEnvironmentHandle, SQL_FETCH_FIRST, LDriverDescription, BUF_MAX + 1, LDescriptionLengthPtr, LDriverAttributes, BUF_MAX + 1, AttributesLengthPtr);
         while (LReturn <> SQL_NO_DATA_FOUND) do
             begin
               LText := String(LDriverDescription);// + '/' + BreakList(LDriverAttributes);
               Memo1.Lines.Add(LText);
               FillChar(LDriverDescription, SizeOf(LDriverDescription), 0);
               FillChar(LDriverAttributes, SizeOf(LDriverAttributes), 0);
               LReturn := SQLDrivers(LEnvironmentHandle, SQL_FETCH_NEXT, LDriverDescription, BUF_MAX + 1, LDescriptionLengthPtr, LDriverAttributes, BUF_MAX + 1, AttributesLengthPtr);
             end;
        finally
            SQLFreeEnv(LEnvironmentHandle);
        end;
  except
    on E:Exception do
       Memo1.Lines.Add(E.Message);
  end;
end;
procedure TForm1.Button2Click(Sender: TObject);
const BUF_MAX = 1024;
var
  LEnvironmentHandle: SQLHENV;
  LServerName: array[0..SQL_MAX_DSN_LENGTH] of Char;
  LNameLength1Ptr: SQLSMALLINT;
  LDescription: array[0..BUF_MAX] of Char;
  LNameLength2Ptr: SQLSMALLINT;
  LReturn: SQLRETURN; LText: String;
begin
  Memo1.Clear();
  try
    if (SQLAllocEnv(LEnvironmentHandle) = SQL_ERROR) then Exit;
       try
         FillChar(LServerName, SizeOf(LServerName), 0);
         FillChar(LDescription, SizeOf(LDescription), 0);
         LReturn := SQLDataSources(LEnvironmentHandle, SQL_FETCH_FIRST, LServerName, SQL_MAX_DSN_LENGTH + 1, LNameLength1Ptr, LDescription, BUF_MAX + 1, LNameLength2Ptr);
         while (LReturn <> SQL_NO_DATA_FOUND) do
             begin
               LText := String(LServerName) + '/' + BreakList(LDescription);
               Memo1.Lines.Add(LText);
               FillChar(LServerName, SizeOf(LServerName), 0);
               FillChar(LDescription, SizeOf(LDescription), 0);
               LReturn := SQLDataSources(LEnvironmentHandle, SQL_FETCH_NEXT, LServerName, SQL_MAX_DSN_LENGTH + 1, LNameLength1Ptr, LDescription, BUF_MAX + 1, LNameLength2Ptr);
             end;
       finally
         SQLFreeEnv(LEnvironmentHandle);
       end;
  except
    on E:Exception do
       Memo1.Lines.Add(E.Message);
  end;
end;

end.
通过这段代码，大致学习到如何调用dll和函数的调用。