Этот код работает сносно ,но дает сбой при длине записи более 300 байт
(комментарий показывает это место ).Причем если уменьшить в bind_columns
количество столбцов,ошибка исчезает ,но это не выход .Где глюк в коде ?Может ,его можно сделать эффективнее ?Сбой возникает внутри ctlib.dll...

<code>
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, Grids, ExtCtrls,
global;

type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
Panel1: TPanel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
btnDisconnect: TButton;
btnExit: TButton;
btnConnect: TButton;
user: TEdit;
passwd: TEdit;
server: TEdit;
btnQuery: TButton;
btnTables: TButton;
btnSPwho: TButton;
SQL: TMemo;
btnSql: TButton;
Splitter1: TSplitter;
Memo1: TMemo;
procedure btnDisconnectClick(Sender: TObject);
procedure btnExitClick(Sender: TObject);
procedure btnConnectClick(Sender: TObject);
procedure btnQueryClick(Sender: TObject);
procedure btnTablesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure DBCleanup(Sender: TObject);
procedure btnSPwhoClick(Sender: TObject);
procedure btnSqlClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

const
MAX_COLSIZE = 255;
MAX_COLUMN = 100;
MAX_CHAR_BUF = 1024;


var
Form1 : TForm1;
context : CS_CONTEXT;
ret : CS_RETCODE;
connection : CS_CONNECTION;
cmd : CS_COMMAND;
coldata : array[1..20] of CS_COLUMN_DATA;

country :array[0..9] of string[2];
countrylen :array[0..9] of integer;
countryind :array[0..9] of smallint;

branch :array[0..9] of smallint;
branchlen :array[0..9] of integer;
branchind :array[0..9] of smallint;

sequence :array[0..9] of integer;
sequencelen:array[0..9] of integer;
sequenceind:array[0..9] of smallint;

implementation

{$R *.DFM}

//************************************************************
// SERVER MSG
// Function to call when server sends a message to client
//************************************************************
function server_msg_handler(context : CS_CONTEXT;
connection : CS_CONNECTION;
var srvmsg : CS_SERVERMSG) : CS_RETCODE; stdcall;
var
errorstr : string;
begin
// Messages <= 10 is informational
if (srvmsg.severity > 10)
and (srvmsg.msgnumber <> 2409 ) then
begin
errorstr:= 'Message: ' + IntToStr(srvmsg.msgnumber) + ', ' +
'Severity: ' + IntToStr(srvmsg.severity) + #13 + #13 +
srvmsg.text;
Application.MessageBox(PChar(errorstr), 'Server Message', mb_OK);
end;
result := CS_SUCCEED;
end;

//************************************************************
// CLIENT MSG and COMMON MSG
// Function to call when Client- and common-lib signal error
//************************************************************
function cl_err_handler(context : CS_CONTEXT;
connection : CS_CONNECTION;
var errmsg : CS_CLIENTMSG) : CS_RETCODE; stdcall;
var
errorstr : string;
begin
if (errmsg.severity > 0) then
begin
errorstr:= 'Message: ' + IntToStr( CS_NUMBER(errmsg.msgnumber) ) + ', ' +
'Severity: ' + IntToStr(errmsg.severity) + ', ' +
'Origin: ' + IntToStr( CS_ORIGIN(errmsg.msgnumber) ) +#13+#13+
errmsg.msgstring;
if errmsg.osstringlen > 0 then
begin
errorstr := errorstr + #13 + 'OS: ' + errmsg.osstring;
end;
Application.MessageBox(PChar(errorstr), 'Open Client Message', mb_OK);
end;
result := CS_SUCCEED;
end;

function min(a, b : CS_INT) : CS_INT;
begin
if a < b then
result := a
else
result := b;
end;

function max(a, b : CS_INT) : CS_INT;
begin
if a > b then
result := a
else
result := b;
end;

function sybconnected : Boolean;
var
retval : PCS_INT;
ret : Boolean;
begin
ret := False;
ct_con_props(connection, CS_GET, CS_LOGIN_STATUS, retval, CS_UNUSED, nil);
if retval^ = CS_TRUE then
ret := True;
result := ret;
end;

