sybgrid.pas

sybase大全

    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
  objectlist: Tobjectlistdlg;
{  SqlCommand:array[0..2048] of char;}
  Login,Retcode,retcode2,i:integer;
  dbname :SybObjectname;
  proc   :integer;
  tslist:tsybgrid;
  adatabase :tsybdatabase;
begin
  tslist:=tsybgrid(getcomponent(0));
  proc:=tslist.dbproc;

  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 tsybgrid.get_dbproc;
var i         :integer;
    adatabase :tsybdatabase;
begin
  if not autodbproc then
    exit;

  if 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;
end;

function Tstringsproperty.getattributes:Tpropertyattributes;
begin
  result:=[padialog];
end;

constructor Threadgrid.create(b:boolean;AOwner:tsybgrid);
begin
   fparent:=AOwner;
   inherited create(b);
   fparent:=AOwner;

{   f_cancel_query:=Tf_cancel_query.create(fparent);
   f_cancel_query.show;
   f_cancel_query.close;
   f_cancel_query.free;}
end;

procedure Threadgrid.Execute;
var value             :string[255];
    i,j,nc    :integer;
    p                 :pchar;
    rows,first        :integer;
    RetCode,retcode2  :integer;
    max_rows_return   :integer;
    max_numcols       :integer;
    sql_count         :integer;
    col_widths        :array[1..300] of smallint;

begin

  freeonterminate:=true;
  for j:=1 to fparent.rowcount do
    for i:=1 to fparent.numcols do
    begin
      if terminated then
      begin
        fparent.thread.destroy;
        exit;
      end;
      fparent.cells[i,j]:='';
    end;
  fparent.rowcount:=2;
  fparent.fixedrows:=1;
  fparent.colcount:=2;
  for i:=1 to 300 do
    col_widths[i]:=10;
  if terminated then
  begin
    fparent.thread.destroy;
    exit;
  end;
  Retcode := Dbcanquery(fparent.dbProc);
  max_numcols:=1;

  if terminated then
  begin
    fparent.thread.destroy;
    exit;
  end;

  fparent.linenum:=1;  {XX}
  first:=1;
  for sql_count:=0 to fparent.sql_commands.count-1 do
  begin

  p:=pchar(fparent.sql_commands[sql_count]);

  if terminated then
  begin
    fparent.thread.destroy;
    exit;
  end;
  Retcode:=dbcmd(fparent.dbProc,p);
  if terminated then
  begin
    destroy;
    fparent.thread.destroy;
    exit;
  end;
  Retcode:=dbsqlexec(fparent.dbProc);
  if terminated then
  begin
    fparent.thread.destroy;
    exit;
  end;
  Retcode:=dbresults(fparent.dbProc);
  if terminated then
  begin
    fparent.thread.destroy;
    exit;
  end;

  rows:=dbrows(fparent.dbProc);
  if terminated then
  begin
    fparent.thread.destroy;
    exit;
  end;
  if rows = fail then
  begin
  end
  else
  begin
    max_rows_return:=succeed;
  end;
  
  if terminated then
  begin
    fparent.thread.destroy;
    exit;
  end;

