mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 13:49:39 +02:00
--- Merging r29401 into '.':
U rtl/unix/dl.pp U rtl/android/Makefile.fpc A rtl/android/dlandroid.inc U rtl/android/Makefile --- Merging r29402 into '.': U utils/fpcm/revision.inc --- Merging r29418 into '.': U rtl/android/dlandroid.inc --- Merging r29419 into '.': U utils/pas2jni/readme.txt U utils/pas2jni/writer.pas U utils/pas2jni/ppuparser.pas --- Merging r29420 into '.': U packages/fcl-db/src/sqldb/odbc/odbcconn.pas # revisions: 29401,29402,29418,29419,29420 git-svn-id: branches/fixes_3_0@29421 -
This commit is contained in:
parent
9a0f43104c
commit
6ecfc996b0
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -7913,6 +7913,7 @@ rtl/android/Makefile.fpc svneol=native#text/plain
|
|||||||
rtl/android/arm/dllprt0.as svneol=native#text/plain
|
rtl/android/arm/dllprt0.as svneol=native#text/plain
|
||||||
rtl/android/arm/prt0.as svneol=native#text/plain
|
rtl/android/arm/prt0.as svneol=native#text/plain
|
||||||
rtl/android/cwstring.pp svneol=native#text/plain
|
rtl/android/cwstring.pp svneol=native#text/plain
|
||||||
|
rtl/android/dlandroid.inc svneol=native#text/plain
|
||||||
rtl/android/i386/dllprt0.as svneol=native#text/plain
|
rtl/android/i386/dllprt0.as svneol=native#text/plain
|
||||||
rtl/android/i386/prt0.as svneol=native#text/plain
|
rtl/android/i386/prt0.as svneol=native#text/plain
|
||||||
rtl/android/jvm/Makefile svneol=native#text/plain
|
rtl/android/jvm/Makefile svneol=native#text/plain
|
||||||
|
@ -16,9 +16,7 @@ unit odbcconn;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, sqldb, db, odbcsqldyn
|
Classes, SysUtils, sqldb, db, odbcsqldyn, BufDataset;
|
||||||
{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}, BufDataset{$ENDIF}
|
|
||||||
;
|
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
@ -33,9 +31,6 @@ type
|
|||||||
FQuery:string; // last prepared query, with :ParamName converted to ?
|
FQuery:string; // last prepared query, with :ParamName converted to ?
|
||||||
FParamIndex:TParamBinding; // maps the i-th parameter in the query to the TParams passed to PrepareStatement
|
FParamIndex:TParamBinding; // maps the i-th parameter in the query to the TParams passed to PrepareStatement
|
||||||
FParamBuf:array of pointer; // buffers that can be used to bind the i-th parameter in the query
|
FParamBuf:array of pointer; // buffers that can be used to bind the i-th parameter in the query
|
||||||
{$IF NOT((FPC_VERSION>=2) AND (FPC_RELEASE>=1))}
|
|
||||||
FBlobStreams:TList; // list of Blob TMemoryStreams stored in field buffers (we need this currently as we can't hook into the freeing of TBufDataset buffers)
|
|
||||||
{$ENDIF}
|
|
||||||
public
|
public
|
||||||
constructor Create(Connection:TODBCConnection);
|
constructor Create(Connection:TODBCConnection);
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
@ -95,13 +90,8 @@ type
|
|||||||
// - Result retrieving
|
// - Result retrieving
|
||||||
procedure AddFieldDefs(cursor:TSQLCursor; FieldDefs:TFieldDefs); override;
|
procedure AddFieldDefs(cursor:TSQLCursor; FieldDefs:TFieldDefs); override;
|
||||||
function Fetch(cursor:TSQLCursor):boolean; override;
|
function Fetch(cursor:TSQLCursor):boolean; override;
|
||||||
{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
|
|
||||||
function LoadField(cursor:TSQLCursor; FieldDef:TFieldDef; buffer:pointer; out CreateBlob : boolean):boolean; override;
|
function LoadField(cursor:TSQLCursor; FieldDef:TFieldDef; buffer:pointer; out CreateBlob : boolean):boolean; override;
|
||||||
procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); override;
|
procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); override;
|
||||||
{$ELSE}
|
|
||||||
function LoadField(cursor:TSQLCursor; FieldDef:TFieldDef; buffer:pointer):boolean; override;
|
|
||||||
function CreateBlobStream(Field:TField; Mode:TBlobStreamMode):TStream; override;
|
|
||||||
{$ENDIF}
|
|
||||||
procedure FreeFldBuffers(cursor:TSQLCursor); override;
|
procedure FreeFldBuffers(cursor:TSQLCursor); override;
|
||||||
// - UpdateIndexDefs
|
// - UpdateIndexDefs
|
||||||
procedure UpdateIndexDefs(IndexDefs:TIndexDefs; TableName:string); override;
|
procedure UpdateIndexDefs(IndexDefs:TIndexDefs; TableName:string); override;
|
||||||
@ -135,7 +125,6 @@ type
|
|||||||
|
|
||||||
EODBCException = class(ESQLDatabaseError);
|
EODBCException = class(ESQLDatabaseError);
|
||||||
|
|
||||||
{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
|
|
||||||
{ TODBCConnectionDef }
|
{ TODBCConnectionDef }
|
||||||
|
|
||||||
TODBCConnectionDef = Class(TConnectionDef)
|
TODBCConnectionDef = Class(TConnectionDef)
|
||||||
@ -143,7 +132,6 @@ type
|
|||||||
Class Function ConnectionClass : TSQLConnectionClass; override;
|
Class Function ConnectionClass : TSQLConnectionClass; override;
|
||||||
Class Function Description : String; override;
|
Class Function Description : String; override;
|
||||||
end;
|
end;
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
@ -302,9 +290,7 @@ end;
|
|||||||
constructor TODBCConnection.Create(AOwner: TComponent);
|
constructor TODBCConnection.Create(AOwner: TComponent);
|
||||||
begin
|
begin
|
||||||
inherited Create(AOwner);
|
inherited Create(AOwner);
|
||||||
{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
|
|
||||||
FConnOptions := FConnOptions + [sqEscapeRepeat] + [sqEscapeSlash];
|
FConnOptions := FConnOptions + [sqEscapeRepeat] + [sqEscapeSlash];
|
||||||
{$ENDIF}
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TODBCConnection.StrToStatementType(s : string) : TStatementType;
|
function TODBCConnection.StrToStatementType(s : string) : TStatementType;
|
||||||
@ -661,11 +647,7 @@ begin
|
|||||||
|
|
||||||
// Parse the SQL and build FParamIndex
|
// Parse the SQL and build FParamIndex
|
||||||
if assigned(AParams) and (AParams.count > 0) then
|
if assigned(AParams) and (AParams.count > 0) then
|
||||||
{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
|
|
||||||
buf := AParams.ParseSQL(buf,false,sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions,psInterbase,ODBCCursor.FParamIndex);
|
buf := AParams.ParseSQL(buf,false,sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions,psInterbase,ODBCCursor.FParamIndex);
|
||||||
{$ELSE}
|
|
||||||
buf := AParams.ParseSQL(buf,false,psInterbase,ODBCCursor.FParamIndex);
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
// prepare statement
|
// prepare statement
|
||||||
ODBCCursor.FQuery:=Buf;
|
ODBCCursor.FQuery:=Buf;
|
||||||
@ -815,11 +797,7 @@ end;
|
|||||||
const
|
const
|
||||||
DEFAULT_BLOB_BUFFER_SIZE = 1024;
|
DEFAULT_BLOB_BUFFER_SIZE = 1024;
|
||||||
|
|
||||||
{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
|
|
||||||
function TODBCConnection.LoadField(cursor: TSQLCursor; FieldDef: TFieldDef; buffer: pointer; out CreateBlob : boolean): boolean;
|
function TODBCConnection.LoadField(cursor: TSQLCursor; FieldDef: TFieldDef; buffer: pointer; out CreateBlob : boolean): boolean;
|
||||||
{$ELSE}
|
|
||||||
function TODBCConnection.LoadField(cursor: TSQLCursor; FieldDef: TFieldDef; buffer: pointer):boolean;
|
|
||||||
{$ENDIF}
|
|
||||||
var
|
var
|
||||||
ODBCCursor:TODBCCursor;
|
ODBCCursor:TODBCCursor;
|
||||||
StrLenOrInd:SQLLEN;
|
StrLenOrInd:SQLLEN;
|
||||||
@ -827,16 +805,9 @@ var
|
|||||||
ODBCTimeStruct:SQL_TIME_STRUCT;
|
ODBCTimeStruct:SQL_TIME_STRUCT;
|
||||||
ODBCTimeStampStruct:SQL_TIMESTAMP_STRUCT;
|
ODBCTimeStampStruct:SQL_TIMESTAMP_STRUCT;
|
||||||
DateTime:TDateTime;
|
DateTime:TDateTime;
|
||||||
{$IF NOT((FPC_VERSION>=2) AND (FPC_RELEASE>=1))}
|
|
||||||
BlobBuffer:pointer;
|
|
||||||
BlobBufferSize,BytesRead:SQLINTEGER;
|
|
||||||
BlobMemoryStream:TMemoryStream;
|
|
||||||
{$ENDIF}
|
|
||||||
Res:SQLRETURN;
|
Res:SQLRETURN;
|
||||||
begin
|
begin
|
||||||
{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
|
|
||||||
CreateBlob := False;
|
CreateBlob := False;
|
||||||
{$ENDIF}
|
|
||||||
ODBCCursor:=cursor as TODBCCursor;
|
ODBCCursor:=cursor as TODBCCursor;
|
||||||
|
|
||||||
// load the field using SQLGetData
|
// load the field using SQLGetData
|
||||||
@ -899,9 +870,7 @@ begin
|
|||||||
else
|
else
|
||||||
PWord(buffer)^ := StrLenOrInd;
|
PWord(buffer)^ := StrLenOrInd;
|
||||||
end;
|
end;
|
||||||
{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
|
|
||||||
ftWideMemo,
|
ftWideMemo,
|
||||||
{$ENDIF}
|
|
||||||
ftBlob, ftMemo: // BLOBs
|
ftBlob, ftMemo: // BLOBs
|
||||||
begin
|
begin
|
||||||
//Writeln('BLOB');
|
//Writeln('BLOB');
|
||||||
@ -911,48 +880,8 @@ begin
|
|||||||
// Read the data if not NULL
|
// Read the data if not NULL
|
||||||
if StrLenOrInd<>SQL_NULL_DATA then
|
if StrLenOrInd<>SQL_NULL_DATA then
|
||||||
begin
|
begin
|
||||||
{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
|
|
||||||
CreateBlob:=true; // defer actual loading of blob data to LoadBlobIntoBuffer method
|
CreateBlob:=true; // defer actual loading of blob data to LoadBlobIntoBuffer method
|
||||||
//WriteLn('Deferring loading of blob of length ',StrLenOrInd);
|
//WriteLn('Deferring loading of blob of length ',StrLenOrInd);
|
||||||
{$ELSE}
|
|
||||||
// Determine size of buffer to use
|
|
||||||
if StrLenOrInd<>SQL_NO_TOTAL then
|
|
||||||
BlobBufferSize:=StrLenOrInd
|
|
||||||
else
|
|
||||||
BlobBufferSize:=DEFAULT_BLOB_BUFFER_SIZE;
|
|
||||||
try
|
|
||||||
// init BlobBuffer and BlobMemoryStream to nil pointers
|
|
||||||
BlobBuffer:=nil;
|
|
||||||
BlobMemoryStream:=nil;
|
|
||||||
if BlobBufferSize>0 then // Note: zero-length BLOB is represented as nil pointer in the field buffer to save memory usage
|
|
||||||
begin
|
|
||||||
// Allocate the buffer and memorystream
|
|
||||||
BlobBuffer:=GetMem(BlobBufferSize);
|
|
||||||
BlobMemoryStream:=TMemoryStream.Create;
|
|
||||||
// Retrieve data in parts (or effectively in one part if StrLenOrInd<>SQL_NO_TOTAL above)
|
|
||||||
repeat
|
|
||||||
Res:=SQLGetData(ODBCCursor.FSTMTHandle, FieldDef.Index+1, SQL_C_BINARY, BlobBuffer, BlobBufferSize, @StrLenOrInd);
|
|
||||||
ODBCCheckResult(Res, SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not get field data for field "%s" (index %d).',[FieldDef.Name, FieldDef.Index+1]);
|
|
||||||
// Append data in buffer to memorystream
|
|
||||||
if (StrLenOrInd=SQL_NO_TOTAL) or (StrLenOrInd>BlobBufferSize) then
|
|
||||||
BytesRead:=BlobBufferSize
|
|
||||||
else
|
|
||||||
BytesRead:=StrLenOrInd;
|
|
||||||
BlobMemoryStream.Write(BlobBuffer^, BytesRead);
|
|
||||||
until Res=SQL_SUCCESS;
|
|
||||||
end;
|
|
||||||
// Store memorystream pointer in Field buffer and in the cursor's FBlobStreams list
|
|
||||||
TObject(buffer^):=BlobMemoryStream;
|
|
||||||
if BlobMemoryStream<>nil then
|
|
||||||
ODBCCursor.FBlobStreams.Add(BlobMemoryStream);
|
|
||||||
// Set BlobMemoryStream to nil, so it won't get freed in the finally block below
|
|
||||||
BlobMemoryStream:=nil;
|
|
||||||
finally
|
|
||||||
BlobMemoryStream.Free;
|
|
||||||
if BlobBuffer<>nil then
|
|
||||||
Freemem(BlobBuffer,BlobBufferSize);
|
|
||||||
end;
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
// TODO: Loading of other field types
|
// TODO: Loading of other field types
|
||||||
@ -965,7 +894,6 @@ begin
|
|||||||
//writeln(Format('Field.Size: %d; StrLenOrInd: %d',[FieldDef.Size, StrLenOrInd]));
|
//writeln(Format('Field.Size: %d; StrLenOrInd: %d',[FieldDef.Size, StrLenOrInd]));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
|
|
||||||
procedure TODBCConnection.LoadBlobIntoBuffer(FieldDef: TFieldDef; ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction: TSQLTransaction);
|
procedure TODBCConnection.LoadBlobIntoBuffer(FieldDef: TFieldDef; ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction: TSQLTransaction);
|
||||||
var
|
var
|
||||||
ODBCCursor: TODBCCursor;
|
ODBCCursor: TODBCCursor;
|
||||||
@ -1036,41 +964,13 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
{$ELSE}
|
|
||||||
function TODBCConnection.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
|
|
||||||
var
|
|
||||||
ODBCCursor: TODBCCursor;
|
|
||||||
BlobMemoryStream, BlobMemoryStreamCopy: TMemoryStream;
|
|
||||||
begin
|
|
||||||
if (Mode=bmRead) and not Field.IsNull then
|
|
||||||
begin
|
|
||||||
Field.GetData(@BlobMemoryStream);
|
|
||||||
BlobMemoryStreamCopy:=TMemoryStream.Create;
|
|
||||||
if BlobMemoryStream<>nil then
|
|
||||||
BlobMemoryStreamCopy.LoadFromStream(BlobMemoryStream);
|
|
||||||
Result:=BlobMemoryStreamCopy;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
Result:=nil;
|
|
||||||
end;
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
procedure TODBCConnection.FreeFldBuffers(cursor: TSQLCursor);
|
procedure TODBCConnection.FreeFldBuffers(cursor: TSQLCursor);
|
||||||
var
|
var
|
||||||
ODBCCursor:TODBCCursor;
|
ODBCCursor:TODBCCursor;
|
||||||
{$IF NOT((FPC_VERSION>=2) AND (FPC_RELEASE>=1))}
|
|
||||||
i: integer;
|
|
||||||
{$ENDIF}
|
|
||||||
begin
|
begin
|
||||||
ODBCCursor:=cursor as TODBCCursor;
|
ODBCCursor:=cursor as TODBCCursor;
|
||||||
|
|
||||||
{$IF NOT((FPC_VERSION>=2) AND (FPC_RELEASE>=1))}
|
|
||||||
// Free TMemoryStreams in cursor.FBlobStreams and clear it
|
|
||||||
for i:=0 to ODBCCursor.FBlobStreams.Count-1 do
|
|
||||||
TObject(ODBCCursor.FBlobStreams[i]).Free;
|
|
||||||
ODBCCursor.FBlobStreams.Clear;
|
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
if ODBCCursor.FSTMTHandle <> SQL_NULL_HSTMT then
|
if ODBCCursor.FSTMTHandle <> SQL_NULL_HSTMT then
|
||||||
ODBCCheckResult(
|
ODBCCheckResult(
|
||||||
SQLFreeStmt(ODBCCursor.FSTMTHandle, SQL_CLOSE),
|
SQLFreeStmt(ODBCCursor.FSTMTHandle, SQL_CLOSE),
|
||||||
@ -1082,11 +982,7 @@ procedure TODBCConnection.AddFieldDefs(cursor: TSQLCursor; FieldDefs: TFieldDefs
|
|||||||
const
|
const
|
||||||
ColNameDefaultLength = 40; // should be > 0, because an ansistring of length 0 is a nil pointer instead of a pointer to a #0
|
ColNameDefaultLength = 40; // should be > 0, because an ansistring of length 0 is a nil pointer instead of a pointer to a #0
|
||||||
TypeNameDefaultLength = 80; // idem
|
TypeNameDefaultLength = 80; // idem
|
||||||
{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
|
|
||||||
BLOB_BUF_SIZE = 0;
|
BLOB_BUF_SIZE = 0;
|
||||||
{$ELSE}
|
|
||||||
BLOB_BUF_SIZE = sizeof(pointer);
|
|
||||||
{$ENDIF}
|
|
||||||
var
|
var
|
||||||
ODBCCursor:TODBCCursor;
|
ODBCCursor:TODBCCursor;
|
||||||
ColumnCount:SQLSMALLINT;
|
ColumnCount:SQLSMALLINT;
|
||||||
@ -1149,11 +1045,9 @@ begin
|
|||||||
SQL_CHAR: begin FieldType:=ftFixedChar; FieldSize:=ColumnSize; end;
|
SQL_CHAR: begin FieldType:=ftFixedChar; FieldSize:=ColumnSize; end;
|
||||||
SQL_VARCHAR: begin FieldType:=ftString; FieldSize:=ColumnSize; end;
|
SQL_VARCHAR: begin FieldType:=ftString; FieldSize:=ColumnSize; end;
|
||||||
SQL_LONGVARCHAR: begin FieldType:=ftMemo; FieldSize:=BLOB_BUF_SIZE; end; // is a blob
|
SQL_LONGVARCHAR: begin FieldType:=ftMemo; FieldSize:=BLOB_BUF_SIZE; end; // is a blob
|
||||||
{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
|
|
||||||
SQL_WCHAR: begin FieldType:=ftFixedWideChar; FieldSize:=ColumnSize*sizeof(Widechar); end;
|
SQL_WCHAR: begin FieldType:=ftFixedWideChar; FieldSize:=ColumnSize*sizeof(Widechar); end;
|
||||||
SQL_WVARCHAR: begin FieldType:=ftWideString; FieldSize:=ColumnSize*sizeof(Widechar); end;
|
SQL_WVARCHAR: begin FieldType:=ftWideString; FieldSize:=ColumnSize*sizeof(Widechar); end;
|
||||||
SQL_WLONGVARCHAR: begin FieldType:=ftWideMemo; FieldSize:=BLOB_BUF_SIZE; end; // is a blob
|
SQL_WLONGVARCHAR: begin FieldType:=ftWideMemo; FieldSize:=BLOB_BUF_SIZE; end; // is a blob
|
||||||
{$ENDIF}
|
|
||||||
SQL_DECIMAL: begin FieldType:=ftFloat; FieldSize:=0; end;
|
SQL_DECIMAL: begin FieldType:=ftFloat; FieldSize:=0; end;
|
||||||
SQL_NUMERIC: begin FieldType:=ftFloat; FieldSize:=0; end;
|
SQL_NUMERIC: begin FieldType:=ftFloat; FieldSize:=0; end;
|
||||||
SQL_SMALLINT: begin FieldType:=ftSmallint; FieldSize:=0; end;
|
SQL_SMALLINT: begin FieldType:=ftSmallint; FieldSize:=0; end;
|
||||||
@ -1186,9 +1080,7 @@ begin
|
|||||||
{ SQL_INTERVAL_HOUR_TO_MINUTE: FieldType:=ftUnknown;}
|
{ SQL_INTERVAL_HOUR_TO_MINUTE: FieldType:=ftUnknown;}
|
||||||
{ SQL_INTERVAL_HOUR_TO_SECOND: FieldType:=ftUnknown;}
|
{ SQL_INTERVAL_HOUR_TO_SECOND: FieldType:=ftUnknown;}
|
||||||
{ SQL_INTERVAL_MINUTE_TO_SECOND:FieldType:=ftUnknown;}
|
{ SQL_INTERVAL_MINUTE_TO_SECOND:FieldType:=ftUnknown;}
|
||||||
{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
|
|
||||||
SQL_GUID: begin FieldType:=ftGuid; FieldSize:=38; end; //SQL_GUID defines 36, but TGuidField requires 38
|
SQL_GUID: begin FieldType:=ftGuid; FieldSize:=38; end; //SQL_GUID defines 36, but TGuidField requires 38
|
||||||
{$ENDIF}
|
|
||||||
else
|
else
|
||||||
begin FieldType:=ftUnknown; FieldSize:=ColumnSize; end
|
begin FieldType:=ftUnknown; FieldSize:=ColumnSize; end
|
||||||
end;
|
end;
|
||||||
@ -1565,21 +1457,13 @@ end;
|
|||||||
|
|
||||||
constructor TODBCCursor.Create(Connection:TODBCConnection);
|
constructor TODBCCursor.Create(Connection:TODBCConnection);
|
||||||
begin
|
begin
|
||||||
{$IF NOT((FPC_VERSION>=2) AND (FPC_RELEASE>=1))}
|
|
||||||
// allocate FBlobStreams
|
|
||||||
FBlobStreams:=TList.Create;
|
|
||||||
{$ENDIF}
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
destructor TODBCCursor.Destroy;
|
destructor TODBCCursor.Destroy;
|
||||||
begin
|
begin
|
||||||
{$IF NOT((FPC_VERSION>=2) AND (FPC_RELEASE>=1))}
|
|
||||||
FBlobStreams.Free;
|
|
||||||
{$ENDIF}
|
|
||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
|
|
||||||
class function TODBCConnectionDef.TypeName: String;
|
class function TODBCConnectionDef.TypeName: String;
|
||||||
begin
|
begin
|
||||||
Result:='ODBC';
|
Result:='ODBC';
|
||||||
@ -1597,12 +1481,9 @@ end;
|
|||||||
|
|
||||||
initialization
|
initialization
|
||||||
RegisterConnection(TODBCConnectionDef);
|
RegisterConnection(TODBCConnectionDef);
|
||||||
{$ENDIF}
|
|
||||||
|
|
||||||
finalization
|
finalization
|
||||||
{$IF (FPC_VERSION>=2) AND (FPC_RELEASE>=1)}
|
|
||||||
UnRegisterConnection(TODBCConnectionDef);
|
UnRegisterConnection(TODBCConnectionDef);
|
||||||
{$ENDIF}
|
|
||||||
if Assigned(DefaultEnvironment) then
|
if Assigned(DefaultEnvironment) then
|
||||||
DefaultEnvironment.Free;
|
DefaultEnvironment.Free;
|
||||||
end.
|
end.
|
||||||
|
@ -3437,7 +3437,7 @@ baseunix$(PPUEXT) : $(UNIXINC)/baseunix.pp $(LINUXINC)/errno.inc $(LINUXINC)/pty
|
|||||||
$(LINUXINC)/ostypes.inc $(LINUXINC)/osmacro.inc $(UNIXINC)/gensigset.inc \
|
$(LINUXINC)/ostypes.inc $(LINUXINC)/osmacro.inc $(UNIXINC)/gensigset.inc \
|
||||||
$(UNIXINC)/genfuncs.inc $(SYSTEMUNIT)$(PPUEXT)
|
$(UNIXINC)/genfuncs.inc $(SYSTEMUNIT)$(PPUEXT)
|
||||||
$(COMPILER) $(UNIXINC)/baseunix.pp
|
$(COMPILER) $(UNIXINC)/baseunix.pp
|
||||||
dl$(PPUEXT) : $(UNIXINC)/dl.pp $(SYSTEMUNIT)$(PPUEXT)
|
dl$(PPUEXT) : $(UNIXINC)/dl.pp $(SYSTEMUNIT)$(PPUEXT) dlandroid.inc
|
||||||
$(COMPILER) $(UNIXINC)/dl.pp
|
$(COMPILER) $(UNIXINC)/dl.pp
|
||||||
dynlibs$(PPUEXT) : $(INC)/dynlibs.pas $(UNIXINC)/dynlibs.inc dl$(PPUEXT) objpas$(PPUEXT)
|
dynlibs$(PPUEXT) : $(INC)/dynlibs.pas $(UNIXINC)/dynlibs.inc dl$(PPUEXT) objpas$(PPUEXT)
|
||||||
$(COMPILER) $(INC)/dynlibs.pas
|
$(COMPILER) $(INC)/dynlibs.pas
|
||||||
|
@ -156,7 +156,7 @@ baseunix$(PPUEXT) : $(UNIXINC)/baseunix.pp $(LINUXINC)/errno.inc $(LINUXINC)/pty
|
|||||||
$(UNIXINC)/genfuncs.inc $(SYSTEMUNIT)$(PPUEXT)
|
$(UNIXINC)/genfuncs.inc $(SYSTEMUNIT)$(PPUEXT)
|
||||||
$(COMPILER) $(UNIXINC)/baseunix.pp
|
$(COMPILER) $(UNIXINC)/baseunix.pp
|
||||||
|
|
||||||
dl$(PPUEXT) : $(UNIXINC)/dl.pp $(SYSTEMUNIT)$(PPUEXT)
|
dl$(PPUEXT) : $(UNIXINC)/dl.pp $(SYSTEMUNIT)$(PPUEXT) dlandroid.inc
|
||||||
$(COMPILER) $(UNIXINC)/dl.pp
|
$(COMPILER) $(UNIXINC)/dl.pp
|
||||||
|
|
||||||
dynlibs$(PPUEXT) : $(INC)/dynlibs.pas $(UNIXINC)/dynlibs.inc dl$(PPUEXT) objpas$(PPUEXT)
|
dynlibs$(PPUEXT) : $(INC)/dynlibs.pas $(UNIXINC)/dynlibs.inc dl$(PPUEXT) objpas$(PPUEXT)
|
||||||
|
91
rtl/android/dlandroid.inc
Normal file
91
rtl/android/dlandroid.inc
Normal file
@ -0,0 +1,91 @@
|
|||||||
|
|
||||||
|
// On Android the dladdr() function does not return full path to modules.
|
||||||
|
// Emulate dladdr() by reading the /proc/self/maps to get full path to modules.
|
||||||
|
|
||||||
|
var
|
||||||
|
_ModuleName: ansistring;
|
||||||
|
|
||||||
|
function dladdr(Lib: pointer; info: Pdl_info): Longint; cdecl;
|
||||||
|
var
|
||||||
|
F: Text;
|
||||||
|
s, ss, curnode: ansistring;
|
||||||
|
a1, a2, curbase: ptruint;
|
||||||
|
i: longint;
|
||||||
|
p, pp: PAnsiChar;
|
||||||
|
begin
|
||||||
|
{$PUSH}
|
||||||
|
{$I-}
|
||||||
|
dladdr:=0;
|
||||||
|
_ModuleName:='';
|
||||||
|
if info = nil then
|
||||||
|
exit;
|
||||||
|
curbase:=0;
|
||||||
|
curnode:='';
|
||||||
|
Assign(F, '/proc/self/maps');
|
||||||
|
Reset(F);
|
||||||
|
if IoResult <> 0 then
|
||||||
|
exit;
|
||||||
|
while not Eof(F) do
|
||||||
|
begin
|
||||||
|
// Read the address range info
|
||||||
|
ReadLn(F, ss);
|
||||||
|
p:=PAnsiChar(ss);
|
||||||
|
// Starting address
|
||||||
|
pp:=p;
|
||||||
|
while not (p^ in ['-', #0]) do
|
||||||
|
Inc(p);
|
||||||
|
SetString(s, pp, p - pp);
|
||||||
|
Val('$' + s, a1, i);
|
||||||
|
if i = 0 then
|
||||||
|
begin
|
||||||
|
// Ending address
|
||||||
|
Inc(p);
|
||||||
|
pp:=p;
|
||||||
|
while p^ > ' ' do
|
||||||
|
Inc(p);
|
||||||
|
SetString(s, pp, p - pp);
|
||||||
|
Val('$' + s, a2, i);
|
||||||
|
if i = 0 then
|
||||||
|
begin
|
||||||
|
while p^ <= ' ' do Inc(p); // Whitespace
|
||||||
|
while p^ > ' ' do Inc(p); // Skip perms
|
||||||
|
while p^ <= ' ' do Inc(p); // Whitespace
|
||||||
|
while p^ > ' ' do Inc(p); // Skip offset
|
||||||
|
while p^ <= ' ' do Inc(p); // Whitespace
|
||||||
|
while p^ > ' ' do Inc(p); // Skip dev
|
||||||
|
while p^ <= ' ' do Inc(p); // Whitespace
|
||||||
|
// inode
|
||||||
|
pp:=p;
|
||||||
|
while p^ > ' ' do
|
||||||
|
Inc(p);
|
||||||
|
SetString(s, pp, p - pp);
|
||||||
|
if s <> '0' then
|
||||||
|
begin
|
||||||
|
if s <> curnode then
|
||||||
|
begin
|
||||||
|
curnode:=s;
|
||||||
|
curbase:=a1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if (ptruint(Lib) >= a1) and (ptruint(Lib) < a2) then
|
||||||
|
begin
|
||||||
|
while p^ <= ' ' do Inc(p); // Whitespace
|
||||||
|
// File name
|
||||||
|
if p^ = '/' then
|
||||||
|
begin
|
||||||
|
_ModuleName:=p;
|
||||||
|
info^.dli_fname:=PAnsiChar(_ModuleName);
|
||||||
|
info^.dli_fbase:=pointer(curbase);
|
||||||
|
info^.dli_sname:=nil;
|
||||||
|
info^.dli_saddr:=nil;
|
||||||
|
dladdr:=1;
|
||||||
|
end;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
Close(F);
|
||||||
|
{$POP}
|
||||||
|
end;
|
@ -92,7 +92,7 @@ function dlerror() : Pchar; cdecl; external libdl;
|
|||||||
{ overloaded for compatibility with hmodule }
|
{ overloaded for compatibility with hmodule }
|
||||||
function dlsym(Lib : PtrInt; Name : Pchar) : Pointer; cdecl; external Libdl;
|
function dlsym(Lib : PtrInt; Name : Pchar) : Pointer; cdecl; external Libdl;
|
||||||
function dlclose(Lib : PtrInt) : Longint; cdecl; external libdl;
|
function dlclose(Lib : PtrInt) : Longint; cdecl; external libdl;
|
||||||
function dladdr(Lib: pointer; info: Pdl_info): Longint; cdecl; {$ifndef aix}external;{$endif}
|
function dladdr(Lib: pointer; info: Pdl_info): Longint; cdecl; {$if not defined(aix) and not defined(android)} external; {$endif}
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
@ -133,9 +133,10 @@ uses
|
|||||||
{$i dlaix.inc}
|
{$i dlaix.inc}
|
||||||
{$endif}
|
{$endif}
|
||||||
|
|
||||||
|
{$ifdef android}
|
||||||
|
{$i dlandroid.inc}
|
||||||
|
{$endif}
|
||||||
|
|
||||||
begin
|
begin
|
||||||
{$ifndef android}
|
|
||||||
UnixGetModuleByAddrHook:=@UnixGetModuleByAddr;
|
UnixGetModuleByAddrHook:=@UnixGetModuleByAddr;
|
||||||
{$endif android}
|
|
||||||
end.
|
end.
|
||||||
|
@ -1 +1 @@
|
|||||||
'2014-12-07 rev 29213'
|
'2015-01-04 rev 29399'
|
||||||
|
@ -42,6 +42,7 @@ type
|
|||||||
public
|
public
|
||||||
SearchPath: TStringList;
|
SearchPath: TStringList;
|
||||||
Units: TDef;
|
Units: TDef;
|
||||||
|
OnExceptionProc: TProcDef;
|
||||||
|
|
||||||
constructor Create(const ASearchPath: string);
|
constructor Create(const ASearchPath: string);
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
@ -56,6 +57,9 @@ implementation
|
|||||||
|
|
||||||
uses process, pipes, fpjson, jsonparser;
|
uses process, pipes, fpjson, jsonparser;
|
||||||
|
|
||||||
|
const
|
||||||
|
OnExceptionProcName = 'JNI_OnException';
|
||||||
|
|
||||||
type
|
type
|
||||||
TCharSet = set of char;
|
TCharSet = set of char;
|
||||||
|
|
||||||
@ -495,6 +499,9 @@ var
|
|||||||
Name:='Int';
|
Name:='Int';
|
||||||
|
|
||||||
_ReadDefs(d, it, 'Params');
|
_ReadDefs(d, it, 'Params');
|
||||||
|
// Check for user exception handler proc
|
||||||
|
if AMainUnit and (Parent = CurUnit) and (OnExceptionProc = nil) and (AnsiCompareText(Name, OnExceptionProcName) = 0) then
|
||||||
|
OnExceptionProc:=TProcDef(d);
|
||||||
end;
|
end;
|
||||||
dtVar, dtField, dtParam:
|
dtVar, dtField, dtParam:
|
||||||
with TVarDef(d) do begin
|
with TVarDef(d) do begin
|
||||||
|
@ -57,6 +57,60 @@ After successfull run of pas2jni you will get the following output files:
|
|||||||
|
|
||||||
Note: You need to use ppudump of the same version as the FPC compiler. Use the -D switch to specify correct ppudump if it is not in PATH.
|
Note: You need to use ppudump of the same version as the FPC compiler. Use the -D switch to specify correct ppudump if it is not in PATH.
|
||||||
|
|
||||||
|
CUSTOM HANDLERS
|
||||||
|
|
||||||
|
It is possible to define the following custom handlers in your Pascal code.
|
||||||
|
|
||||||
|
procedure JNI_OnException;
|
||||||
|
- is called when an unhandled Pascal exception occurs. For example, you can log a stack back trace in this handler.
|
||||||
|
|
||||||
|
Custom handlers must be public and defined in one of the main units specified when calling pas2jni.
|
||||||
|
|
||||||
|
CODING TIPS
|
||||||
|
|
||||||
|
* Setting handlers (method pointers) in a Java code.
|
||||||
|
|
||||||
|
For example there is the following event handler in your Pascal code:
|
||||||
|
|
||||||
|
TMyClass = class
|
||||||
|
...
|
||||||
|
property OnChange: TNotifyEvent;
|
||||||
|
...
|
||||||
|
end;
|
||||||
|
|
||||||
|
In a Java code you get the following TMyClass instance:
|
||||||
|
|
||||||
|
TMyClass myclass = TMyClass.Create();
|
||||||
|
|
||||||
|
It is possible set a Java handler in 2 ways:
|
||||||
|
|
||||||
|
1) Place the handler inline.
|
||||||
|
|
||||||
|
...
|
||||||
|
myclass.setOnChange(
|
||||||
|
new TNotifyEvent() {
|
||||||
|
protected void Execute(TObject Sender) {
|
||||||
|
// The handler code
|
||||||
|
}
|
||||||
|
}
|
||||||
|
);
|
||||||
|
...
|
||||||
|
|
||||||
|
2) Define the handler as a method in a class.
|
||||||
|
|
||||||
|
public class MyJavaClass {
|
||||||
|
private void DoOnChange(TObject Sender) {
|
||||||
|
// The handler code
|
||||||
|
}
|
||||||
|
|
||||||
|
public void main() {
|
||||||
|
...
|
||||||
|
// Set the handler to the method with the "DoOnChange" name in the current class (this).
|
||||||
|
myclass.setOnChange( new TNotifyEvent(this, "DoOnChange") );
|
||||||
|
...
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
COMMAND LINE OPTIONS
|
COMMAND LINE OPTIONS
|
||||||
|
|
||||||
Usage: pas2jni [options] <unit> [<unit2> <unit3> ...]
|
Usage: pas2jni [options] <unit> [<unit2> <unit3> ...]
|
||||||
|
@ -1074,7 +1074,7 @@ procedure TWriter.WriteProcType(d: TProcDef; PreInfo: boolean);
|
|||||||
var
|
var
|
||||||
vd: TVarDef;
|
vd: TVarDef;
|
||||||
i: integer;
|
i: integer;
|
||||||
s, ss: string;
|
s, ss, hclass: string;
|
||||||
err: boolean;
|
err: boolean;
|
||||||
begin
|
begin
|
||||||
if not d.IsUsed or not (poMethodPtr in d.ProcOpt) then
|
if not d.IsUsed or not (poMethodPtr in d.ProcOpt) then
|
||||||
@ -1084,21 +1084,14 @@ begin
|
|||||||
WriteClassInfoVar(d);
|
WriteClassInfoVar(d);
|
||||||
|
|
||||||
// Handler proc
|
// Handler proc
|
||||||
|
hclass:=GetClassPrefix(d) + 'Class';
|
||||||
Fps.WriteLn;
|
Fps.WriteLn;
|
||||||
vd:=TVarDef.Create(nil, dtParam);
|
Fps.WriteLn(Format('type %s = class', [hclass]));
|
||||||
try
|
Fps.WriteLn(Format('private %s;', [ GetProcDeclaration(d, 'Handler', True)]), 1);
|
||||||
vd.Name:='_data';
|
Fps.WriteLn('end;');
|
||||||
vd.VarType:=TTypeDef.Create(nil, dtType);
|
Fps.WriteLn;
|
||||||
with TTypeDef(vd.VarType) do begin
|
Fps.WriteLn(GetProcDeclaration(d, Format('%s.Handler', [hclass]), True) + ';');
|
||||||
Name:='pointer';
|
|
||||||
BasicType:=btPointer;
|
|
||||||
end;
|
|
||||||
d.Insert(0, vd);
|
|
||||||
Fps.WriteLn(GetProcDeclaration(d, Format('%sHandler', [GetClassPrefix(d)]), True) + ';');
|
|
||||||
finally
|
|
||||||
vd.VarType.Free;
|
|
||||||
vd.Free;
|
|
||||||
end;
|
|
||||||
Fps.WriteLn('var');
|
Fps.WriteLn('var');
|
||||||
Fps.IncI;
|
Fps.IncI;
|
||||||
Fps.WriteLn('_env: PJNIEnv;');
|
Fps.WriteLn('_env: PJNIEnv;');
|
||||||
@ -1118,7 +1111,7 @@ begin
|
|||||||
Fps.WriteLn('CurJavaVM^^.GetEnv(CurJavaVM, @_env, JNI_VERSION_1_6);');
|
Fps.WriteLn('CurJavaVM^^.GetEnv(CurJavaVM, @_env, JNI_VERSION_1_6);');
|
||||||
Fps.WriteLn('_MethodPointersCS.Enter;');
|
Fps.WriteLn('_MethodPointersCS.Enter;');
|
||||||
Fps.WriteLn('try');
|
Fps.WriteLn('try');
|
||||||
Fps.WriteLn('_mpi:=_TMethodPtrInfo(_MethodPointers[-integer(ptruint(_data)) - 1]);', 1);
|
Fps.WriteLn('_mpi:=_TMethodPtrInfo(_MethodPointers[-integer(ptruint(Self)) - 1]);', 1);
|
||||||
Fps.WriteLn('finally');
|
Fps.WriteLn('finally');
|
||||||
Fps.WriteLn('_MethodPointersCS.Leave;', 1);
|
Fps.WriteLn('_MethodPointersCS.Leave;', 1);
|
||||||
Fps.WriteLn('end;');
|
Fps.WriteLn('end;');
|
||||||
@ -1190,7 +1183,7 @@ begin
|
|||||||
Fps.WriteLn('else');
|
Fps.WriteLn('else');
|
||||||
Fps.WriteLn('with TMethod(Result) do begin', 1);
|
Fps.WriteLn('with TMethod(Result) do begin', 1);
|
||||||
Fps.WriteLn('Data:=pointer(ptruint(-integer(mpi.Index)));', 2);
|
Fps.WriteLn('Data:=pointer(ptruint(-integer(mpi.Index)));', 2);
|
||||||
Fps.WriteLn(Format('Code:=@%sHandler;', [GetClassPrefix(d)]), 2);
|
Fps.WriteLn(Format('Code:=@%s.Handler;', [hclass]), 2);
|
||||||
Fps.WriteLn('end;', 1);
|
Fps.WriteLn('end;', 1);
|
||||||
Fps.DecI;
|
Fps.DecI;
|
||||||
Fps.WriteLn('end;');
|
Fps.WriteLn('end;');
|
||||||
@ -2128,6 +2121,10 @@ begin
|
|||||||
Fps.WriteLn;
|
Fps.WriteLn;
|
||||||
Fps.WriteLn('procedure _HandleJNIException(env: PJNIEnv);');
|
Fps.WriteLn('procedure _HandleJNIException(env: PJNIEnv);');
|
||||||
Fps.WriteLn('begin');
|
Fps.WriteLn('begin');
|
||||||
|
if p.OnExceptionProc <> nil then begin
|
||||||
|
Fps.WriteLn(Format('%s.%s;', [p.OnExceptionProc.Parent.Name, p.OnExceptionProc.Name]), 1);
|
||||||
|
p.OnExceptionProc.SetNotUsed;
|
||||||
|
end;
|
||||||
Fps.WriteLn('env^^.ThrowNew(env, env^^.FindClass(env, ''java/lang/Exception''), PAnsiChar(Utf8Encode(Exception(ExceptObject).Message)));', 1);
|
Fps.WriteLn('env^^.ThrowNew(env, env^^.FindClass(env, ''java/lang/Exception''), PAnsiChar(Utf8Encode(Exception(ExceptObject).Message)));', 1);
|
||||||
Fps.WriteLn('end;');
|
Fps.WriteLn('end;');
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user