--- Merging r20610 into '.':

U    packages/ibase/src/ibase60.inc
--- Merging r20611 into '.':
U    packages/fcl-db/src/sdf/sdfdata.pp
U    packages/fcl-db/src/sdf/testsdf.pp
--- Merging r20613 into '.':
G    packages/ibase/src/ibase60.inc
--- Merging r20614 into '.':
U    packages/fcl-db/src/sqldb/interbase/ibconnection.pp
--- Merging r20633 into '.':
G    packages/fcl-db/src/sqldb/interbase/ibconnection.pp
--- Merging r20675 into '.':
U    packages/fcl-db/src/sqldb/oracle/oracleconnection.pp
--- Merging r20676 into '.':
G    packages/fcl-db/src/sqldb/oracle/oracleconnection.pp
--- Merging r20677 into '.':
G    packages/fcl-db/src/sqldb/oracle/oracleconnection.pp

# revisions: 20610,20611,20613,20614,20633,20675,20676,20677
------------------------------------------------------------------------
r20610 | marco | 2012-03-24 10:31:05 +0100 (Sat, 24 Mar 2012) | 3 lines
Changed paths:
   M /trunk/packages/ibase/src/ibase60.inc

 * ISC_STATUS to ptrint and all handles to 32-bit. Mantis #19116 related (but
   not fixing that?)

------------------------------------------------------------------------
------------------------------------------------------------------------
r20611 | marco | 2012-03-24 11:01:55 +0100 (Sat, 24 Mar 2012) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sdf/sdfdata.pp
   M /trunk/packages/fcl-db/src/sdf/testsdf.pp

 * Patch from Lacak2 for Mantis #20379 FirstLineAsSchema improvements.

------------------------------------------------------------------------
------------------------------------------------------------------------
r20613 | marco | 2012-03-24 13:00:49 +0100 (Sat, 24 Mar 2012) | 2 lines
Changed paths:
   M /trunk/packages/ibase/src/ibase60.inc

 * FB_API_NULLHANDLE since now handles can be 0 or nil.

------------------------------------------------------------------------
------------------------------------------------------------------------
r20614 | marco | 2012-03-24 13:22:29 +0100 (Sat, 24 Mar 2012) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp

 * use NULLHANDLE instead of NIL, since exact typing of handle type is unknown
   (ptr or integer iow nil or 0)
------------------------------------------------------------------------
------------------------------------------------------------------------
r20633 | marco | 2012-03-26 10:05:19 +0200 (Mon, 26 Mar 2012) | 4 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/interbase/ibconnection.pp

 * Patch from Mantis #19116, from Toru Takubo modified by Reinier for recent
   changes.  Implements a check on blobsize to avoid reading beyond the
   length of a blob where isc_get_segment can segfault.

------------------------------------------------------------------------
------------------------------------------------------------------------
r20675 | marco | 2012-03-30 18:04:21 +0200 (Fri, 30 Mar 2012) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/oracle/oracleconnection.pp

 * Initial support for Oracle metadata, patch by Ludo Brands, Mantis #21606

------------------------------------------------------------------------
------------------------------------------------------------------------
r20676 | marco | 2012-03-30 18:06:45 +0200 (Fri, 30 Mar 2012) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/oracle/oracleconnection.pp

 * Fix from Ludo Brands to properly free parameters in deallocated cursors. Mantis #21608

------------------------------------------------------------------------
------------------------------------------------------------------------
r20677 | marco | 2012-03-30 18:08:38 +0200 (Fri, 30 Mar 2012) | 3 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/oracle/oracleconnection.pp

 * Raise error on unknown datatypes and adds support for ftbcd params.
   Patch by Ludo Brands, Mantis #21611.

------------------------------------------------------------------------

git-svn-id: branches/fixes_2_6@20960 -

packages/fcl-db/src/sdf/sdfdata.pp

@@ -722,8 +722,6 @@ begin
 end;
 
 procedure TFixedFormatDataSet.InternalPost;
-var
-  i: Longint;
 begin
   FSaveChanges := TRUE;
   inherited UpdateRecord;
@@ -862,7 +860,12 @@ var
 begin
   if not IsCursorOpen then
     exit;
