sybquery.pas

sybase大全

{$H+}
unit sybquery;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids,DsgnIntf,sybase_components,sybnavigator;

type
  SybObjectname = string[30];

type
  Tsybobjectproperty = class(TStringProperty)
  public
    procedure GetValues(TheProc: TGetStrProc); override;
    function getattributes:Tpropertyattributes; override;
  end;

type
  Tstringsproperty = class(TPropertyEditor)
  public
    function getvalue:string; override;
    procedure setvalue(const value :string); override;
    procedure edit;override;
    function getattributes:Tpropertyattributes; override;
  end;

type
  TSybQuery = class(TComponent)
  private
    { Private declarations }
    FSql            :ansistring;
    FDesignSql      :ansistring;
    FDbname         :SybObjectname;
    FDesignActive   :boolean;
    FMaxCount       :integer;
    FColumnCount    :integer;
    FBuffersize     :integer;
    FRowsReturned   :boolean;
    FAutoDbProc     :boolean;
    FDbProc         :integer;
    FUpdateFields   :boolean;
    FCurrCmd        :integer;
    procedure setupdatefields(Value:boolean);
    procedure SetAutoDbProc(Value :boolean);
    procedure SetDbProc(Value :integer);
    procedure SetSql(Value :ansistring);
    procedure SetDesignSql(Value :ansistring);
    procedure SetDbName(Value :SybObjectname);
    procedure SetMaxCount(Value :integer);
    procedure SetBuffersize(Value :integer);
    procedure SetRowsReturned(Value :boolean);
    procedure Readfieldscount(Reader: TReader);
    procedure Writefieldscount(Writer: TWriter);
    procedure Writefields(Writer: TWriter);
    procedure Readfields(Reader: TReader);
    procedure update_fields;
    procedure get_next_resultset;
  protected
    { Protected declarations }
    procedure get_dbproc;
    procedure SetDesignActive(Value :boolean);
    procedure get_databasefields;
    procedure DefineProperties(Filer: TFiler); override;
    procedure setname(const NewName:Tcomponentname); override;
  public
    SqlCommand:array[0..8000] of char;
    Login,Retcode,retcode2,nocols,col:integer;
    dbprocc:integer;
    numcols       :integer;
    sproc_retcode :integer;
    firstrownum,lastrownum,currrownum:longint;
    first_flag :boolean;

    fieldscount     :smallint;
    fields          :array[1..255] of SybObjectname;
    datafields      :array[1..255] of SybObjectname;
    datafieldscount :smallint;
    navigator       :tsybnavigator;
    constructor create(AOwner:TComponent); override;
    destructor destroy; override;
    procedure loaded; override;
    procedure addsql(Value :ansistring);
    procedure clearsql;
    function sqlexec:integer; virtual;
    function nextrow:integer; virtual;
    function prevrow:integer; virtual;
    function firstrow:integer; virtual;
    function lastrow:integer; virtual;
    function row_exists:boolean;
    function column(index:byte):string;
    function heading(index:byte):string;
    function coltype(index:byte):string;
    function collength(index:byte):integer;
    function ischar(index:byte):boolean;
    procedure addfield(value:SybObjectname);
    procedure deletefield(value:SybObjectname);
    procedure LoadSqlFromFile(FileName :string);
    property RowsReturned:boolean read fRowsReturned write setRowsReturned default false;
    property MaxCount :integer read FMaxCount write SetMaxCount default 0;
    property CurrCmd :integer read FCurrCmd write FCurrCmd;
  published
    { Published declarations }
    property ColumnCount :integer read FColumnCount;
    property DbName :SybObjectname read FDbName write setDbname;
    property Sql :ansistring read FSql write SetSql;
    property DesignSql :ansistring read FDesignSql write SetDesignSql;
    property DesignActive:boolean read fdesignactive write setdesignactive stored false;
    property BufferSize :integer read FBuffersize write SetBuffersize;
    property AutoDbProc:boolean read FAutoDbProc write SetAutoDbProc default true;
    property DbProc:integer read FDbproc write SetDbProc default 0;
    property UpdateFields:boolean read fupdatefields write setupdatefields default true;
  end;

procedure Register;

implementation
uses sybase32,
     objectlistdlg,
     ansistringedit,
     sybmemo,
     sybcheckbox,
     sybradiobutton,
     sybdatabase,
     stdctrls;

procedure Register;
begin
  RegisterPropertyEditor(TypeInfo(SybObjectname),tsybquery,'',Tsybobjectproperty);
  RegisterPropertyEditor(TypeInfo(AnsiString),tsybquery,'Sql',TstringsProperty);
  RegisterPropertyEditor(TypeInfo(AnsiString),tsybquery,'DesignSql',TstringsProperty);
  RegisterComponents('Sybase DBLIB', [tsybquery]);
end;

procedure tsybquery.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('FieldsProp', Readfields, Writefields,fieldscount>0);
  Filer.DefineProperty('FieldsCountProp',Readfieldscount,Writefieldscount,true);
end;

procedure tsybquery.setname(const NewName:Tcomponentname);
begin
  inherited setname(NewName);
  if querylist.indexof(self) = -1 then
    querylist.add(self)
  else
  begin
    querylist.items[querylist.indexof(self)]:=self;
  end;
end;

destructor tsybquery.destroy;
begin
  querylist.remove(self);
  inherited destroy;
end;

