zorasqlquery.pas

控件名称：WINZEOS.ZIP 2002年08月03日 作者：CapellaDevelopment Zeos系列构件套件包含一组可直接存取Linux知名的免费数据库MySQL、Postgre

{ Fill collection with indices }
procedure TZCustomOraSqlDataset.AddTableIndices(Table: string;
  SqlFields: TSqlFields; SqlIndices: TSqlIndices);
var
  KeyType: TKeyType;
  SortType: TSortType;
  Query: TDirOraSqlQuery;
begin
  Query := TDirOraSqlQuery(TransactObj.QueryHandle);
  Query.ShowIndexes(Table);
  while not Query.EOF do
  begin
    { Define a key type }
    if Query.Field(2) = 'UNIQUE' then
    begin
      if Query.Field(3) = 'Y' then
        KeyType := ktPrimary
      else KeyType := ktUnique;
    end else KeyType := ktIndex;
    { Define a sorting mode }
    SortType := stAscending;

    { Put new index description }
    SqlIndices.AddIndex(Query.Field(0), Table, Query.Field(4),
      KeyType, SortType);
    Query.Next;
  end;
  Query.Close;
end;

{ Convert field value to sql value }
function TZCustomOraSqlDataset.FieldValueToSql(Value: string;
  FieldDesc: PFieldDesc): string;

  function BytesToSql(Value: string): string;
  var
    I: Integer;
  begin
    if Value = '' then
    begin
      Result := 'NULL';
      Exit;
    end
    else
    begin
      Result := '';
      for I := 1 to Length(Value) do
        Result := Result + IntToHex(Ord(Value[I]),2);
      Result := '''' + Result + '''';
    end;
  end;

begin
  if FieldDesc.FieldType = ftBlob then
    Result := BytesToSql(Value)
  else begin
    Result := inherited FieldValueToSql(Value, FieldDesc);

    if FieldDesc.FieldType = ftDateTime then
    begin
