unit uBcpApi;
interface
uses {$IF CompilerVersion <= 22}
Windows;
{$ELSE}
Winapi.Windows;
{$ENDIF}
//ODBC
type
SQLHANDLE = Pointer;
SQLHENV = SQLHANDLE;
SQLHDBC = SQLHANDLE;
SQLCHAR = Char;
PSQLCHAR = ^SQLCHAR;
SQLHSTMT = SQLHANDLE;
SQLPOINTER = Pointer;
SQLSMALLINT = SmallInt;
SQLUSMALLINT = Word;
SQLINTEGER = Integer;
SQLRETURN = SQLSMALLINT;
SQLHWND = NativeUInt;
const
SQL_HANDLE_ENV = 1;
SQL_HANDLE_DBC = 2;
SQL_HANDLE_STMT = 3;
SQL_NULL_HANDLE = SQLHandle(0);
SQL_FETCH_NEXT = 1;
SQL_FETCH_FIRST = 2;
SQL_FETCH_LAST = 3;
SQL_FETCH_PRIOR = 4;
SQL_SUCCESS = 0;
SQL_SUCCESS_WITH_INFO = 1;
SQL_ATTR_ODBC_VERSION = 200;
SQL_OV_ODBC3 = ULong(3);
SQL_IS_UINTEGER = -5;
SQL_IS_INTEGER = -6;
SQL_COPT_SS_BASE = 1200;
SQL_COPT_SS_BCP = SQL_COPT_SS_BASE + 19;
SQL_BCP_ON = Long(1);
SQL_NTS = -3;
SQL_DRIVER_NOPROMPT = 0;
SQL_MAX_MESSAGE_LENGTH = 512; //FireDAC为4096
SQL_NO_DATA = 100;
SQL_NULL_HSTMT = SQLHandle(0);
//Bcp
type
DBINT = Long;
const
SUCCEED = 1;
FAIL = 0;
SUCCEED_ABORT = 2;
SUCCEED_ASYNC = 3;
DB_IN = 1;
DB_OUT = 2;
SQLCHARACTER = $2f;
SQL_VARLEN_DATA = -10;
BCPMAXERRS = 1;
BCPBATCH = 4;
type
//'ODBC32.DLL';
TSQLAllocHandle = function(HandleType: SQLSMALLINT; InputHandle: SQLHANDLE;
var OutputHandlePtr: SQLHANDLE): SQLRETURN; stdcall;
TSQLSetEnvAttr = function(EnvironmentHandle: SQLHENV; Attribute: SQLINTEGER;
ValuePtr: SQLPOINTER; StringLength: SQLINTEGER): SQLRETURN; stdcall;
TSQLDrivers = function(EnvironmentHandle: SQLHENV; Direction: SQLUSMALLINT;
DriverDescription: PSQLCHAR; BufferLength1: SQLSMALLINT;
var DescriptionLengthPtr: SQLSMALLINT; DriverAttributes: PSQLCHAR;
BufferLength2: SQLSMALLINT; var AttributesLengthPtr: SQLSMALLINT): SQLRETURN;
stdcall;
TSQLSetConnectAttr = function(ConnectionHandle: SQLHDBC; Attribute: SQLINTEGER;
ValuePtr: SQLPOINTER; StringLength: SQLINTEGER): SQLRETURN; stdcall;
TSQLDriverConnect = function(ConnectionHandle: SQLHDBC; WindowHandle: SQLHWND;
InConnectionString: PSQLCHAR; StringLength1: SQLSMALLINT;
OutConnectionString: PSQLCHAR; BufferLength: SQLSMALLINT;
var StringLength2Ptr: SQLSMALLINT; DriverCompletion: SQLUSMALLINT): SQLRETURN;
stdcall;
TSQLDisconnect = function(ConnectionHandle: SQLHDBC): SQLRETURN; stdcall;
TSQLFreeHandle = function(HandleType: SQLSMALLINT;
ConnectionHandle: SQLHDBC): SQLRETURN; stdcall;
TSQLGetDiagRec = function(HandleType: SQLSMALLINT; Handle: SQLHANDLE;
RecNumber: SQLSMALLINT; SQLState: PSQLCHAR; var NativeErrorPtr: SQLINTEGER;
MessageText: PSQLCHAR; BufferLength: SQLSMALLINT;
var TextLengthPtr: SQLSMALLINT): SQLRETURN; stdcall;
TSQLExecDirect = function(StatementHandle: SQLHSTMT; StatementText: PSQLCHAR;
TextLength: SQLINTEGER): SQLRETURN; stdcall;
TSQLNumResultCols = function(StatementHandle: SQLHSTMT;
var ColumnCountPtr: SQLSMALLINT): SQLRETURN; stdcall;
//'SQLNCLI11.DLL'
TBcp_Init = function(hdbc: SQLHDBC; szTable, szDataFile, szErrorFile: LPCWSTR;
eDirection: Integer): SQLRETURN; stdcall;
TBcp_Columns = function(hdbc: SQLHDBC; nColumns: Integer): SQLRETURN; stdcall;
TBcp_Colfmt = function(hdbc: SQLHDBC; idxUserDataCol: Integer; eUserDataType: BYTE;
cbIndicator: Integer; cbUserData: DBINT; pUserDataTerm: PByte;
cbUserDataTerm: Integer; idxServerCol: Integer): SQLRETURN; stdcall;
TBcp_Control = function(hdbc: SQLHDBC; eOption: Integer; iValue: NativeInt):
SQLRETURN; stdcall;
TBcp_Exec = function(hdbc: SQLHDBC; var pnRowsProcessed: DBINT):
SQLRETURN; stdcall;
var
SQLAllocHandle : TSQLAllocHandle;
SQLSetEnvAttr : TSQLSetEnvAttr;
SQLDrivers : TSQLDrivers;
SQLSetConnectAttr: TSQLSetConnectAttr;
SQLDriverConnect : TSQLDriverConnect;
SQLDisconnect : TSQLDisconnect;
SQLFreeHandle : TSQLFreeHandle;
SQLGetDiagRec : TSQLGetDiagRec;
SQLExecDirect : TSQLExecDirect;
SQLNumResultCols : TSQLNumResultCols;
Bcp_Init : TBcp_Init;
Bcp_Columns : TBcp_Columns;
Bcp_Colfmt : TBcp_Colfmt;
Bcp_Control : TBcp_Control;
Bcp_Exec : TBcp_Exec;
implementation
end.
unit uBCP;
interface
type
TDataFormat = (fmtChar, fmtNative);
IBcp = interface['{E38D0CE4-CAEF-4353-B812-BD213099CE2F}']
function DataIn (TableName, FileName: String): Boolean;
function DataOut(TableName, FileName: String): Boolean;
function Connect: Boolean; overload;
function Connect(aServer, aUser, aPassword: String): Boolean; overload;
procedure SetServer (aServer : String);
procedure SetUser (aUser : String);
procedure SetPassword(aPassword: String);
procedure SetDatabase(aDatabase: String);
procedure SetBatchSize(aBatchSize: Int64);
procedure SetDataFormat(aDataFormat: TDataFormat);
function GetBatchSize: Int64;
function GetErrorMsg: String;
function GetRowsProcessed: Integer;
property Server : String write SetServer;
property User : String write SetUser;
property Password: String write SetPassword;
property Database: String write SetDatabase;
property DataFormat: TDataFormat write SetDataFormat;
property RowsProcessed: Integer read GetRowsProcessed;
property BatchSize: Int64 read GetBatchSize write SetBatchSize;
property ErrorMsg: String Read GetErrorMsg;
end;
TiBcp = class
class function Create: IBcp;
class function LoadBcpDll: String;
end;
implementation
uses {$IF CompilerVersion <= 22} //delphi xe及更老的版本
Windows, SysUtils, Classes;
{$ELSE}
WinApi.Windows, System.SysUtils, System.Classes,
{$ENDIF}
uBcpApi;
type
TBcp = class(TInterfacedObject, IBcp)
private
FErrorMsg: String;
FConnected: Boolean;
FRowsProcessed: DBINT;
FDataFormat: TDataFormat;
FhEnv, FhDbc, FhStmt: Pointer;
FMaxErrs, FBatchSize: NativeInt;
FServer, FUser, FPassword, FDatabase: String;
class var cvDllLoaded: SmallInt;
class var cvSQLDriver, cvBcpDLLFileName: String;
class function GetSysDriverList: TStringList;
procedure SetServer(aServer: String);
procedure SetUser (aUser : String);
procedure SetPassword(aPassword: String);
procedure SetDatabase(aDatabase: String);
procedure SetBatchSize(aBatchSize: Int64);
procedure SetDataFormat(aDataFormat: TDataFormat);
function GetBatchSize: Int64;
function GetRowsProcessed: Integer;
function GetErrorMsg: String;
function RCheck(aRetCode: SQLRETURN): Boolean; inline;
function Exec(TableName, FileName: String; Direction: Integer): Boolean;
function GetDiagRecInfo: String;
public
class function LoadBcpDll: String;
function DataIn (TableName, FileName: String): Boolean;
function DataOut(TableName, FileName: String): Boolean;
function Connect: Boolean; overload;
function Connect(aServer, aUser, aPassword: String): Boolean; overload;
property Server : String write SetServer;
property User : String write SetUser;
property Password: String write SetPassword;
property Database: String write SetDatabase;
property DataFormat: TDataFormat write SetDataFormat;
property RowsProcessed: Integer read GetRowsProcessed;
property BatchSize: Int64 read GetBatchSize write SetBatchSize;
property ErrorMsg: String Read GetErrorMsg;
constructor Create ; overload;
destructor Destroy; override;
end;
class function TiBcp.Create: IBcp;
begin
Result := TBcp.Create;
end;
class function TiBcp.LoadBcpDll: String;
begin
Result := TBcp.LoadBcpDll;
end;
constructor TBcp.Create;
begin
inherited;
FhDbc := SQL_NULL_HANDLE;
FhEnv := SQL_NULL_HANDLE;
FhStmt:= SQL_NULL_HANDLE;
FDatabase := 'master';
FConnected := False;
FBatchSize := 1000;
FMaxErrs := 1; //只要出现一个错误,就会报错(默认是10个错误才会报错)
FDataFormat := fmtNative;
if cvDllLoaded = 0 then
LoadBcpDll;
if cvDllLoaded = 1 then {0: 未加载; 1:加载成功; -1:加载过,但不成功}
begin
SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, FhEnv);
SQLSetEnvAttr(FhEnv, SQL_ATTR_ODBC_VERSION, SQLPOINTER(SQL_OV_ODBC3), SQL_IS_UINTEGER);
SQLAllocHandle(SQL_HANDLE_DBC, FhEnv, FhDbc);
SQLSetConnectAttr(FhDbc, SQL_COPT_SS_BCP, SQLPOINTER(SQL_BCP_ON), SQL_IS_INTEGER);
end;
end;
destructor TBcp.Destroy;
begin
if Assigned(FhDbc) then
begin
SQLDisconnect(FhDbc);
SQLFreeHandle(SQL_HANDLE_DBC, FhDbc);
end;
if Assigned(FhEnv) then
SQLFreeHandle(SQL_HANDLE_ENV, FhEnv);
inherited;
end;
class function TBcp.LoadBcpDll: String;
var
I: SmallInt;
FOdbcDllHandle, FBCPDllHandle: THandle;
SysDriverList, SQLDriverList, BcpDllList: TStringList;
begin
cvDllLoaded := -1;
Result := '';
FOdbcDllHandle := LoadLibrary(PChar('ODBC32.DLL'));
{$IFDEF UNICODE}
@SQLDriverConnect := GetProcAddress(FOdbcDllHandle, 'SQLDriverConnectW');
@SQLDrivers := GetProcAddress(FOdbcDllHandle, 'SQLDriversW' );
@SQLGetDiagRec := GetProcAddress(FOdbcDllHandle, 'SQLGetDiagRecW' );
@SQLExecDirect := GetProcAddress(FOdbcDllHandle, 'SQLExecDirectW' );
{$ELSE}
@SQLDriverConnect := GetProcAddress(FOdbcDllHandle, 'SQLDriverConnectA');
@SQLDrivers := GetProcAddress(FOdbcDllHandle, 'SQLDriversA' );
@SQLGetDiagRec := GetProcAddress(FOdbcDllHandle, 'SQLGetDiagRecA' );
@SQLExecDirect := GetProcAddress(FOdbcDllHandle, 'SQLExecDirectA' );
{$ENDIF}
@SQLAllocHandle := GetProcAddress(FOdbcDllHandle, 'SQLAllocHandle' );
@SQLSetEnvAttr := GetProcAddress(FOdbcDllHandle, 'SQLSetEnvAttr' );
@SQLAllocHandle := GetProcAddress(FOdbcDllHandle, 'SQLAllocHandle' );
@SQLSetConnectAttr:= GetProcAddress(FOdbcDllHandle, 'SQLSetConnectAttr');
@SQLDisconnect := GetProcAddress(FOdbcDllHandle, 'SQLDisconnect' );
@SQLFreeHandle := GetProcAddress(FOdbcDllHandle, 'SQLFreeHandle' );
@SQLNumResultCols := GetProcAddress(FOdbcDllHandle, 'SQLNumResultCols' );
SQLDriverList := TStringList.Create;
BcpDllList := TStringList.Create;
SQLDriverList.Add('SQL Server Native Client 11.0');
SQLDriverList.Add('SQL Server Native Client 10.0');
SQLDriverList.Add('SQL Server Native Client' );
SQLDriverList.Add('SQL Server' );
BcpDllList.DelimitedText := 'SQLNCLI11.DLL, SQLNCLI10.DLL, SQLNCLI.DLL, ODBCBCP.DLL';
SysDriverList := GetSysDriverList;
for I := 0 to SQLDriverList.Count-1 do
begin
if SysDriverList.IndexOf(SQLDriverList[I]) >=0 then
begin
cvSQLDriver := SQLDriverList[I];
cvBcpDLLFileName := BcpDllList[I];
FBCPDllHandle := LoadLibrary(PChar(cvBcpDLLFileName));
{$IFDEF UNICODE}
@Bcp_Init := GetProcAddress(FBCPDllHandle, 'bcp_initW' );
{$ELSE}
@Bcp_Init := GetProcAddress(FBCPDllHandle, 'bcp_initA' );
{$ENDIF}
@Bcp_Columns := GetProcAddress(FBCPDllHandle, 'bcp_columns');
@Bcp_Colfmt := GetProcAddress(FBCPDllHandle, 'bcp_colfmt' );
@Bcp_Control := GetProcAddress(FBCPDllHandle, 'bcp_control');
@Bcp_Exec := GetProcAddress(FBCPDllHandle, 'bcp_exec' );
cvDllLoaded := 1;
Result := cvBcpDLLFileName;
Break;
end;
end;
SysDriverList.Free;
SQLDriverList.Free;
BcpDllList.Free;
end;
class function TBcp.GetSysDriverList: TStringList;
var
hEnv: SQLHANDLE;
Len1, Len2, RetCode: SQLSMALLINT;
Description: array[0..255] of SQLCHAR;
Str: String;
begin
Result := TStringList.Create;
SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, hEnv);
SQLSetEnvAttr(hEnv, SQL_ATTR_ODBC_VERSION, SQLPOINTER(SQL_OV_ODBC3), SQL_IS_UINTEGER);
RetCode := SQLDrivers(hEnv, SQL_FETCH_FIRST, @Description,
Sizeof(Description), Len1, nil, 0, Len2);
while RetCode <> SQL_NO_DATA do
begin
Str := String(Description);
Result.Add(Str);
RetCode := SQLDrivers(hEnv, SQL_FETCH_NEXT, @Description,
Sizeof(Description), Len1, nil, 0, Len2);
end;
if Assigned(hEnv) then
SQLFreeHandle(SQL_HANDLE_ENV, hEnv);
end;
function TBcp.RCheck(aRetCode: SQLRETURN): Boolean;
begin
Result := (aRetCode = SQL_SUCCESS) or (aRetCode = SQL_SUCCESS_WITH_INFO);
end;
function TBcp.Connect: Boolean;
var
Len: SQLSMALLINT;
ConnectStr: String;
OutConnectStr: array[0..511] of SQLCHAR;
begin
ConnectStr := Format('DRIVER={%s};Server=%s;Database=%s;Uid=%s;Pwd=%s;',
[cvSQLDriver, FServer, FDatabase, FUser, FPassword]);
Result := RCheck(SQLDriverConnect(FhDbc, 0, PSQLCHAR(ConnectStr),
SQL_NTS, @OutConnectStr, SizeOf(OutConnectStr), Len, SQL_DRIVER_NOPROMPT));
FConnected := Result;
end;
function TBcp.Connect(aServer, aUser, aPassword: String): Boolean;
begin
FServer := aServer;
FUser := aUser;
FPassword := aPassword;
Result := Connect;
end;
function TBcp.Exec(TableName, FileName: String; Direction: Integer): Boolean;
const
ColTerm: array[0..0] of Byte = (9); //TAB
RowTerm: array[0..1] of Byte = (13, 10); //RETURN
var
SqlStr: String;
I, ColCount: SQLSMALLINT;
ExecResult: SQLRETURN;
begin
Result := False;
FRowsProcessed := -1;
if (Bcp_Init(FhDbc, PChar(TableName), PChar(FileName), nil, Direction) <> SUCCEED) then
Exit;
if (FDataFormat = fmtChar) then //bep文件格式为文本格式
begin
SQLAllocHandle(SQL_HANDLE_STMT, FhDbc, FhStmt); //创建SQL语句的句柄FhStmt
SqlStr := (Format('select * from %s where 1=2', [TableName]));
if (SQLExecDirect(FhStmt, PSQLCHAR(SqlStr), SQL_NTS) <> SQL_SUCCESS) then
begin
SQLFreeHandle(SQL_HANDLE_STMT, FhStmt); //释放SQL语句的句柄FhStmt
Exit;
end;
SQLNumResultCols(FhStmt, ColCount);
SQLFreeHandle(SQL_HANDLE_STMT, FhStmt); //释放SQL语句的句柄FhStmt
Bcp_Columns(FhDbc, ColCount); //找到表的列数
for I := 1 to ColCount-1 do
begin
Bcp_Colfmt(FhDbc, I, SQLCHARACTER, 0, SQL_VARLEN_DATA, @ColTerm, 1, I);
end;
Bcp_Colfmt(FhDbc, ColCount, SQLCHARACTER, 0, SQL_VARLEN_DATA, @RowTerm, 2, ColCount);
end;
Bcp_Control(FhDbc, BCPBATCH , FBatchSize);
Bcp_Control(FhDbc, BCPMAXERRS, FMaxErrs );
ExecResult := Bcp_Exec(FhDbc, FRowsProcessed);
FErrorMsg := GetDiagRecInfo;
if (ExecResult = SUCCEED) and (FErrorMsg = '') then
Result := True;
end;
function TBcp.DataIn(TableName, FileName: String): Boolean;
begin
Result := Exec(TableName, FileName, DB_IN)
end;
function TBcp.DataOut(TableName, FileName: String): Boolean;
begin
Result := Exec(TableName, FileName, DB_OUT)
end;
function TBcp.GetDiagRecInfo: String;
var
StateCode: String;
IsFirstLine: Boolean;
RecNo, MsgLen: SQLSMALLINT;
pzSql, pzMsg: PSQLCHAR;
NativeError: SQLINTEGER;
SqlState: array[1..6] of SQLCHAR;
Msg: array[1..SQL_MAX_MESSAGE_LENGTH] of SQLCHAR;
begin
Result := '';
if not Assigned(FhDbc) then Exit;
pzSql := @SqlState;
pzMsg := @Msg;
RecNo := 1; //DiagRec的记录号从1开始
IsFirstLine := True;
while (SQLGetDiagRec(SQL_HANDLE_DBC, FhDbc, RecNo, pzSql,
NativeError, pzMsg, Sizeof(Msg), MsgLen) <> SQL_NO_DATA) do
begin
StateCode := String(pzSql);
if Copy(StateCode, 1, 2) <> '01' then
begin //把01开头的sqlstate(警告)看成是正常的
if (IsFirstLine) then
IsFirstLine := False
else
Result := Result + #13#10;
Result := Result + Format('SQLState = %5s; NativeError = %d; Error = %s',
[StateCode, NativeError, String(pzMsg)]);
end;
Inc(RecNo);
{https://docs.microsoft.com/en-us/sql/odbc/reference/appendixes/
appendix-a-odbc-error-codes?view=sql-server-2017}
//SQLState:
//'01'开头: 警告,返回值为SQL_SUCCESS_WITH_INFO
//'IM'开头: ODBC具体实现上的专属错误或警告
//其他:错误
end;
end;
procedure TBcp.SetServer(aServer: String);
begin
FServer := aServer;
end;
procedure TBcp.SetUser(aUser: String);
begin
FUser := aUser;
end;
procedure TBcp.SetPassword(aPassword: String);
begin
FPassword := aPassword;
end;
procedure TBcp.SetDatabase(aDatabase: String);
begin
if (FDatabase <> aDatabase) then
begin
FDatabase := aDatabase;
if FConnected then
begin //重新建立连接
SQLDisconnect(FhDbc);
FConnected := False;
Connect;
end;
end;
end;
procedure TBcp.SetDataFormat(aDataFormat: TDataFormat);
begin
FDataFormat := aDataFormat;
end;
procedure TBcp.SetBatchSize(aBatchSize: Int64);
begin
FBatchSize := aBatchSize;
end;
function TBcp.GetBatchSize: Int64;
begin
Result := FBatchSize;
end;
function TBcp.GetRowsProcessed: Integer;
begin
Result := FRowsProcessed;
end;
function TBcp.GetErrorMsg: String;
begin
Result := FErrorMsg
end;
end.
-----------------------------------------------------------------------------示例------------------------------------------------------------------------------------
unit Unit1;
interface
uses
{$IF CompilerVersion <= 22}
Windows, Messages, SysUtils, Variants,
Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, uBCP;
{$ELSE}
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
Vcl.StdCtrls, uBCP;
{$ENDIF}
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Memo1: TMemo;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
Bcp: IBcp;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Bcp := TiBcp.Create;
with Bcp do
begin
DataFormat := fmtChar; //默认为fmtNative
BatchSize := 2000; //默认为1000
Server := 'LocalHost';
User := 'sa';
Password := '********';
Database := 'TestDB'; //默认为master
Connect;
end;
end;
procedure TForm1.Button1Click(Sender: TObject); //导出
begin
Bcp.DataFormat := fmtChar;
Bcp.Database := 'TestDB';
if Bcp.DataOut('Test', 'd:\Test.bcp') then
Memo1.Lines.Add('导出成功,导出行数为' + IntToStr(Bcp.RowsProcessed) + '行.');
//else
Memo1.Lines.Add(Bcp.ErrorMsg);
end;
procedure TForm1.Button2Click(Sender: TObject); //导入
begin
Bcp.DataFormat := fmtChar;
Bcp.Database := 'master';
if Bcp.DataIn('TestDB.dbo.Test2', 'd:\Test.bcp') then
Memo1.Lines.Add('导入成功,导入行数为' + IntToStr(Bcp.RowsProcessed) + '行.');
//else
Memo1.Lines.Add(Bcp.ErrorMsg);
end;
end.