paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-13 00:09:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Applied patch from 21583

Browse Source 
git-svn-id: trunk@20680 -
This commit is contained in:
michael 2012-03-31 09:18:01 +00:00
parent 2c941ec5d9
commit a999648726
2 changed files with 34 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
packages/dblib/src/dblib.pp
View File

@ -43,7 +43,11 @@ const
{$IFDEF ntwdblib}'ntwdblib.dll'{$ENDIF}
{$IFDEF freetds} 'dblib.dll' {$ENDIF}
{$ELSE}
'libsybdb.so'
{$IFDEF DARWIN}
'libsybdb.dylib'
{$ELSE}
'libsybdb.so'
{$ENDIF}
{$ENDIF}
;
@ -150,6 +154,9 @@ const
DBUNKNOWN = 2; //FALSE = 0, TRUE = 1
// Error codes:
SYBEFCON = 20002; // SQL Server connection failed
type
PLOGINREC=Pointer;
PDBPROCESS=Pointer;
@ -230,7 +237,7 @@ type
DBVARYCHAR=packed record
len: {$IFDEF freetds}DBINT{$ELSE}DBSMALLINT{$ENDIF};
str: array[0..DBMAXCHAR-1] of CHAR;
str: array[0..DBMAXCHAR-1] of AnsiChar;
end;
DBERRHANDLE_PROC=function(dbproc: PDBPROCESS; severity, dberr, oserr:INT; dberrstr, oserrstr:PChar):INT; cdecl;
@ -241,9 +248,9 @@ type
{$ENDIF}
DBCOL=record
SizeOfStruct: DBINT;
Name: array[0..MAXCOLNAMELEN] of char;
ActualName: array[0..MAXCOLNAMELEN] of char;
TableName: array[0..MAXTABLENAME] of char;
Name: array[0..MAXCOLNAMELEN] of AnsiChar;
ActualName: array[0..MAXCOLNAMELEN] of AnsiChar;
TableName: array[0..MAXTABLENAME] of AnsiChar;
Typ: SHORT;
UserType: DBINT;
MaxLength: DBINT;
@ -396,7 +403,7 @@ begin
if DBLibLibraryHandle = nilhandle then
begin
RefCount := 0;
raise EInOutError.CreateFmt('Can not load DB-Lib client library "%s". Check your installation.'#13'%s',
raise EInOutError.CreateFmt('Can not load DB-Lib client library "%s". Check your installation.'+LineEnding+'%s',
[libname, SysErrorMessage(GetLastOSError)]);
end;

38
packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
View File

@ -54,6 +54,7 @@ type
FDBProc : PDBPROCESS;
Ftds : integer; // TDS protocol version
Fstatus : STATUS; // current result/rows fetch status
function CheckError(const Ret: RETCODE): RETCODE;
procedure DBExecute(const cmd: string);
function TranslateFldType(SQLDataType: integer): TFieldType;
function ClientCharset: TClientCharset;
@ -178,34 +179,19 @@ var
function DBErrHandler(dbproc: PDBPROCESS; severity, dberr, oserr:INT; dberrstr, oserrstr:PChar):INT; cdecl;
begin
DBErrorStr:=DBErrorStr+#13+dberrstr;
DBErrorStr:=DBErrorStr+LineEnding+dberrstr;
DBErrorNo :=dberr;
Result :=INT_CANCEL;
end;
function DBMsgHandler(dbproc: PDBPROCESS; msgno: DBINT; msgstate, severity:INT; msgtext, srvname, procname:PChar; line:DBUSMALLINT):INT; cdecl;
begin
DBMsgStr:=DBMsgStr+#13+msgtext;
DBMsgStr:=DBMsgStr+LineEnding+msgtext;
DBMsgNo :=msgno;
Result :=0;
end;
function CheckError(const Ret: RETCODE): RETCODE;
var E: EMSSQLDatabaseError;
begin
if Ret=FAIL then
begin
E:=EMSSQLDatabaseError.Create(DBErrorStr+#13+DBMsgStr);
E.DBErrorCode:=DBErrorNo;
DBErrorStr:='';
DBMsgStr:='';
raise E;
end;
Result:=Ret;
end;
{ TDBLibCursor }
function TDBLibCursor.ReplaceParams(AParams: TParams; ASQLConnection: TMSSQLConnection): string;
@ -245,6 +231,24 @@ begin
Result := (Ftds=DBTDS_50) or (Ftds=DBTDS_42);
end;
function TMSSQLConnection.CheckError(const Ret: RETCODE): RETCODE;
var E: EMSSQLDatabaseError;
begin
if Ret=FAIL then
begin
if DBErrorStr = '' then
case DBErrorNo of
SYBEFCON: DBErrorStr:='SQL Server connection failed!';
end;
E:=EMSSQLDatabaseError.CreateFmt('%s Error %d: %s'+LineEnding+'%s', [ClassName, DBErrorNo, DBErrorStr, DBMsgStr]);
E.DBErrorCode:=DBErrorNo;
DBErrorStr:='';
DBMsgStr:='';
raise E;
end;
Result:=Ret;
end;
constructor TMSSQLConnection.Create(AOwner: TComponent);
begin
inherited Create(AOwner);