⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 sdinf.pas

📁 SQLDirect Component Library is a light-weight Borland Database Engine replacement for Borland Delphi
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  FSQLCopyDesc        	:= B_SQLCopyDesc;
  FSQLDataSources     	:= B_SQLDataSources;
  FSQLDescribeCol     	:= B_SQLDescribeCol;
  FSQLDisconnect      	:= B_SQLDisconnect;
  FSQLEndTran         	:= B_SQLEndTran;
  FSQLError           	:= B_SQLError;
  FSQLExecDirect      	:= B_SQLExecDirect;
  FSQLExecute         	:= B_SQLExecute;
  FSQLFetch           	:= B_SQLFetch;
  FSQLFetchScroll     	:= B_SQLFetchScroll;
  FSQLFreeConnect     	:= B_SQLFreeConnect;
  FSQLFreeEnv         	:= B_SQLFreeEnv;
  FSQLFreeHandle      	:= B_SQLFreeHandle;
  FSQLFreeStmt        	:= B_SQLFreeStmt;
  FSQLGetConnectAttr  	:= B_SQLGetConnectAttr;
  FSQLGetConnectOption	:= B_SQLGetConnectOption;
  FSQLGetCursorName   	:= B_SQLGetCursorName;
  FSQLGetData         	:= B_SQLGetData;
  FSQLGetDescField    	:= B_SQLGetDescField;
  FSQLGetDescRec      	:= B_SQLGetDescRec;
  FSQLGetDiagField    	:= B_SQLGetDiagField;
  FSQLGetDiagRec      	:= B_SQLGetDiagRec;
  FSQLGetEnvAttr      	:= B_SQLGetEnvAttr;
  FSQLGetFunctions    	:= B_SQLGetFunctions;
  FSQLGetInfo         	:= B_SQLGetInfo;
  FSQLGetStmtAttr     	:= B_SQLGetStmtAttr;
  FSQLGetStmtOption   	:= B_SQLGetStmtOption;
  FSQLGetTypeInfo     	:= B_SQLGetTypeInfo;
  FSQLNumResultCols   	:= B_SQLNumResultCols;
  FSQLParamData       	:= B_SQLParamData;
  FSQLPrepare         	:= B_SQLPrepare;
  FSQLPutData         	:= B_SQLPutData;
  FSQLRowCount        	:= B_SQLRowCount;
  FSQLSetConnectAttr  	:= B_SQLSetConnectAttr;
  FSQLSetConnectOption	:= B_SQLSetConnectOption;
  FSQLSetCursorName   	:= B_SQLSetCursorName;
  FSQLSetDescField    	:= B_SQLSetDescField;
  FSQLSetDescRec      	:= B_SQLSetDescRec;
  FSQLSetEnvAttr      	:= B_SQLSetEnvAttr;
  FSQLSetParam        	:= B_SQLSetParam;
  FSQLSetStmtAttr     	:= B_SQLSetStmtAttr;
  FSQLSetStmtOption   	:= B_SQLSetStmtOption;
  FSQLSpecialColumns  	:= B_SQLSpecialColumns;
  FSQLStatistics      	:= B_SQLStatistics;
  FSQLTables          	:= B_SQLTables;
  FSQLTransact        	:= B_SQLTransact;
  FSQLBrowseConnect   	:= B_SQLBrowseConnect;
  FSQLBulkOperations  	:= B_SQLBulkOperations;
  FSQLColAttributes   	:= B_SQLColAttributes;
  FSQLColumnPrivileges	:= B_SQLColumnPrivileges;
  FSQLDescribeParam   	:= B_SQLDescribeParam;
  FSQLExtendedFetch   	:= B_SQLExtendedFetch;
  FSQLForeignKeys   	:= B_SQLForeignKeys;
  FSQLMoreResults     	:= B_SQLMoreResults;
  FSQLNativeSql       	:= B_SQLNativeSql;
  FSQLNumParams       	:= B_SQLNumParams;
  FSQLParamOptions    	:= B_SQLParamOptions;
  FSQLPrimaryKeys     	:= B_SQLPrimaryKeys;
  FSQLProcedureColumns	:= B_SQLProcedureColumns;
  FSQLProcedures      	:= B_SQLProcedures;
  FSQLSetPos  		:= B_SQLSetPos;
  FSQLTablePrivileges 	:= B_SQLTablePrivileges;
  FSQLDrivers 		:= B_SQLDrivers;
  FSQLBindParameter   	:= B_SQLBindParameter;
  FSQLDriverConnect   	:= B_SQLDriverConnect;
{$ELSE}
begin
  inherited SetApiCalls( hSqlLibModule );
{$ENDIF}
end;

procedure TInfFunctions.ClearApiCalls;
begin
  inherited ClearApiCalls;