{  Result:=retcode;}

  fparent.numcols:=dbnumcols(fparent.dbProc);
  if fparent.numcols> max_numcols then
    max_numcols:=fparent.numcols;

  nc:=fparent.numcols;
  fparent.FColumncount:=max_numcols;
  if terminated then
  begin
    fparent.thread.destroy;
    exit;
  end;

  fparent.colcount:=max_numcols + 1;

  if terminated then
  begin
    fparent.thread.destroy;
    exit;
  end;

  while (retcode <> No_more_results) and (retcode <> Fail) do
  begin
    if terminated then
    begin
      fparent.thread.destroy;
      exit;
    end;
    if retcode = Succeed then
    begin
      if terminated then
      begin
        fparent.thread.destroy;
        exit;
      end;

      rows:=dbrows(fparent.dbProc);
      if rows <> fail then
      begin
        fparent.cells[0,fparent.linenum]:=' ';
        if fparent.showlinenum then
          if fparent.linenum > 0 then
            fparent.cells[0,fparent.linenum]:=inttostr(fparent.linenum);
        for i:=1 to fparent.numcols do
        begin
          if terminated then
          begin
            fparent.thread.destroy;
            exit;
          end;
          fparent.cells[i,fparent.linenum]:=dbcolname(fparent.dbProc,i);
          if (length(strpas(dbcolname(fparent.dbProc,i))) * fparent.fontsize > fparent.colwidths[i]) then
            fparent.colwidths[i]:=length(strpas(dbcolname(fparent.dbProc,i))) * fparent.fontsize;
          col_widths[i]:=fparent.colwidths[i];
        end;
        fparent.rowcount:=fparent.rowcount + 1;
        inc(fparent.linenum);
      end;

      retcode2 := dbnextrow(fparent.dbProc);
      while retcode2 <> No_More_Rows do
      Begin
        if terminated then
        begin
          fparent.thread.destroy;
          exit;
        end;

        if first = 0 then
          fparent.rowcount:=fparent.rowcount + 1
        else
          first:=0;

        fparent.cells[0,fparent.linenum]:=' ';
        if fparent.showlinenum then
          if fparent.linenum > 0 then
            fparent.cells[0,fparent.linenum]:=inttostr(fparent.linenum);
        fparent.colwidths[0]:=length(fparent.cells[0,fparent.linenum]) * fparent.fontsize + 5;
        if not fparent.showlinenum then
          fparent.colwidths[0]:=13;
        for i:=1 to fparent.numcols do
        begin
          if terminated then
          begin
            fparent.thread.destroy;
            exit;
          end;
          if (length(strpas(dbvalue(fparent.dbProc,i))) * fparent.fontsize > fparent.colwidths[i]) then
            fparent.colwidths[i]:=length(strpas(dbvalue(fparent.dbProc,i))) * fparent.fontsize;
          fparent.cells[i,fparent.linenum]:=dbvalue(fparent.dbProc,i);
          if length(fparent.cells[i,fparent.linenum])=0 then
            fparent.cells[i,fparent.linenum]:=' ';
          col_widths[i]:=fparent.colwidths[i];
        end;
        if terminated then
        begin
          fparent.thread.destroy;
          exit;
        end;
        inc(fparent.linenum);
        retcode2 := dbnextrow(fparent.dbProc);
{        result:=retcode2;}
      end;
    end;
    if terminated then
    begin
      fparent.thread.destroy;
      exit;
    end;
    Retcode := dbresults(fparent.dbproc);
    fparent.numcols:=dbnumcols(fparent.dbProc);
    if fparent.numcols > max_numcols then
      max_numcols:=fparent.numcols;
    fparent.colcount:=max_numcols + 1;

    for i:=1 to max_numcols do
    begin
      if fparent.colwidths[i]<col_widths[i] then
        fparent.colwidths[i]:=col_widths[i];
    end;
  end;
  if terminated then
  begin
    fparent.thread.destroy;
    exit;
  end;
  end;
  terminate;
  destroy;
end;

procedure tsybgrid.get_sql_commands;
var sFindText        :string[30];
    iFoundPosit      :integer;
    char_indx,i      :integer;
    go_count         :integer;
    l                :string;
    ifCurrentpos     :integer;
    lastfound        :integer;
    fin              :boolean;
    sql_comm         :string;

begin
  fin:=false;
  sFindText:='go' + char(13);
  l:='';
  ifCurrentpos:=1;
  char_indx:=0;
  lastfound:=1;
  sql_comm:=fsql + char(13);
  go_count:=0;
  sql_commands.clear;
  while (char_indx<=length(Sql_Comm))
    or (fin) do
  begin
    inc(char_indx);
    iFoundPosit := Pos(sFindText, lowercase(copy(sql_comm,char_indx,length(sql_comm))));
    if iFoundPosit=0 then
    begin
      fin:=true;

      if go_count=0 then
        sql_commands.add(sql_comm)
      else
      if char_indx <> length(sql_comm) then
      begin
        l:=copy(sql_comm,lastfound,length(sql_comm)-lastfound+1);
        if length(trim(l))>0 then
        begin
          sql_commands.add(l);
          if ShowRowCount then
          begin
            sql_commands.add('select "(" + convert(varchar(10),@@rowcount) + " rows affected)"');
          end;
        end;
      end;
      if sql_commands.Count=1 then
         sql_commands.add('select "(" + convert(varchar(10),@@rowcount) + " rows affected)"');
      exit;
    end;
    if iFoundPosit > 0 then
    begin
      ifCurrentpos:=iFoundPosit+char_indx+1;
      char_indx:=ifCurrentpos-1;
      l:=copy(sql_comm,lastfound,ifCurrentpos-lastfound-length(sFindText));
      sql_commands.add(l);
      if ShowRowCount then
      begin
        sql_commands.add('select "(" + convert(varchar(10),@@rowcount) + " rows affected)"');
      end;
      l:='';
      lastfound:=ifCurrentpos + length(sFindText)-1;
      inc(go_count);
    end;
  end;
  if sql_commands.Count=1 then
     sql_commands.add('select "(" + convert(varchar(10),@@rowcount) + " rows affected)"');
end;

end.