function column_width(column : CS_DATAFMT) : CS_INT;
var
len : CS_INT;
begin
case column.datatype of
CS_CHAR_TYPE,
CS_VARCHAR_TYPE,
CS_TEXT_TYPE,
CS_IMAGE_TYPE:
len := MIN(column.maxlength, MAX_CHAR_BUF);

CS_BINARY_TYPE,
CS_VARBINARY_TYPE:
len := MIN((2 * column.maxlength) + 2, MAX_CHAR_BUF);

CS_BIT_TYPE,
CS_TINYINT_TYPE:
len := 3;

CS_SMALLINT_TYPE:
len := 6;

CS_INT_TYPE:
len := 11;

CS_REAL_TYPE,
CS_FLOAT_TYPE:
len := 20;

CS_MONEY_TYPE,
CS_MONEY4_TYPE:
len := 24;

CS_DATETIME_TYPE,
CS_DATETIME4_TYPE:
len := 30;

CS_NUMERIC_TYPE,
CS_DECIMAL_TYPE:
len := (CS_MAX_PREC + 2);

else
begin
len := 12;
end;
end;

result := MAX(column.namelen + 1, len);
end;


function bind_columns(var cmd : CS_COMMAND; num_col : CS_INT) : CS_RETCODE;
var
ret : CS_RETCODE;
i : CS_INT;
datafmt : CS_DATAFMT;

begin

// Loop through the columns getting a description of each one
// and binding each one to a program variable.
for i := 1 to num_col do
begin
// Get the column description. ct_describe() fills the
// datafmt parameter with a description of the column.
ret := ct_describe(cmd, i, datafmt);
if (ret <> CS_SUCCEED) then begin
result := CS_FAIL;
exit;
end;

// update the datafmt structure to indicate that we want the
// results in a null terminated character string.
datafmt.maxlength := column_width(datafmt) + 1;
datafmt.datatype := CS_CHAR_TYPE;
datafmt.format := CS_FMT_NULLTERM;
datafmt.count := 1;

// Set column-name to grid
Form1.StringGrid1.Cells[i, 0] := datafmt.name;

//Allocate memory for the column data string
GetMem(coldata .value, datafmt.maxlength+1);

// Now bind column
ret := ct_bind(cmd, i, datafmt, coldata.value, coldata.valuelen, coldata.indicator);
end;

if ret <> CS_SUCCEED then
begin
for i := 1 to num_col do
begin
// free up allocated memory etc
FreeMem(coldata.value);
end;
end;

result := ret;
end;

function fetch_data(var cmd : CS_COMMAND) : CS_RETCODE;
var
ret : CS_RETCODE;
i,
num_col,
row : CS_INT;
rows_read,
count : CS_INT;
begin

rows_read := 0;
row := 1;

// Get number of columns returned
ret := ct_res_info(cmd, CS_NUMDATA, num_col, CS_UNUSED, nil);

//Make sure we have at least one column
if (num_col <= 0) then
begin
result := CS_FAIL;
exit;
end;

// Bind colums
bind_columns(cmd, num_col);

Form1.StringGrid1.ColCount := num_col + 1;
//сбой при длине записи более 300 байт
// Fetch the rows. Loop while ct_fetch() returns CS_SUCCEED or CS_ROW_FAIL
ret := ct_fetch(cmd, CS_UNUSED, CS_UNUSED, CS_UNUSED, count);
while (ret = CS_SUCCEED) or (ret = CS_ROW_FAIL) do
begin

//If ct_fetch failed, check if we hit a recoverable error.
if ret = CS_ROW_FAIL then
begin
//Clear up, ct_cancel() ...
//exit;
end;

// Increment our row count by the number of rows just fetched.
rows_read := rows_read + count;

Form1.StringGrid1.Cells[0, row] := IntToStr(row);