constructor tsybquery.create(AOwner:TComponent);
begin
  inherited create(AOwner);
  fupdatefields:=true;
  Fdesignactive:=false;
  Fautodbproc:=true;
  FBuffersize:=0;
  Fdbproc:=0;
  first_flag:=true;
  if querylist = nil then
  begin
    querylist:=TList.create;
  end;
end;

procedure tsybquery.SetUpdatefields(Value :boolean);
begin
  Fupdatefields:=value;
end;

procedure tsybquery.Readfields(Reader: TReader);
var i:integer;
begin
  Reader.ReadListBegin;
  fieldscount:=0;
  while not Reader.EndOfList do
  begin
    inc(fieldscount);
    fields[fieldscount]:=Reader.ReadString;
  end;
  Reader.ReadListEnd;
end;

procedure tsybquery.Writefields(Writer: TWriter);
var
  I: Integer;
begin
  Writer.WriteListBegin;
  for I := 1 to fieldscount do
    Writer.WriteString(fields[I]);
  Writer.WriteListEnd;
end;

procedure tsybquery.Readfieldscount(Reader: TReader);
begin
  fieldscount := Reader.ReadInteger;
end;

procedure tsybquery.Writefieldscount(Writer: TWriter);
begin
  Writer.WriteInteger(fieldscount);
end;

procedure tsybquery.loaded;
begin
end;

procedure tsybquery.SetDbProc(Value :integer);
begin
  FDbproc:=Value;
  Dbprocc:=Value;
end;

procedure TSybquery.SetAutoDbPRoc(Value :boolean);
begin
  FAutoDbProc:=value;
end;

procedure tsybquery.SetSql(Value :ansistring);
begin
  FSql:=Value;
end;

procedure tsybquery.SetDesignSql(Value :ansistring);
begin
  FDesignSql:=Value;
end;

procedure tsybquery.SetRowsReturned(Value:boolean);
begin
  FRowsReturned:=value;
end;

procedure tsybquery.Setdesignactive(Value :boolean);
begin
  if value then
  begin
    get_dbproc;
    get_databasefields;
  end;
  Fdesignactive:=Value;
end;

procedure TSybquery.SetMaxCount(Value :integer);
begin
  FMaxCount:=Value;
end;

procedure TSybquery.SetBuffersize(Value :integer);
var p :pchar;
    s :string[20];
begin
  FBuffersize:=Value;
  s:=inttostr(value);
  new(p);
  strpcopy(p,s);
  if (Value > 0) then
  begin
    retcode:=dbsetopt(dbproc,DBBUFFER,p,-1);
  end;
  dispose(p);
end;

procedure tsybquery.addsql(Value :ansistring);
begin
  FSql:=FSql + Value;
end;

procedure tsybquery.clearsql;
begin
  FSql:='';
end;

procedure tsybquery.SetDbname(Value :SybObjectname);
begin
  FDbname:=value;
  get_dbproc;
end;

function tsybquery.sqlexec:integer;
var value             :string[255];
    linenum,i,j,rows  :integer;
    p                 :pchar;
begin
  if navigatorlist <> nil then
  begin
    for i:=0 to navigatorlist.count-1 do
    begin
      if tsybnavigator(navigatorlist[i]).DataSet = name then
      begin
        navigator:=tsybnavigator(navigatorlist[i]);
        break;
      end;
    end;
  end
  else
  begin
    navigator:=tsybnavigator.create(nil);
  end;

  get_dbproc;
  if dbprocc = 0 then
   exit;
  retcode:=dbcurcmd(dbProc);

  if (retcode2 <> More_Rows) then
  begin
    Retcode := Dbcanquery(dbProc);
    p:=pchar(Fsql);
    Retcode:=dbcmd(dbProc,p);
    Retcode:=dbsqlexec(dbProc);
    FCurrCmd:=dbcurcmd(dbProc);
    Retcode:=dbresults(dbProc);

    rows:=dbrows(dbProc);
    if rows = fail then
      setrowsreturned(false)
    else
      setrowsreturned(true);
    numcols:=dbnumcols(dbProc);
    FColumncount:=numcols;
    Result:=retcode;
    retcode2:=0;
    if retcode = Succeed then
    begin
      firstrownum:=1;
      lastrownum:=1;
{      retcode2 := dbnextrow(dbProc);}
    end;
  end;
end;

function Tsybquery.row_exists:boolean;
var res:integer;
begin
  result:=false;
  res:=nextrow;
  if res = -1 then
    result:=true;
end;

function Tsybquery.nextrow:integer;
begin
  result:=0;
  sproc_retcode:=0;

  if (retcode = Succeed) then
  begin

    retcode2 := dbnextrow(dbProc);
    Result:=retcode2;

    if retcode2 = No_More_Rows then
    begin
      if dbmorecmds(dbProc) = Succeed then
        get_next_resultset;
        retcode2 := dbnextrow(dbProc);
        Result:=retcode2;
    end;

    if (fupdatefields) and (retcode2=-1) then
      update_fields;
    if (navigator <> nil) then
    if trim(navigator.name) <> '' then
    begin
      case retcode2 of
        -1 :begin
              if first_flag then
              begin
                navigator.btnfirst.enabled:=false;
                navigator.btnprior.enabled:=false;
                navigator.btnnext.enabled:=true;
                navigator.btnlast.enabled:=true;
                first_flag:=false;
              end
              else
              begin
                navigator.btnfirst.enabled:=true;
                navigator.btnprior.enabled:=true;
                navigator.btnnext.enabled:=true;