-  if (FData.Count = 0) or (Trim(FData[0]) = '') then
+  if (FData.Count = 0) and (Schema.Count > 0) and FirstLineAsSchema then
+  begin
+    Schema.Delimiter := Delimiter;
+    FData.Append(Schema.DelimitedText);
+  end
+  else if (FData.Count = 0) or (Trim(FData[0]) = '') then
     begin
     FirstLineAsSchema := FALSE;
     FDataOffset:=0;
@@ -957,7 +960,7 @@ begin
 
     while Boolean(Byte(pStrEnd[0])) and (pStrEnd[0] in [#1..' ']) do
     begin
-     if FFMultiLine=true then
+     if FFMultiLine then
       begin
        if ((pStrEnd[0]=CR) or (pStrEnd[0]=LF)) then
         begin
@@ -979,7 +982,7 @@ begin
 
     if (pStr[0] = '"') then
      begin
-      if FFMultiLine=true then
+      if FFMultiLine then
        begin
         repeat
          Inc(pStrEnd);
@@ -1036,21 +1039,21 @@ begin
   begin
     Str := Trim(Copy(pansichar(Buffer), p, FieldDefs[i].Size));
     Inc(p, FieldDefs[i].Size);
-    if FFMultiLine=true then
+    if FFMultiLine then
       begin
        // If multiline enabled, quote whenever we find carriage return or linefeed
-       if ((QuoteMe=False) and (StrScan(PChar(Str), #10) <> nil)) then QuoteMe:=true;
-       if ((QuoteMe=False) and (StrScan(PChar(Str), #13) <> nil)) then QuoteMe:=true;
+       if (not QuoteMe) and (StrScan(PChar(Str), #10) <> nil) then QuoteMe:=true;
+       if (not QuoteMe) and (StrScan(PChar(Str), #13) <> nil) then QuoteMe:=true;
       end
     else
       begin
        // If we don't allow multiline, remove all CR and LF because they mess with the record ends:
-       StringReplace(Str, #10, '', [rfReplaceAll]);
-       StringReplace(Str, #13, '', [rfReplaceAll]);
+       Str := StringReplace(Str, #10, '', [rfReplaceAll]);
+       Str := StringReplace(Str, #13, '', [rfReplaceAll]);
       end;
     // Check for any delimiters occurring in field text
-    if ((QuoteMe=False) and (StrScan(PChar(Str), FDelimiter) <> nil)) then QuoteMe:=true;
-    if (QuoteMe=True) then
+    if ((not QuoteMe) and (StrScan(PChar(Str), FDelimiter) <> nil)) then QuoteMe:=true;
+    if (QuoteMe) then
       Str := QuoteDelimiter + Str + QuoteDelimiter;
     Result := Result + Str + FDelimiter;
   end;

packages/fcl-db/src/sdf/testsdf.pp

@@ -38,6 +38,27 @@ begin
     end;
 end;
 
+Procedure DoTest2;
+begin
+  // if file does not exists, then create it with schema at first line
+  With TSdfDataSet.Create(Nil) do
+    try
+      Delimiter := #9;
+      FileName := 'fpc2.ssy';
+      FileMustExist := False;
+      FirstLineAsSchema := True;
+      Schema.Add('First Name');
+      Schema.Add('Last Name');
+      Schema.Add('Email');
+      Open;
+      AppendRecord(['FName', 'LName', '[email protected]']);
+      Close;
+    finally
+      Free;
+    end;
+end;
+
 begin
   DoTest;
+  DoTest2;
 end.

packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -85,6 +85,7 @@ type
     procedure AddFieldDefs(cursor: TSQLCursor;FieldDefs : TfieldDefs); override;
     function Fetch(cursor : TSQLCursor) : boolean; override;
     function LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; override;
+    function GetBlobSize(blobHandle : TIsc_Blob_Handle) : LongInt;
     function GetTransactionHandle(trans : TSQLHandle): pointer; override;
     function Commit(trans : TSQLHandle) : boolean; override;
     function RollBack(trans : TSQLHandle) : boolean; override;
@@ -786,7 +787,7 @@ var ParNr,SQLVarNr : integer;
     with cursor as TIBCursor do
       begin
       TransactionHandle := aTransation.Handle;
-      blobhandle := nil;
+      blobhandle := FB_API_NULLHANDLE;
       if isc_create_blob(@FStatus[0], @FSQLDatabaseHandle, @TransactionHandle, @blobHandle, @blobId) <> 0 then
        CheckError('TIBConnection.CreateBlobStream', FStatus);
 
@@ -1246,6 +1247,22 @@ begin
   Move(Dbl, Buffer^, 8);
 end;
 
+function TIBConnection.GetBlobSize(blobHandle: TIsc_Blob_Handle): LongInt;
+var
+  iscInfoBlobTotalLength : byte;
+  blobInfo : array[0..50] of byte;
+
+begin
+  iscInfoBlobTotalLength:=isc_info_blob_total_length;
+  if isc_blob_info(@Fstatus[0], @blobHandle, sizeof(iscInfoBlobTotalLength), pchar(@iscInfoBlobTotalLength), sizeof(blobInfo) - 2, pchar(@blobInfo[0])) <> 0 then
+    CheckError('isc_blob_info', FStatus);
+  if blobInfo[0]  = iscInfoBlobTotalLength then
+    begin
+      result :=  isc_vax_integer(pchar(@blobInfo[3]), isc_vax_integer(pchar(@blobInfo[1]), 2));
+    end
+  else
+     CheckError('isc_blob_info', FStatus);
+end;
 
 procedure TIBConnection.LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction);
 const
@@ -1255,6 +1272,7 @@ var
   blobHandle : Isc_blob_Handle;
   blobSegment : pointer;
   blobSegLen : word;
+  blobSize: LongInt;
   TransactionHandle : pointer;
   blobId : PISC_QUAD;
   ptr : Pointer;
@@ -1262,34 +1280,40 @@ begin
   blobId := PISC_QUAD(@(ABlobBuf^.ConnBlobBuffer));
 
   TransactionHandle := Atransaction.Handle;
-  blobHandle := nil;
+  blobHandle := FB_API_NULLHANDLE;
 
   if isc_open_blob(@FStatus[0], @FSQLDatabaseHandle, @TransactionHandle, @blobHandle, blobId) <> 0 then
     CheckError('TIBConnection.CreateBlobStream', FStatus);
 
+  blobSize := GetBlobSize(blobHandle);
+
   //For performance, read as much as we can, regardless of any segment size set in database.
   blobSegment := AllocMem(MAXBLOBSEGMENTSIZE);
 
   with ABlobBuf^.BlobBuffer^ do
     begin
     Size := 0;
-    while (isc_get_segment(@FStatus[0], @blobHandle, @blobSegLen, MAXBLOBSEGMENTSIZE, blobSegment) = 0) do
+    // Test for Size is a workaround for Win64 Firebird embedded crashing in isc_get_segment when entire blob is read.
+    while (Size < blobSize) and (isc_get_segment(@FStatus[0], @blobHandle, @blobSegLen, MAXBLOBSEGMENTSIZE, blobSegment) = 0) do
       begin
       ReAllocMem(Buffer,Size+blobSegLen);
       ptr := Buffer+Size;
       move(blobSegment^,ptr^,blobSegLen);
       inc(Size,blobSegLen);
       end;
-    end;
-  freemem(blobSegment);
 
-  if FStatus[1] = isc_segstr_eof then
-    begin
-      if isc_close_blob(@FStatus[0], @blobHandle) <> 0 then
-        CheckError('TIBConnection.CreateBlobStream isc_close_blob', FStatus);
-    end
-  else
-    CheckError('TIBConnection.CreateBlobStream isc_get_segment', FStatus);
+   freemem(blobSegment);
+
+    // Throwing the proper error on failure is more important than closing the blob:
+    // Test for Size is another workaround.
+    if (Size = blobSize) or (FStatus[1] = isc_segstr_eof) then
+      begin
+        if isc_close_blob(@FStatus[0], @blobHandle) <> 0 then
+          CheckError('TIBConnection.CreateBlobStream isc_close_blob', FStatus);
+      end
+    else
+      CheckError('TIBConnection.CreateBlobStream isc_get_segment', FStatus);
+    end;
 end;
 
 function TIBConnection.RowsAffected(cursor: TSQLCursor): TRowsCount;

packages/fcl-db/src/sqldb/oracle/oracleconnection.pp

@@ -87,6 +87,8 @@ type
     function LoadField(cursor:TSQLCursor; FieldDef:TFieldDef; buffer:pointer; out CreateBlob : boolean):boolean; override;
 //    function CreateBlobStream(Field:TField; Mode:TBlobStreamMode):TStream; override;
     procedure FreeFldBuffers(cursor:TSQLCursor); override;
+    procedure UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string); override;
+    function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;
 
   public
     constructor Create(AOwner : TComponent); override;
@@ -471,6 +473,8 @@ begin
     begin
     if Length(FieldBuffers) > 0 then
       for tel := 0 to high(FieldBuffers) do freemem(FieldBuffers[tel].buffer);
+    if Length(ParamBuffers) > 0 then
+      for tel := 0 to high(ParamBuffers) do freemem(ParamBuffers[tel].buffer);
     end;
   FreeAndNil(cursor);
 end;
@@ -529,8 +533,9 @@ begin
           ftFloat : begin OFieldType := SQLT_FLT; OFieldSize := sizeof(double); end;
           ftDate, ftDateTime : begin OFieldType := SQLT_DAT; OFieldSize := 7; end;
           ftString  : begin OFieldType := SQLT_STR; OFieldSize := 4000; end;
-          ftFMTBcd : begin OFieldType := SQLT_VNU; OFieldSize := 22; end;
-
+          ftFMTBcd,ftBCD : begin OFieldType := SQLT_VNU; OFieldSize := 22; end;
+        else
+          DatabaseErrorFmt(SUnsupportedParameter,[Fieldtypenames[AParams[tel].DataType]],self);
         end;
         parambuffers[tel].buffer := getmem(OFieldSize);
         parambuffers[tel].Len := OFieldSize;
@@ -598,9 +603,11 @@ begin
                             pb[5] := 1;
                             pb[6] := 1;
                             end;
-        ftFmtBCD          : begin
+        ftFmtBCD,ftBCD    : begin
                             FmtBCD2Nvu(asFmtBCD,parambuffers[SQLVarNr].buffer);
                             end;
+        else
+          DatabaseErrorFmt(SUnsupportedParameter,[DataType],self);
       end;
 
       end;
@@ -912,6 +919,96 @@ begin
 //  inherited FreeFldBuffers(cursor);
 end;
 
+procedure TOracleConnection.UpdateIndexDefs(IndexDefs: TIndexDefs;
+  TableName: string);
+var qry : TSQLQuery;
+
+begin
+  if not assigned(Transaction) then
+    DatabaseError(SErrConnTransactionnSet);
+
+  qry := tsqlquery.Create(nil);
+  qry.transaction := Transaction;
+  qry.database := Self;
+  with qry do
+    begin
+    ReadOnly := True;
+    sql.clear;
+
+    sql.add('SELECT '+
+              'i.INDEX_NAME,  '+
+              'c.COLUMN_NAME, '+
+              'p.CONSTRAINT_TYPE '+
+            'FROM ALL_INDEXES i, ALL_IND_COLUMNS c,ALL_CONSTRAINTS p  '+
+            'WHERE '+
+              'i.OWNER=c.INDEX_OWNER AND '+
+              'i.INDEX_NAME=c.INDEX_NAME AND '+
+              'p.INDEX_NAME(+)=i.INDEX_NAME AND '+
+              'Upper(c.TABLE_NAME) = ''' +  UpperCase(TableName) +''' '+
+            'ORDER by i.INDEX_NAME,c.COLUMN_POSITION');
+    open;
+    end;
+  while not qry.eof do with IndexDefs.AddIndexDef do
+    begin
+    Name := trim(qry.fields[0].asstring);
+    Fields := trim(qry.Fields[1].asstring);
+    If UpperCase(qry.fields[2].asString)='P' then options := options + [ixPrimary];
+    If UpperCase(qry.fields[2].asString)='U' then options := options + [ixUnique];
+    qry.next;
+    while (name = qry.fields[0].asstring) and (not qry.eof) do
+      begin
+      Fields := Fields + ';' + trim(qry.Fields[2].asstring);
+      qry.next;
+      end;
+    end;
+  qry.close;
+  qry.free;
+end;
+
+function TOracleConnection.GetSchemaInfoSQL(SchemaType: TSchemaType;
+  SchemaObjectName, SchemaPattern: string): string;
+var s : string;
+
+begin
+  case SchemaType of
+    stTables     : s := 'SELECT '+
+                          '''' + DatabaseName + ''' as catalog_name, '+
+                          'sys_context( ''userenv'', ''current_schema'' ) as schema_name, '+
+                          'TABLE_NAME '+
+                        'FROM USER_CATALOG ' +
+                        'WHERE '+
+                          'TABLE_TYPE<>''SEQUENCE'' '+
+                        'ORDER BY TABLE_NAME';
+
+    stSysTables  : s := 'SELECT '+
+                          '''' + DatabaseName + ''' as catalog_name, '+
+                          'OWNER as schema_name, '+
+                          'TABLE_NAME '+
+                        'FROM ALL_CATALOG ' +
+                        'WHERE '+
+                          'TABLE_TYPE<>''SEQUENCE'' '+
+                        'ORDER BY TABLE_NAME';
+    stColumns    : s := 'SELECT '+
+                          'COLUMN_NAME, '+
+                          'DATA_TYPE as column_datatype, '+
+                          'CHARACTER_SET_NAME, '+
+                          'NULLABLE as column_nullable, '+
+                          'DATA_LENGTH as column_length, '+
+                          'DATA_PRECISION as column_precision, '+
+                          'DATA_SCALE as column_scale, '+
+                          'DATA_DEFAULT '+
+                        'FROM ALL_TAB_COLUMNS '+
+                        'WHERE Upper(TABLE_NAME) = '''+UpperCase(SchemaObjectName)+''' '+
+                        'ORDER BY COLUMN_NAME';
+    stProcedures : s := 'SELECT '+
+                          'case when PROCEDURE_NAME is null then OBJECT_NAME ELSE OBJECT_NAME || ''.'' || PROCEDURE_NAME end AS proc_name '+
+                        'FROM USER_PROCEDURES ';
+  else
+    DatabaseError(SMetadataUnavailable)
+  end; {case}
+  result := s;
+end;
+
 constructor TOracleConnection.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);

packages/ibase/src/ibase60.inc

@@ -68,7 +68,9 @@ type
 
 Type
    ISC_USHORT    = word;
-   ISC_STATUS    = clong;
+   ISC_STATUS    = ptrint;  { CLong according the sources but they ifdef
+				for win64, the only significant platform
+				where clong<>ptrint}
    ISC_INT64     = int64;
    ISC_UINT64    = qword;
    ISC_LONG      = Longint;
@@ -80,7 +82,19 @@ Type
    PISC_UINT64 = ^ISC_UINT64;
    PISC_LONG = ^ISC_LONG;
 
+   {$IFDEF CPU64}
+    FB_API_HANDLE = cuint;
+   {$ELSE}
+    FB_API_HANDLE = pointer;
+   {$ENDIF}
+
+
   const
+     {$IFDEF CPU64}
+     FB_API_NULLHANDLE = 0;
+     {$ELSE}
+     FB_API_NULLHANDLE = nil;
+     {$ENDIF}
      DSQL_close = 1;
      DSQL_drop = 2;
 
@@ -327,15 +341,16 @@ type
   {                               }
 
   type
-     isc_att_handle = pointer;
-     isc_blob_handle = pointer;
-     isc_db_handle = pointer;
-     isc_form_handle = pointer;
-     isc_req_handle = pointer;
-     isc_stmt_handle = pointer;
-     isc_svc_handle = pointer;
-     isc_tr_handle = pointer;
-     isc_win_handle = pointer;
+
+     isc_att_handle  = FB_API_HANDLE;
+     isc_blob_handle = FB_API_HANDLE;
+     isc_db_handle   = FB_API_HANDLE;
+     isc_form_handle = FB_API_HANDLE; // can't find in 2.5.1
+     isc_req_handle  = FB_API_HANDLE;
+     isc_stmt_handle = FB_API_HANDLE;
+     isc_svc_handle  = FB_API_HANDLE;
+     isc_tr_handle   = FB_API_HANDLE;
+     isc_win_handle  = pointer;       // can't find in 2.5.1 
      isc_callback = procedure ;extdecl;
      isc_resv_handle = ISC_LONG;
      tisc_att_handle = isc_att_handle;