sybbasequery.pas

sybase大全

{$H+}
unit SybBaseQuery;

interface

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


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
  TSybBaseQuery = class(TComponent)
  private
    { Private declarations }
    FSql            :Ansistring;
    FActive         :Boolean;
    FDbname         :SybObjectname;
    FMaxCount       :Integer;
    FColumnCount    :Integer;
    FBuffersize     :Integer;
    FRowsReturned   :Boolean;
    FRowsAffected   :Integer;
    FAutoDbProc     :Boolean;
    FDbProc         :Integer;
    FCurrCmd        :Integer;
    procedure SetAutoDbProc(Value :Boolean);
    procedure SetDbProc(Value :Integer);
    procedure SetSql(Value :AnsiString);
    procedure SetDbName(Value :SybObjectname);
    procedure SetMaxCount(Value :Integer);
    procedure SetBuffersize(Value :Integer);
    procedure SetRowsReturned(Value :Boolean);
    procedure Get_Next_Resultset;
    procedure SetActive(Value :Boolean);
  protected
    { Protected declarations }
    procedure Get_DbProc;
    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;

    constructor Create(AOwner:TComponent); override;
    destructor Destroy; 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 GetRow(RowNum :Integer) :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 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;
    property RowsAffected :Integer read FRowsAffected;
    property Active :Boolean read fActive  write SetActive stored false;
  published
    { Published declarations }
    property ColumnCount :Integer read FColumnCount;
    property DbName :SybObjectname read FDbName write setDbname;
    property Sql :Ansistring read FSql write SetSql;
    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;
  end;

procedure Register;

implementation
uses Sybase32,
     ObjectListDlg,
     AnsiStringEdit,
     SybDatabase,
     StdCtrls;

procedure Register;
begin
  RegisterPropertyEditor(TypeInfo(SybObjectname),TSybBaseQuery,'',TSybObjectProperty);
  RegisterPropertyEditor(TypeInfo(AnsiString),TSybBaseQuery,'Sql',TStringsProperty);
  RegisterPropertyEditor(TypeInfo(AnsiString),TSybBaseQuery,'DesignSql',TStringsProperty);
  RegisterComponents('Sybase DBLIB', [TSybBaseQuery]);
end;

procedure TSybBaseQuery.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 TSybBaseQuery.Destroy;
begin
  querylist.remove(self);
  inherited destroy;
end;

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

procedure TSybBaseQuery.SetDbProc(Value :Integer);
begin
  FDbproc:=Value;
  Dbprocc:=Value;
end;

procedure TSybBaseQuery.SetAutoDbPRoc(Value :Boolean);
begin
  FAutoDbProc:=value;
end;

procedure TSybBaseQuery.SetSql(Value :AnsiString);
begin
  FSql:=Value;
end;

procedure TSybBaseQuery.SetRowsReturned(Value :Boolean);
begin
  FRowsReturned:=value;
end;

procedure TSybBaseQuery.SetMaxCount(Value :Integer);
begin
  FMaxCount:=Value;
end;

procedure TSybBaseQuery.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 TSybBaseQuery.AddSql(Value :AnsiString);
begin
  FSql:=FSql + Value;
end;

procedure TSybBaseQuery.ClearSql;
begin
  FSql:='';
end;

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

function TSybBaseQuery.SqlExec :Integer;
var value             :String[255];
    linenum,i,j,rows  :Integer;
    p                 :PChar;
begin
  FActive:=False;

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

  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);
    FRowsAffected:=0;
    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;
    end;
  end;
end;

function TSybBaseQuery.Row_Exists :Boolean;
var res  :Integer;
begin
  result:=false;
  res:=nextrow;
  if res = -1 then
    result:=true;
end;

function TSybBaseQuery.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
    else
      inc(FRowsAffected);

    currrownum:=dbcurrow(dbProc);
    if currrownum > lastrownum then
      lastrownum:=currrownum;
  end
  else
  begin
    result:=No_More_Rows;
  end;

  sproc_retcode:=result;
end;

function TSybBaseQuery.PrevRow :Integer;
var value      :String[255];
    retcode3   :Integer;
begin
  result:=0;
  sproc_retcode:=0;
  if (retcode = Succeed) then
  begin
    currrownum:=dbcurrow(dbProc);
    if currrownum > 1 then
      dec(currrownum);
    retcode3 := dbgetrow(dbproc,currrownum);
    if retcode3 = -2 then
    begin
      Result:=retcode3;
      sproc_retcode:=result;
      exit;
    end;
    Result:=retcode3;
  end
  else
  begin
    retcode:=No_More_Rows;
    result:=No_More_Rows;
  end;
  sproc_retcode:=result;
end;

function TSybBaseQuery.FirstRow :Integer;
var retcode3   :Integer;
begin
  result:=0;
  sproc_retcode:=0;
  if (retcode = Succeed) then
  begin
    retcode3 := dbgetrow(dbproc,firstrownum);
    Result:=retcode3;
  end
  else
    result:=No_More_Rows;
  sproc_retcode:=result;
