sybtable.pas

sybase大全

{$H+}
unit sybtable;

interface

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

type
  SybObjectname = string[30];
  sqlstring = array[0..8000] of char;
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
{  tsybtable = class(TWinControl)}
  TSybTable = class(TComponent)
  private
    { Private declarations }
    FSql            :ansistring;
    FTablename      :SybObjectname;
    FDbname         :SybObjectname;
    FDesignActive   :boolean;
    FMaxCount       :integer;
    FColumnCount    :integer;
    FBuffersize     :integer;
    FRowsReturned   :boolean;
    FAutoDbProc     :boolean;
    FUpdateFields   :boolean;
    FDbProc         :integer;
    FSprocUpdate    :SybObjectname;
    FSprocInsert    :SybObjectname;
    FSprocDelete    :SybObjectname;
{    FFields_List    :TStrings;}
    procedure SetUpdateSProc(Value :SybObjectname);
    procedure SetInsertSProc(Value :SybObjectname);
    procedure SetDeleteSProc(Value :SybObjectname);
    procedure SetAutoDbProc(Value :boolean);
    procedure setupdatefields(Value:boolean);
    procedure SetDbProc(Value :integer);
    procedure SetDbName(Value :SybObjectname);
    procedure SetDesignActive(Value :boolean);
    procedure SetMaxCount(Value :integer);
    procedure SetBuffersize(Value :integer);
    procedure SetRowsReturned(Value :boolean);
    procedure Settablename(Value :SybObjectname);
    procedure Readfieldscount(Reader: TReader);
    procedure Writefieldscount(Writer: TWriter);
    procedure Writefields(Writer: TWriter);
    procedure Readfields(Reader: TReader);
    procedure update_fields;
{    procedure SetFields_List(Value:TStrings);}
  protected
    { Protected declarations }
    first_flag :boolean;
    procedure get_dbproc;
    procedure get_databasefields;
    procedure DefineProperties(Filer: TFiler); override;
    procedure setname(const NewName:Tcomponentname); override;
    procedure LoadSqlFromFile(FileName :string);
  public
    fieldscount     :smallint;
    fields          :array[1..255] of SybObjectname;
    datafields      :array[1..255] of SybObjectname;
    datafieldscount :smallint;
    SqlCommand      :sqlstring;
    Login,Retcode,retcode2,nocols,col:integer;
    dbprocc:integer;
    numcols         :integer;
    firstrownum,lastrownum,currrownum:longint;
    navigator       :tsybnavigator;
{    fldslist    :tstrings;}
    constructor create(AOwner:TComponent); override;
    destructor destroy;
    function sqlexec:integer;
    function nextrow:integer;
    function prevrow:integer;
    function firstrow:integer;
    function lastrow:integer;
    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 loaded; override;
    function insert_record:integer;
    function update_record:integer;
    function delete_record:integer;
  published
    { Published declarations }
    property RowsReturned:boolean read fRowsReturned write setRowsReturned default false;
    property DbName :SybObjectname read FDbName write setDbname;
    property TableName :SybObjectname read FTableName write settablename;
    property DesignActive:boolean read fdesignactive write setdesignactive stored false;
    property MaxCount :integer read FMaxCount write SetMaxCount default 0;
    property ColumnCount :integer read FColumnCount;
    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 SProcUpdate :SybObjectname read FSProcUpdate write setUpdateSProc;
    property SProcInsert :SybObjectname read FSProcInsert write setInsertSProc;
    property SProcDelete :SybObjectname read FSProcDelete write setDeleteSProc;
    property UpdateFields:boolean read fupdatefields write setupdatefields default true;
{    property FieldsLst:TStrings read FFields_List write SetFields_List;}
  end;

procedure Register;

implementation
uses sybase32,
     objectlistdlg,
     ansistringedit,
     sybdatabase,
     sybsproc,
     sybcombobox,
     sybcheckbox,
     sybradiobutton,
     sybmemo;

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

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

procedure tsybtable.LoadSqlFromFile(FileName :string);
begin
  fsql:=sybase_components.LoadFromFile(FileName);
end;

procedure tsybtable.SetUpdateSProc(Value :SybObjectname);
begin
  FSProcUpdate:=value;
end;

procedure tsybtable.SetInsertSProc(Value :SybObjectname);
begin
  FSProcInsert:=value;
end;

procedure tsybtable.SetDeleteSProc(Value :SybObjectname);
begin
  FSProcDelete:=value;
end;

procedure TSybtable.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 TSybtable.Writefields(Writer: TWriter);
var
  I: Integer;
begin
  Writer.WriteListBegin;
  for I := 1 to fieldscount do
    Writer.WriteString(fields[I]);
  Writer.WriteListEnd;
end;

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

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

procedure TSybtable.loaded;
begin
  inherited loaded;
{  setfields_list(fldslist);}
end;

{procedure TSybtable.Setfields_List(Value :TStrings);
begin
  Ffields_List.assign(Value);
end;}

constructor tsybtable.create(AOwner:TComponent);
begin
  inherited create(AOwner);
  first_flag:=true;
  Fdesignactive:=false;
  Fautodbproc:=true;
  FBuffersize:=0;
  fupdatefields:=true;
  Fdbproc:=0;
{  ffields_list:=tstringlist.create;
  fldslist:=tstringlist.create;
  setfields_list(fldslist);}

  if tablelist = nil then
  begin
    tablelist:=TList.create;
  end;
end;

destructor tsybtable.destroy;
begin
  tablelist.remove(self);
  inherited destroy;
end;

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

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

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

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

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

procedure tsybtable.Setdesignactive(Value :boolean);
begin
  Fdesignactive:=Value;
  get_dbproc;
  if length(tablename) > 0 then
    get_databasefields;
{  setfields_list(fldslist);}
end;

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

procedure Tsybtable.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);
    dispose(p);
  end;
end;

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

function tsybtable.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;

  Fsql:='select * from ' + FTableName;

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

    rows:=dbrows(dbProc);
    if rows = fail then
      setrowsreturned(false)
    else
    begin
      setrowsreturned(true);
    end;

    numcols:=dbnumcols(dbProc);
    FColumncount:=numcols;
    Result:=retcode;
    retcode2:=0;
    if retcode = Succeed then
    begin
      firstrownum:=1;
      lastrownum:=1;
{      retcode2 := dbnextrow(dbProc);}
    end;
  end;
end;

procedure Tsybtable.Settablename(Value :SybObjectname);
begin
  Ftablename:=value;
  get_databasefields;
end;

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

function Tsybtable.nextrow:integer;
begin
  result:=0;
  if (retcode = Succeed) then
  begin
    retcode2 := dbnextrow(dbProc);
    Result:=retcode2;
    if (fupdatefields) and (retcode2=-1) then
      update_fields;
    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;
              navigator.btnlast.enabled:=true;
            end;
          end;