//We have a row. Loop through the columns displaying the column values.
for i := 1 to num_col do
begin
Form1.StringGrid1.Cells[i, row] := coldata.value;
end;
inc(row);
ret := ct_fetch(cmd, CS_UNUSED, CS_UNUSED, CS_UNUSED, count);
end;

Form1.StringGrid1.RowCount := rows_read +1;

{ for i := 1 to num_col do
begin
// free up allocated memory etc
FreeMem(coldata.value);
end;}

case ret of
CS_END_DATA :
ret := CS_SUCCEED;

CS_FAIL :
ret := CS_FAIL;
end;

result := ret;
end;

function handle_results(cmd : CS_COMMAND) : CS_RETCODE;
var
result_ok : CS_RETCODE;
result_type : CS_INT;
num_rows : CS_INT;
begin
result_ok := ct_results(cmd, result_type);

while (result_ok = CS_SUCCEED) do
begin
case result_type of
// server encountered an error while processing the command.
// The callback function has been called
CS_CMD_FAIL:
begin
//ct_cmd_props( csCmdP, CS_SET, CS_USERDATA, resType, sizeof(RWDBCsInt), NULL );
//ct_res_info( csCmdP, CS_ROW_COUNT, &rowCount_, sizeof(rowCount_), NULL);
//return CS_FAIL;
// Break
end;

// rows to process
CS_ROW_RESULT,
CS_COMPUTE_RESULT,
CS_CURSOR_RESULT:
begin
result_ok := fetch_data(cmd);
end;

// Results from stored proc
// Must fetch or cancel returned params/status from stored proc
CS_PARAM_RESULT:
begin
result_ok := ct_cancel(nil, cmd, CS_CANCEL_CURRENT);
end;

// select command succeeded wich returns no rows,done with one resultset. Go on to next
CS_CMD_DONE,
CS_CMD_SUCCEED:
begin
// Get number of rows returned
result_ok := ct_res_info(cmd, CS_ROW_COUNT, num_rows, CS_UNUSED, nil);
end;


CS_PENDING,
CS_MSG_RESULT,
CS_DESCRIBE_RESULT :
begin
break; // continue
end;

// error
else
begin
result_ok := CS_FAIL;
end;
end;

result_ok := ct_results(cmd, result_type);
end;

case result_ok of

CS_END_RESULTS :
result_ok := CS_END_RESULTS;

CS_BUSY :
result_ok := CS_BUSY;

CS_FAIL : // error handler would have been called.
result_ok := CS_FAIL;
end;

result := result_ok;
end;

procedure TForm1.btnQueryClick(Sender: TObject);
begin
// setup query/command
ret := ct_command(cmd, CS_LANG_CMD, 'select name, dbid from master..sysdatabases', CS_NULLTERM, CS_UNUSED);
// send query to server
ret := ct_send(cmd);
if ret <> CS_SUCCEED then
begin
MessageBox(0, 'ct_send Failed', nil, mb_OK);
exit;
end;

handle_results(cmd);
end;

procedure TForm1.btnTablesClick(Sender: TObject);
begin
// setup query/command
ret := ct_command(cmd, CS_LANG_CMD, 'select name from master..sysobjects where type = "U"', CS_NULLTERM, CS_UNUSED);

// send query to server
ret := ct_send(cmd);
handle_results(cmd);
end;

procedure TForm1.btnSPwhoClick(Sender: TObject);
var
sql : string;
begin
sql:= 'select '+
' spid,'+
' loginname = suser_name(suid),'+
' hostname,'+
' program_name,'+
' hostprocess,'+
' "database" = db_name(dbid),'+
' status,'+
' cmd,'+
' blocked '+
'from master..sysprocesses';

// setup query/command
if ct_command(cmd, CS_LANG_CMD, PChar(sql), CS_NULLTERM, CS_UNUSED) <> CS_SUCCEED then exit;
// send query to server
if ct_send(cmd) <> CS_SUCCEED then exit;
// fetch and print result
handle_results(cmd);
end;

procedure TForm1.btnSqlClick(Sender: TObject);
begin
if sql.text <> '' then
begin
Screen.Cursor := crHourGlass;
// setup query/command
ret := ct_command(cmd, CS_LANG_CMD, PChar(SQL.text), CS_NULLTERM, CS_UNUSED);

