Zeoslib Portal

Code: Select all

program ZeosOraClobUTF8;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  System.Classes,
  System.Diagnostics,
  ZDbcIntfs,
  ZDbcProperties,
  ZConnection,
  ZDataset;

var
  ZConn: TZConnection;
  ZQuery: TZQuery;
  TempString: String;
  i: integer;
  RecID: Integer;
  RecAClob: String;
begin
  try
    ZConn := TZConnection.Create(nil);
    ZConn.Protocol := 'Oracle';
    ZConn.User := 'michelle';
    ZConn.Password := 'mycoolpw';
    ZConn.Database := 'benthic_tp';
    {$IFDEF WIN64}
      ZConn.LibraryLocation := 'C:\U\DbClients\Oracle\21.8\64Bit\oci.dll';
    {$ELSE}
      ZConn.LibraryLocation := 'C:\U\DbClients\Oracle\21.8\32Bit\oci.dll';
    {$ENDIF}
    // Set OCI to multithreaded (even though this test is not.)
    ZConn.Properties.Values[ConnProps_OCIMultiThreaded] := 'True';
    // Note that all of this works well in utf16 mode.
    // ZConn.Properties.Values[ConnProps_CodePage] := 'UTF16';
    ZConn.Connect;

    // Create table if it doesn't exist
    try try

      Writeln('Attempting to create sample table.');
      ZConn.ExecuteDirect('create table zclobtest (id number(38) primary key, aclob clob)');
      // Now fill some data.
      begin
        Writeln('Filling sample table.');
        ZQuery := TZQuery.Create(nil);
        try
          ZQuery.Connection := ZConn;
          ZConn.StartTransaction;
          ZQuery.SQL.Text := 'insert into zclobtest values (:id, :aclob)';
          for i := 1 to 10 do
          begin
            ZQuery.Params[0].AsInteger := i;
            ZQuery.Params[1].AsString := FormatFloat('000#',i) + ' ' + TempString.PadRight(Random(10000), 'Z');
            ZQuery.ExecSQL;
          end;
          ZConn.Commit;
        finally
          ZQuery.Free;
        end;
      end;
    except
      // Table probably just already exists.
    end;

    begin
      Writeln('');
      Writeln('Test bug #1: failure reading a clob in OnLoad LobCacheMode and utf8.');
      ZQuery := TZQuery.Create(nil);
      try
        ZQuery.Connection := ZConn;
        ZQuery.Properties.Values[DSProps_LobCacheMode] := 'OnLoad';
        ZQuery.SQL.Text := 'select id, aclob from zclobtest order by id';
        ZQuery.Open;
        if not ZQuery.Eof then
        begin
          RecID := ZQuery.Fields[0].AsInteger;
          RecAClob := ZQuery.Fields[1].AsString;
          if RecAClob = '' then
            Writeln('Clob failed: Empty.')
          else
          begin
            TempString := RecAClob.Split([' '])[0];
            if (TempString = '') or (TempString.ToInteger <> RecID) then
              Writeln('Clob failed: Integrity test.')
            else
              Writeln('Clob read correctly!');
          end;
        end;
      finally
        ZQuery.Free;
      end;
    end;
    
    begin
      Writeln('');
      Writeln('Test bug #2:  writing a clob in "None" LobCacheMode and utf8.');
      ZQuery := TZQuery.Create(nil);
      try
        ZQuery.Connection := ZConn;
        ZQuery.Properties.Values[DSProps_LobCacheMode] := 'OnNone';
        ZQuery.SQL.Text := 'select id, aclob from zclobtest order by id';
        ZQuery.Open;
        if not ZQuery.Eof then
        begin
          RecID := ZQuery.Fields[0].AsInteger;
          RecAClob := ZQuery.Fields[1].AsString;
          ZQuery.First;
          ZQuery.Edit;
          TempString := '0001 Edited: ' + DateTimeToStr(Now);
          // In OnNone and UTF8 the following line should fail with 
          // ORA-22292: Cannot open a LOB in read-write mode without a transaction
          ZQuery.Fields[1].AsString := TempString;
          ZQuery.Post;
          ZQuery.RefreshCurrentRow(True);
          if ZQuery.Fields[1].AsString <> TempString then
            Writeln('Clob write failed.')
          else
            Writeln('Clob write succeeded.');
         
        end;
      finally
        ZQuery.Free;
      end;
    end;

    Writeln('Done');

  finally
    ZConn.Disconnect;
    ZConn.Free;
  end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;

  Writeln('');
  Write('Press Enter to quit...');
  ReadLn;

end.