//      Result := 'TO_DATE(' + Result + ',''YYYY-MM-DD HH24-MI-SS'')'
      if Pos(' ', Result) > 0 then
        Result := 'TO_DATE(' + Result + ',''' + UpperCase(ShortDateFormat) + ' HH24' + TimeSeparator + 'MI' + TimeSeparator + 'SS'')'
      else
        Result := 'TO_DATE(' + Result + ',''' + UpperCase(ShortDateFormat) + ''')';
    end
    else
    if (FieldDesc.FieldType = ftString)
      and (StrCaseCmp(FieldDesc.TypeName, 'NCHAR')
      or StrCaseCmp(FieldDesc.TypeName, 'NVARCHAR2')) then
      Result := 'N' + Result;
  end;
end;

{ Update record after initialization }
procedure TZCustomOraSqlDataset.UpdateAfterInit(RecordData: PRecordData);

  function FindPrimaryKey: PFieldDesc;
  var
    I: Integer;
    IndexDesc: PIndexDesc;
  begin
    Result := nil;
    if SqlParser.Tables.Count = 0 then Exit;
    { Find primary key }
    IndexDesc := nil;
    for I := 0 to SqlBuffer.SqlIndices.Count-1 do
      if StrCaseCmp(SqlBuffer.SqlIndices[I].Table, SqlParser.Tables[0])
        and (SqlBuffer.SqlIndices[I].KeyType = ktPrimary) then
      begin
        IndexDesc := SqlBuffer.SqlIndices[I];
        Break;
      end;
    { Check primary key }
    if (IndexDesc = nil) or (IndexDesc.FieldCount <> 1) then Exit;
    Result := SqlBuffer.SqlFields.FindByName(SqlParser.Tables[0],
      IndexDesc.Fields[0]);
    if Result = nil then Exit;
    if Result.FieldType <> ftInteger then
      Result := nil;
  end;

var
  FieldDesc: PFieldDesc;
begin
  inherited UpdateAfterInit(RecordData);

  if ooAutoIncKey in FExtraOptions then
  begin
    FieldDesc := FindPrimaryKey;
    if FieldDesc <> nil then
      SqlBuffer.SetField(FieldDesc, EvaluteDef(Format('%s_%s_seq.NextVal',
        [SqlParser.Tables[0], FieldDesc.Field])), RecordData);
  end;
end;

{ Update Lobs after update or insert }
procedure TZCustomOraSqlDataset.UpdateAfterPost(OldData,
  NewData: PRecordData);
var
  I: Integer;
  Sql: string;
  BlobDescs: array[0..MAX_FIELD_COUNT-1] of PFieldDesc;
  BlobCount: Integer;
  FieldDesc: PFieldDesc;
  FieldValue: string;
  OraConnect: TDirOraSqlConnect;
  OraTransact: TDirOraSqlTransact;
  UpdateQuery: TDirOraSqlQuery;
  LobHandle: POCILobLocator;
  Affected: ub4;
begin
  inherited UpdateAfterPost(OldData, NewData);

  if SqlParser.Tables.Count = 0 then Exit;
  if NewData.RecordType in [ztUnmodified, ztDeleted] then Exit;

  Sql := '';
  BlobCount := 0;
  for I := 0 to SqlBuffer.SqlFields.Count-1 do
  begin
    FieldDesc := SqlBuffer.SqlFields[I];
    if not StrCaseCmp(FieldDesc.Table, SqlParser.Tables[0]) then
      Continue;
    if not (FieldDesc.FieldType in [ftBlob, ftMemo])
      or (FieldDesc.BlobType <> btExternal) then Continue;
    if SqlBuffer.GetFieldNull(FieldDesc, NewData) then Continue;
    FieldValue := SqlBuffer.GetField(FieldDesc, NewData);
    if (NewData.RecordType = ztModified)
      and (FieldValue = SqlBuffer.GetField(FieldDesc, OldData)) then
      Continue;
    if Sql <> '' then Sql := Sql + ',';
    Sql := Sql + FieldDesc.Field;
    BlobDescs[BlobCount] := FieldDesc;
    Inc(BlobCount);
  end;
  if Sql = '' then Exit;

  Sql := 'SELECT ' + Sql + ' FROM ' + SqlParser.Tables[0]
    + FormSqlWhere(SqlParser.Tables[0], OldData) + ' FOR UPDATE';
  OraConnect := TDirOraSqlConnect(Query.Connect);
  OraTransact := TDirOraSqlTransact(Query.Transact);
  UpdateQuery := TDirOraSqlQuery.Create(OraConnect, OraTransact);
  UpdateQuery.Sql := Sql;
  UpdateQuery.Open;
  for I := 0 to MinIntValue([BlobCount, UpdateQuery.FieldCount]) do
  begin
    if not (UpdateQuery.FieldType(I) in [SQLT_BLOB, SQLT_CLOB]) or
      UpdateQuery.FieldIsNull(I) then
      Continue;
    FieldValue := SqlBuffer.GetField(BlobDescs[I], NewData);
    LobHandle := PPOCIDescriptor(UpdateQuery.FieldBuffer(I))^;

    Affected := Length(FieldValue);
    OCILobWrite(OraTransact.Handle, OraTransact.ErrorHandle,
      LobHandle, Affected, 1, PChar(FieldValue), Affected,
      OCI_ONE_PIECE, nil, nil, 0, SQLCS_IMPLICIT);
  end;
  UpdateQuery.Close;
end;

{ Assign Lob handlers }
procedure TZCustomOraSqlDataset.CopyRecord(SqlBuffer: TSqlBuffer; Source,
  Dest: PRecordData);
var
  I, Status: Integer;
  NewPtr: POCILobLocator;
  DestBlob: PRecordBlob;
begin
  for I := 0 to SqlBuffer.SqlFields.Count-1 do
    if (SqlBuffer.SqlFields[I].FieldType in [ftBlob, ftMemo])
      and (Dest.Bytes[SqlBuffer.SqlFields[I].Offset] = 0) then
    begin
      DestBlob := PRecordBlob(@Dest.Bytes[SqlBuffer.SqlFields[I].Offset+1]);
      if (DestBlob.BlobType = btExternal) and (DestBlob.Handle.Ptr <> 0) then
      begin
        Status := OCIDescriptorAlloc(TDirOraSqlConnect(Query.Connect).Handle,
           POCIDescriptor(NewPtr), OCI_DTYPE_LOB, 0, nil);
        if Status = OCI_SUCCESS then
          Status := OCILobAssign(TDirOraSqlConnect(Query.Connect).Handle,
            TDirOraSqlTransact(Query.Transact).ErrorHandle,
            POCIDescriptor(DestBlob.Handle.Ptr),
            POCIDescriptor(NewPtr));
        if Status = OCI_SUCCESS then
          DestBlob.Handle.Ptr := Integer(NewPtr)
        else
          DestBlob.Handle.Ptr := 0;
      end;
   end;
end;

{ Free Lob handlers }
procedure TZCustomOraSqlDataset.FreeRecord(SqlBuffer: TSqlBuffer;
  Value: PRecordData);
var
  I: Integer;
  BlobPtr: PRecordBlob;
begin
  for I := 0 to SqlBuffer.SqlFields.Count-1 do
    if (SqlBuffer.SqlFields[I].FieldType in [ftBlob, ftMemo])
      and (Value.Bytes[SqlBuffer.SqlFields[I].Offset] = 0) then
    begin
      BlobPtr := PRecordBlob(@Value.Bytes[SqlBuffer.SqlFields[I].Offset+1]);
      if (BlobPtr.BlobType = btExternal) and (BlobPtr.Handle.Ptr <> 0) then
      begin          
        OCIDescriptorFree(POCIDescriptor(BlobPtr.Handle.Ptr), OCI_DTYPE_LOB);
        BlobPtr.Handle.Ptr := 0;
      end;
   end;
end;

{$IFDEF WITH_IPROVIDER}
{ IProvider support }

{ Is in transaction }
function TZCustomOraSqlDataset.PSInTransaction: Boolean;
begin
  Result := True;
end;

{ Execute an sql statement }
function TZCustomOraSqlDataset.PSExecuteStatement(const ASql: string; AParams: TParams;
  ResultSet: Pointer): Integer;
begin
  if Assigned(ResultSet) then
  begin
    TDataSet(ResultSet^) := TZOraSqlQuery.Create(nil);
    with TZOraSqlQuery(ResultSet^) do
    begin
      Sql.Text := ASql;
      Params.Assign(AParams);
      Open;
      Result := RowsAffected;
    end;
  end else
    Result := TransactObj.ExecSql(ASql);
end;

{ Set command query }
procedure TZCustomOraSqlDataset.PSSetCommandText(const CommandText: string);
begin
  Close;
  if Self is TZOraSqlQuery then
    TZOraSqlQuery(Self).Sql.Text := CommandText
  else
  if Self is TZOraSqlTable then
    TZOraSqlQuery(Self).TableName := CommandText;
end;

{$ENDIF}

end.