// send query to server
ret := ct_send(cmd);

handle_results(cmd);
Screen.Cursor := crDefault;
end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
// Allocate context structure
ret := cs_ctx_alloc(CS_VERSION_100, context);
if not ret = CS_SUCCEED then
begin
MessageBox(0, 'ctx Alloc Failed', nil, mb_OK);
exit;
end;

// Init context
ret := ct_init(context, CS_VERSION_100);
if not ret = CS_SUCCEED then
begin
MessageBox(0, 'Init ctx Failed', nil, mb_OK);
exit;
end;

// Error handling
//
// Set server message function
ret := ct_callback(context, connection, CS_SET, CS_SERVERMSG_CB, @server_msg_handler);
if not ret = CS_SUCCEED then
begin
MessageBox(0, 'ct_callback Failed', nil, mb_OK);
exit;
end;

// Set Client-lib message function
ret := ct_callback(context, nil, CS_SET, CS_CLIENTMSG_CB, @cl_err_handler);

// Set common-lib message function
ret := cs_config(context, CS_SET, CS_MESSAGE_CB, @cl_err_handler, CS_UNUSED, nil);

// Allocate connection structure
ret := ct_con_alloc(context, connection);
if not ret = CS_SUCCEED then
begin
MessageBox(0, 'con Alloc Failed', nil, mb_OK);
exit;
end;
end;

procedure TForm1.btnConnectClick(Sender: TObject);
var
outlen : PCS_INT;
begin
outlen := nil;

// Set login name
ret := ct_con_props(connection, CS_SET, CS_USERNAME, pChar(user.text), CS_NULLTERM, outlen);
if not ret = CS_SUCCEED then
begin
MessageBox(0, 'ct_con_props usr Failed', nil, mb_OK);
exit;
end;

// Set password
ret := ct_con_props(connection, CS_SET, CS_PASSWORD, pChar(passwd.text), CS_NULLTERM, nil);
if not ret = CS_SUCCEED then
begin
MessageBox(0, 'ct_con_props pwds Failed', nil, mb_OK);
exit;
end;

// Set application name
ret := ct_con_props(connection, CS_SET, CS_APPNAME, PChar('CTLIB_TEST'), CS_NULLTERM, nil);
if not ret = CS_SUCCEED then
begin
MessageBox(0, 'ct_con_props pwds Failed', nil, mb_OK);
exit;
end;

// Set host name
ret := ct_con_props(connection, CS_SET, CS_HOSTNAME, PChar('HOSTNAME'), CS_NULLTERM, nil);
if not ret = CS_SUCCEED then
begin
MessageBox(0, 'ct_con_props pwds Failed', nil, mb_OK);
exit;
end;

// Connect to server
ret := ct_connect(connection, pChar(server.text), CS_NULLTERM);
if ret = CS_SUCCEED then
begin
Form1.Caption := 'Connected to ' + server.text;
end
else
begin
//MessageBox(0, 'ct_connect failed', nil, mb_OK);
exit;
end;

// Allocate command structure
ret := ct_cmd_alloc(connection, cmd);
end;

procedure TForm1.btnDisconnectClick(Sender: TObject);
begin
// Close connection to server
ret := ct_close(connection, CS_UNUSED);
Form1.Caption := 'Not connected';
end;

procedure TForm1.btnExitClick(Sender: TObject);
begin
// DBCleanup(self);
close;
end;

procedure TForm1.DBCleanup(Sender: TObject);
begin
// exit client library.
// Terminates client-lib for a specific context. Closes all open
// connections, de-allocate internal data space
ret := ct_exit(context, CS_FORCE_EXIT); //CS_UNUSED
// De-allocate connection structure
ct_con_drop(connection);
// frees the context space
ret := cs_ctx_drop(context);
Form1.Caption := 'Not connected';
end;

end.
</code>

я радикально переделал код ,теперь нормально .там было много проблем

да ,теперь нормально