end;

procedure LoadSqlLib;
const
  SqlApiDLLSep	= ';';	// delimiters of API-library names
var
  sLibName, sSqlApiDLL: string;
  CurPos: Integer;
begin
  SqlLibLock.Acquire;
  try
    if (SqlLibRefCount = 0) then begin
      sSqlApiDLL := SqlApiDLL;

      CurPos := 1;
      repeat
        sLibName := ExtractLibName(sSqlApiDLL, SqlApiDLLSep, CurPos);
        hSqlLibModule := HelperLoadLibrary( sLibName );
        if hSqlLibModule <> 0 then
          Break;
      until CurPos > Length(sSqlApiDLL);
      if (hSqlLibModule = 0) then
        raise ESDSqlLibError.CreateFmt(SErrLibLoading, [SqlApiDLL]);

      Inc(SqlLibRefCount);
      InfCalls.SetApiCalls( hSqlLibModule );
    end else
      Inc(SqlLibRefCount);
  finally
    SqlLibLock.Release;
  end;
end;

procedure FreeSqlLib;
begin
  if SqlLibRefCount = 0 then
    Exit;

  SqlLibLock.Acquire;
  try
    if (SqlLibRefCount = 1) then begin
        // sleep(1) to exclude AV, when application (under Linux with Wine)
        //disconnecting from Informix (from Thomas Dingermann)    
      Sleep(1);
      if FreeLibrary(hSqlLibModule) then
        hSqlLibModule := 0
      else
        raise ESDSqlLibError.CreateFmt(SErrLibUnloading, [ GetModuleFileNameStr(hSqlLibModule) ]);
      Dec(SqlLibRefCount);
      InfCalls.ClearApiCalls;
    end else
      Dec(SqlLibRefCount);
  finally
    SqlLibLock.Release;
  end;
end;


{ TIInfDatabase }
function TIInfDatabase.CreateSqlCommand: TISqlCommand;
begin
  Result := TIInfCommand.Create( Self );
end;

function TIInfDatabase.GetCalls: TInfFunctions;
begin
  Result := FCalls as TInfFunctions;
end;

procedure TIInfDatabase.FreeSqlLib;
begin
  SDInf.FreeSqlLib;
end;

procedure TIInfDatabase.LoadSqlLib;
begin
  SDInf.LoadSqlLib;

  FCalls := InfCalls;
end;

procedure TIInfDatabase.RaiseSDEngineError(AErrorCode, ANativeError: TSDEResult; const AMsg, ASqlState: string);
begin
  raise ESDInfError.CreateWithSqlState(AErrorCode, ANativeError, AMsg, ASqlState);
end;

procedure TIInfDatabase.DoConnect(const sRemoteDatabase, sUserName, sPassword: string);
  function ParseRemoteDatabase(Str, Delimiters: string; var sServer, sDatabase: string) :Boolean;
  var
    i: Integer;
  begin
    sServer := '';
    sDatabase := '';
    i := 1;
    while i <= Length(Str) do begin
      if IsDelimiter(Delimiters, Str, i) then
        Break;
      Inc(i);
    end;
    if i <= Length(Str) then begin
      sServer := Copy(Str, 1, i-1);
      while i <= Length(Str) do begin
        if not IsDelimiter(Delimiters, Str, i) then
          Break;
        Inc(i);
      end;
      sDatabase := Copy(Str, i, Length(Str)-i+1);
      Result := True;
    end else begin
      sServer := Str;
      Result := False;
    end;
  end;
var
  ConnStr, sSrv, sDb: string;
begin
        // if sRemoteDatabase contains server and database name, like srv:db1
  if ParseRemoteDatabase(sRemoteDatabase, ServerDelimiters, sSrv, sDb) then
    ConnStr := Format('SERVICE=%s;HOST=test;PROTOCOL=OLSOCTCP;SERVER=%s;DATABASE=%s;UID=%s;PWD=%s',
    			[sSrv, sSrv, sDb, sUserName, sPassword])
  else
    ConnStr := sRemoteDatabase;
  inherited DoConnect( ConnStr, sUserName, sPassword );
end;


{ TIInfCommand }
function TIInfCommand.GetSqlDatabase: TIInfDatabase;
begin
  Result := (inherited SqlDatabase) as TIInfDatabase;
end;


initialization
  hSqlLibModule	:= 0;
  SqlLibRefCount:= 0;
  SqlApiDLL	:= DefSqlApiDLL;
  InfCalls 	:= TInfFunctions.Create;
  SqlLibLock 	:= TCriticalSection.Create;
finalization
  while SqlLibRefCount > 0 do
    FreeSqlLib;
  SqlLibLock.Free;
  InfCalls.Free;
end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -