www.pudn.com > sybase_dblib4.zip > SybBaseQuery.pas

{$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.