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

* 2.0.4 fix:

Browse Source 
- The oracle example now uses the new oracle-bindings
 - Fixed a typo in the declaration of OCIInitialize

git-svn-id: trunk@4255 -
This commit is contained in:
joost 2006-07-18 23:16:55 +00:00
parent e0955aea59
commit 15f44bec2e
3 changed files with 35 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
packages/base/oracle/example/oraclew.pp
View File

@ -19,7 +19,7 @@ interface
{$H+} {$H+}
{$mode objfpc} {$mode objfpc}
uses OraOCI, Classes, SysUtils; uses OCI, oratypes,Classes, SysUtils;
{ all pos parameters are indexed from 1..x! } { all pos parameters are indexed from 1..x! }
@ -35,7 +35,7 @@ uses OraOCI, Classes, SysUtils;
function OraGetFieldName(pos : integer) : string; function OraGetFieldName(pos : integer) : string;
function OraGetFieldType(pos : integer) : longint; function OraGetFieldType(pos : integer) : longint;
function IsFieldDate(Pos : integer): boolean; function IsFieldDate(Pos : integer): boolean;
procedure OraError(errcode: integer; err: OCIError; msg : string); procedure OraError(errcode: integer; err: POCIError; msg : string);
const const
cDescribeBuf = 1024; cDescribeBuf = 1024;
@ -66,10 +66,10 @@ type
end; end;
var var
Env : OCIEnv; Env : POCIEnv;
Err : OCIError; Err : POCIError;
Svc : OCISvcCtx; Svc : POCISvcCtx;
Stmt: OCIStmt; Stmt: POCIStmt;
FieldList : TList; FieldList : TList;
ecode : integer; ecode : integer;
@ -135,7 +135,7 @@ implementation
procedure Describe; procedure Describe;
var var
fldc : longint; fldc : longint;
paramd : OCIParam; paramd : POCIParam;
colname : PChar; colname : PChar;
colsize : ub4; colsize : ub4;
Rec : PDescribeRec; Rec : PDescribeRec;
@ -143,14 +143,14 @@ implementation
fldc := 1; fldc := 1;
FieldListClear; FieldListClear;
ecode := OCIParamGet(Stmt, OCI_HTYPE_STMT, Err, @paramd, fldc); ecode := OCIParamGet(Stmt, OCI_HTYPE_STMT, Err, paramd, fldc);
if ecode <> OCI_SUCCESS then if ecode <> OCI_SUCCESS then
ORAError(ecode, Err, 'OCIParamGetError'); ORAError(ecode, Err, 'OCIParamGetError');
while ecode = OCI_SUCCESS do while ecode = OCI_SUCCESS do
begin begin
New(Rec); New(Rec);
FillChar(Rec^.buf, sizeof(Rec^.buf), #0); FillChar(Rec^.buf, sizeof(Rec^.buf), #0);
ecode := OCIAttrGet(paramd, OCI_DTYPE_PARAM, @Rec^.dbtype, 0, ecode := OCIAttrGet(paramd, OCI_DTYPE_PARAM, @Rec^.dbtype, nil,
OCI_ATTR_DATA_TYPE, Err); OCI_ATTR_DATA_TYPE, Err);
if ecode <> 0 then if ecode <> 0 then
begin begin
@ -170,14 +170,14 @@ implementation
inc(fldc); inc(fldc);
FieldList.Add(Rec); FieldList.Add(Rec);
ecode := OCIParamGet(Stmt, OCI_HTYPE_STMT, Err, @paramd, fldc); ecode := OCIParamGet(Stmt, OCI_HTYPE_STMT, Err, paramd, fldc);
end; end;
end; end;
procedure Define; procedure Define;
var var
x : longint; x : longint;
def: OCIDefine; def: POCIDefine;
PDesc : PDescribeRec; PDesc : PDescribeRec;
defptr: pointer; defptr: pointer;
deflen: sword; deflen: sword;
@ -188,13 +188,13 @@ implementation
begin begin
PDesc := FieldList[x]; PDesc := FieldList[x];
case PDesc^.dbtype of case PDesc^.dbtype of
NUMBER_TYPE: begin SQLT_NUM: begin
if PDesc^.scale <> 0 then if PDesc^.scale <> 0 then
begin begin
defptr := @PDesc^.flt_buf; defptr := @PDesc^.flt_buf;
deflen := SizeOf(PDesc^.flt_buf); deflen := SizeOf(PDesc^.flt_buf);
deftyp := FLOAT_TYPE; deftyp := SQLT_FLT;
PDesc^.dbtype := FLOAT_TYPE; PDesc^.dbtype := SQLT_FLT;
end end
else begin else begin
if PDesc^.dbsize > 4 then if PDesc^.dbsize > 4 then
@ -202,14 +202,14 @@ implementation
// WriteLn('BIG FAT WARNING!!!! dbsize int > 4 (',PDesc^.dbsize,')'); // WriteLn('BIG FAT WARNING!!!! dbsize int > 4 (',PDesc^.dbsize,')');
defptr := @PDesc^.int64_buf; defptr := @PDesc^.int64_buf;
deflen := SizeOf(PDesc^.int64_buf); deflen := SizeOf(PDesc^.int64_buf);
deftyp := INT_TYPE; deftyp := SQLT_INT;
PDesc^.dbtype := INT_TYPE; PDesc^.dbtype := SQLT_INT;
end end
else begin else begin
defptr := @PDesc^.int_buf; defptr := @PDesc^.int_buf;
deflen := SizeOf(PDesc^.int_buf); deflen := SizeOf(PDesc^.int_buf);
deftyp := INT_TYPE; deftyp := SQLT_INT;
PDesc^.dbtype := INT_TYPE; PDesc^.dbtype := SQLT_INT;
end; end;
end; end;
end; end;
@ -219,7 +219,7 @@ implementation
deftyp := PDesc^.dbtype; deftyp := PDesc^.dbtype;
end; end;
end; end;
ecode := OCIDefineByPos(Stmt, @def, Err, x + 1, defptr, ecode := OCIDefineByPos(Stmt, def, Err, x + 1, defptr,
deflen, deftyp, @PDesc^.indp, @PDesc^.col_retlen, deflen, deftyp, @PDesc^.indp, @PDesc^.col_retlen,
@PDesc^.col_retcode, OCI_DEFAULT); @PDesc^.col_retcode, OCI_DEFAULT);
if ecode <> 0 then if ecode <> 0 then
@ -229,18 +229,17 @@ implementation
end; end;
end; end;
procedure OraError( errcode : integer; err: OCIError; msg : string ); procedure OraError( errcode : integer; err: POCIError; msg : string );
var var
buff : array [0..1024] of char; buff : array [0..1024] of char;
xp : PLongint;
begin begin
if err <> nil then if err <> nil then
begin begin
case errcode of case errcode of
OCI_INVALID_HANDLE: Msg := Msg + ' OCI_INVALID_HANDLE'; OCI_INVALID_HANDLE: Msg := Msg + ' OCI_INVALID_HANDLE';
end; end;
xp := @errcode; OCIErrorGet( err, 1, nil, errcode, @buff[0], 1024, OCI_HTYPE_ERROR);
OCIErrorGet( err, 1, nil, xp, @buff[0], 1024, OCI_HTYPE_ERROR);
writeln(stderr, msg, ' ', buff); writeln(stderr, msg, ' ', buff);
end end
else begin else begin
@ -304,7 +303,7 @@ implementation
end; end;
dtype := 0; dtype := 0;
ecode := OCIAttrGet(Stmt, OCI_HTYPE_STMT, @dtype, 4, ecode := OCIAttrGet(Stmt, OCI_HTYPE_STMT, @dtype, nil,
OCI_ATTR_STMT_TYPE, Err); OCI_ATTR_STMT_TYPE, Err);
if ecode <> 0 then if ecode <> 0 then
begin begin
@ -342,7 +341,7 @@ implementation
if (Pos > FieldList.Count) or (Pos < 1) then if (Pos > FieldList.Count) or (Pos < 1) then
Exit; Exit;
Desc := TDescribeRec(FieldList[Pos-1]^); Desc := TDescribeRec(FieldList[Pos-1]^);
Result := (Desc.dbtype = DATE_TYPE); Result := (Desc.dbtype = SQLT_DAT);
end; end;
function OraGetFieldAsString(pos : integer) : string; function OraGetFieldAsString(pos : integer) : string;
@ -358,23 +357,23 @@ implementation
OraGetFieldAsString := 'null'; OraGetFieldAsString := 'null';
Exit; Exit;
end; end;
if Desc.dbtype = STRING_TYPE then if Desc.dbtype = SQLT_STR then
begin begin
Desc.valbuf[Desc.col_retlen] := #0; Desc.valbuf[Desc.col_retlen] := #0;
OraGetFieldAsString := Desc.valbuf; OraGetFieldAsString := strpas(Desc.valbuf);
end end
else if Desc.dbtype = VARCHAR2_TYPE then else if Desc.dbtype = SQLT_CHR then
begin begin
Desc.valbuf[Desc.col_retlen] := #0; Desc.valbuf[Desc.col_retlen] := #0;
OraGetFieldAsString := Desc.valbuf; OraGetFieldAsString := strpas(Desc.valbuf);
end end
else if Desc.dbtype = INT_TYPE then else if Desc.dbtype = SQLT_INT then
begin begin
OraGetFieldAsString := IntToStr(Desc.int_buf); OraGetFieldAsString := IntToStr(Desc.int_buf);
end end
else if Desc.dbtype = FLOAT_TYPE then else if Desc.dbtype = SQLT_FLT then
OraGetFieldAsString := FloatToStr(Desc.flt_buf) OraGetFieldAsString := FloatToStr(Desc.flt_buf)
else if Desc.dbtype = DATE_TYPE then else if Desc.dbtype = SQLT_DAT then
begin begin
Move(Desc.valbuf,Date,SizeOf(Date)); Move(Desc.valbuf,Date,SizeOf(Date));
OraGetFieldAsString := OraGetFieldAsString :=
@ -387,7 +386,7 @@ implementation
else if Desc.dbtype = SQLT_AFC then else if Desc.dbtype = SQLT_AFC then
begin begin
Desc.valbuf[Desc.col_retlen] := #0; Desc.valbuf[Desc.col_retlen] := #0;
OraGetFieldAsString := Desc.valbuf; OraGetFieldAsString := strpas(Desc.valbuf);
end end
else OraGetFieldAsString := 'dbtype not implemented ' + IntToStr(Desc.dbtype); else OraGetFieldAsString := 'dbtype not implemented ' + IntToStr(Desc.dbtype);
end; end;
@ -423,7 +422,7 @@ implementation
begin begin
if (Pos > FieldList.Count) or (Pos < 1) then if (Pos > FieldList.Count) or (Pos < 1) then
Exit; Exit;
OraGetFieldName := TDescribeRec(FieldList[pos-1]^).buf; OraGetFieldName := strpas(TDescribeRec(FieldList[pos-1]^).buf);
end; end;
initialization initialization

2
packages/base/oracle/example/test01.pp
View File

@ -16,7 +16,7 @@ program test01;
uses uses
oraclew, oraclew,
oraoci; oci,oratypes;
{$H+} {$H+}

2
packages/base/oracle/ociap.inc
View File

@ -6467,7 +6467,7 @@
{$IFNDEF LinkDynamically} {$IFNDEF LinkDynamically}
function OCIInitialize(mode:ub4; ctxp:Pdvoid; malocfp:tmalocfp; ralocfp:tralocfp;mfreefp:tmfreefp ):sword;cdecl;external ocilib name 'OCIInitialise'; function OCIInitialize(mode:ub4; ctxp:Pdvoid; malocfp:tmalocfp; ralocfp:tralocfp;mfreefp:tmfreefp ):sword;cdecl;external ocilib name 'OCIInitialize';
function OCITerminate(mode:ub4):sword;cdecl;external ocilib name 'OCITerminate'; function OCITerminate(mode:ub4):sword;cdecl;external ocilib name 'OCITerminate';