end;

function TSybBaseQuery.LastRow :Integer;
var retcode3  :Integer;
begin
  result:=0;
  sproc_retcode:=0;
  if (retcode = Succeed) then
    retcode3 := dbgetrow(dbproc,dblastrow(dbProc))
  else
    result:=No_More_Rows;
  sproc_retcode:=result;
end;

function TSybBaseQuery.Column(Index :Byte) :String;
begin
  result:=strpas(dbvalue(dbproc,index))
end;

function TSybBaseQuery.Heading(Index :Byte) :String;
begin
  result:=strpas(dbcolname(dbproc,index))
end;

function TSybBaseQuery.ColType(Index :Byte) :String;
begin
  result:=strpas(dbprtype(dbcoltype(dbproc,index)))
end;

function TSybBaseQuery.ColLength(Index :Byte) :Integer;
begin
  result:=dbcollen(dbproc,index)
end;

function TSybBaseQuery.IsChar(Index :Byte) :Boolean;
var colltyp   :String;
begin
  result:=false;
  if (coltype(index)='char')
    or (coltype(index)='text')
    or (coltype(index)='datetime')
    or (coltype(index)='smalldatetime') then
  begin
    result:=true;
    exit;
  end;
  if (coltype(index)='binary')
    or (coltype(index)='tinyint')
    or (coltype(index)='smallint')
    or (coltype(index)='int')
    or (coltype(index)='float')
    or (coltype(index)='real')
    or (coltype(index)='numeric')
    or (coltype(index)='decimal')
    or (coltype(index)='bit')
    or (coltype(index)='money')
    or (coltype(index)='smallmoney')
    or (coltype(index)='sum')
    or (coltype(index)='avg')
    or (coltype(index)='count')
    or (coltype(index)='min')
    or (coltype(index)='max') then
  begin
    result:=false;
  end;
end;

procedure Tsybobjectproperty.GetValues(TheProc: TGetStrProc);
var
  Login,Retcode,
  retcode2,i     :Integer;
  dbname         :SybObjectname;
  s              :String;
  tslist         :TSybBaseQuery;
  adatabase      :TSybDatabase;
begin
  tslist:=TSybBaseQuery(getcomponent(0));

  if getname = 'DbName' then
  begin
    if databaseslist <> nil then
      for i:=0 to (sybase_components.databaseslist.count-1) do
      begin
        adatabase:=databaseslist[i];
        theproc(adatabase.name);
      end;
  end
end;

function Tsybobjectproperty.GetAttributes :TpropertyAttributes;
begin
  Result := [paValueList,paAutoUpdate,paMultiSelect];
end;

procedure TSybBaseQuery.Get_DbProc;
var i         :Integer;
    adatabase :TSybDatabase;
begin
  if not autodbproc then
    exit;
  if sybase_components.databaseslist <> nil then
    for i:=0 to (sybase_components.databaseslist.count-1) do
    begin
      adatabase:=databaseslist[i];
      if FDbName = adatabase.name then
      begin
        setdbproc(adatabase.dbproc);
        break;
      end;
    end;
end;

function TStringsProperty.GetValue :String;
begin
  result:=getstrvalue;
end;

procedure TStringsProperty.SetValue(const Value :String);
begin
  setstrvalue(value);
end;

procedure TStringsProperty.Edit;
var
  OKBottomDlg  :TOKBottomDlg;
begin
  OKBottomDlg:=TOKBottomDlg.create(nil);
  OKBottomDlg.memo.text:=getstrvalue;
  OKBottomDlg.showmodal;
  if OKBottomDlg.modalresult = mrok then
  begin
    setstrvalue(OKBottomDlg.memo.text);
  end;
  OKBottomDlg.free;
end;

function TStringsProperty.GetAttributes :TpropertyAttributes;
begin
  result:=[padialog];
end;

procedure TSybBaseQuery.LoadSqlFromFile(FileName :String);
begin
  clearsql;
  sql:=sybase_components.LoadFromFile(FileName);
end;

procedure TSybBaseQuery.Get_Next_Resultset;
var linenum,i,j,rows  :Integer;
    p                 :PChar;
begin
  FCurrCmd:=dbcurcmd(dbProc);
  Retcode:=dbresults(dbProc);
  rows:=dbrows(dbProc);
  if rows = fail then
    setrowsreturned(false)
  else
    setrowsreturned(true);
  numcols:=dbnumcols(dbProc);
  FColumncount:=numcols;

  retcode2:=0;
  if retcode = Succeed then
  begin
    firstrownum:=1;
    lastrownum:=1;
  end;

end;

function TSybBaseQuery.GetRow(RowNum: Integer):Integer;
begin
  Result:=dbgetrow(dbproc,RowNum);
end;

procedure TSybBaseQuery.SetActive(Value: Boolean);
begin
{  if Value then
    DatabaseByName(DbName).Connected:=Value;}
  FActive:=Value;
end;

end.