delphi2007 教程

delphi2007 教程

首页 新随笔 联系 聚合 管理
  1013 Posts :: 0 Stories :: 28 Comments :: 0 Trackbacks

#

有个思路问题,哪位哥哥帮帮忙指点一下. Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiDB/html/delphi_20061216115615270.html
我在做订单管理和发货单管理时,遇到个问题,因为在发货单里包括了客户信息,订单详细信息等,是相联到了客户表,订单表,而订单表又分为表头信息表和表体信息表,订单的表头里也包括客户信息,我要如何执行发货单的添加和修改操作呢?界面设计上就把我难住了,如果把这些信息全放在发货单上,那么就是关系到四个表,如何象一张单据一样的添加修改操作呢?

如我要添加一张发货单,一定会有一份新的客户信息,和定单信息,那么我是在发货单窗体上用多表关联的方式只供查询,然后使用客户信息管理单独增加客户信息和订单信息,还是有什么办法可以在这个发货单窗体上直接输入进去呀.

客户基本信息应该是不变的,要把客户基本信息分开,在填写定/发货单时,只显示必要的客户信息,如姓名、地址、联系电话等,这些信息同时也可以让操作员可以修改,以应付临时变化,这些变更的信息,就是你要更改的客户临时信息(关联定货单或发货单的)。至于客户的基本信息,当有必要进行修改时,到专门的客户信息管理界面

我知道你的意思,我现在就是这么做的,在发货单中只对主要的信息进行处理,但是你说这几个主要的信息是存在发货单的表里还是对应到真正的客户信息表里呢?  
          我最最搞不清楚的是当点击添加发货单时,要输入的信息包括客户信息(是关联客户表的)、商品明细(关联定单表体表的),而产品明细中的产品名称又是关联产品信息表的(利用商品ID)这些关联在里面,我如果正常地使用APPEND、EDIT、POST的方法啊。使用了N个ADOQUERYT   和ADOTABLE控件了,都是相关联的关系,查询还行,更新能行吗?

哈....你问问题时,自己都是糊涂的!!!  
  客户-->订单.......-->发货-->客户  
  发货时首先选客户,再选此客户对应的订单!!!!!!!!!

我是有点说不明白,不过我知道是先客户再订单,发货是先对应客户的,然后再通过客户到订单,我的问题再说一次,看能否表达明白,产品清单是保存在订单表体中的,那么我的发货单上一定是使用了订单ID来与它关联,可是这种结构如果是查询的话很容易了,但是如果要添加新的的话,我是要对不同的表分别进行添加,再关联,还是在关联的状态下,直接添加呢?如果在关联的状态下,我直接对几个ADOQUERY控件进行APPEND的话,发货单的数据控件可以这样,但是和它关联的ADO数据控件就会出错了.不让使用APPEND事件.我应该如何做呢?

没人回答啊?唉!哪位知道怎么做的帮帮忙说两句吧?

我觉得,你的发货单界面如果需要编辑更新,最好不要用SQL关联订单表,而使用Lookup字段进行关联,这样编辑更新就不会出错了,编辑时如果要在订单表添加,用一个按钮,调出订单表编辑界面添加更新,然后刷新发货单编辑界面即可。

我的问题解决了,我是用的LOOKUP的方式.其实主要问题还是在细节的处理上,唉,还是缺少经验啊.

posted @ 2009-05-12 16:02 delphi2007 阅读(158) | 评论 (0)编辑 收藏

怎样设置DBGrid标题行、所选记录行的行高度和行背景颜色,所选列宽度 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiDB/html/delphi_20061216115412271.html
rt

1、Columns属性  
   
  2、OnDrawColumnCell事件  
  procedure   TForm1.DBGrid1DrawColumnCell(Sender:   TObject;   const   Rect:   TRect;  
      DataCol:   Integer;   Column:   TColumn;   State:   TGridDrawState);  
  var   i   :integer;  
  begin  
  if   gdSelected   in   State   then   Exit;  
  for   i   :=0   to   (Sender   as   TDBGrid).Columns.Count-1   do  
  begin  
  (Sender   as   TDBGrid).Columns[i].Title.Font.Name   :='宋體';    
  (Sender   as   TDBGrid).Columns[i].Title.Font.Size   :=12;    
  (Sender   as   TDBGrid).Columns[i].Title.Font.Color   :=clNavy;      
  (Sender   as   TDBGrid).Columns[i].Title.Color   :=$00FFC4C4;      
  end;  
  if   query1.RecNo   mod   2   =   0   then  
  (Sender   as   TDBGrid).Canvas.Brush.Color   :=   clInfoBk      
  else  
  (Sender   as   TDBGrid).Canvas.Brush.Color   :=   RGB(191,   255,   223);    
  DBGrid1.DefaultDrawColumnCell(Rect,DataCol,Column,State);  
  with   (Sender   as   TDBGrid).Canvas   do     begin  
  Pen.Color   :=   $00ff0000;      
  MoveTo(Rect.Left,   Rect.Bottom);      
  LineTo(Rect.Right,   Rect.Bottom);      
  Pen.Color   :=   clTeal;      
  MoveTo(Rect.Right,   Rect.Top);      
  LineTo(Rect.Right,   Rect.Bottom);      
  end;  
  end;

行高度怎么设置?标题行高度,记录行高度的设置方法?

posted @ 2009-05-12 16:02 delphi2007 阅读(671) | 评论 (0)编辑 收藏

求一简单SQL语句 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiDB/html/delphi_20061216115320272.html
有表A  
   
  A         B           C  
   
  中       1        
  国       2  
  首       3  
  都       4  
  北       5  
  京       6  
   
   
  求一sql语句实现  
  把所有记录的一个字符串字段自动连接  
  如上表用一条查询语句最终实现‘中国首都北京’  
  多谢了

设表名为T1(表名为A会与别名冲突),以下SQL可得到你要的  
  select   a.a+b.a+c.a+d.a+e.a+f.a   as   aa   from   t1   a,t1   b,t1   c,t1   d,t1   e,t1   f   where   a.b=b.b-1   and   b.b=c.b-1   and   c.b=d.b-1   and   d.b=e.b-1   and   e.b=f.b-1  
  但这种做法远远没有用程序实现简单高效  
 

程序的话:  
  procedure   TForm1.Button1Click(Sender:   TObject);  
  var  
      s:string;  
  begin  
      s:='';  
    with   ADOQuery1   do  
    begin  
          sql.Text:='select   a   from   t1   order   by   b';  
          open;  
          while   not   eof   do  
          begin  
              s:=s+FieldByName('a').AsString;  
              next;  
          end;  
    end;  
    ShowMessage(s);  
  end;

同意楼上的,我再给个存储过程:  
   
   
  select   @count=count(*)   from   T1  
  declare   @i   int  
  set   @i=1  
  declare   @str   varchar(8000)  
  set   @str=''  
  while   @i<=@count  
  begin    
      select   @str=@str+B   from   T1   where   c=@i  
      set   @i=@i+1  
  end  
   
  select   @str

用SQL真实不好实现  
  但我的表字段也没有规律,B列是不确定的字符,不一定是1,2,3...,并且记录数还不是确定的  
  A         B           C  
   
  中       qq        
  国       ee  
  首       qwr  
  都       rety  
  北       dfg  
  京       trf  
  和       kjk  
  a         sdfs  
   
  我的本意是查询,给一个字符串参数,比如‘首’,我要把这个表的A字段组合起来,查参数‘首’是否在这个表的A字段组合中,也就是给的参数是否在‘中国首都北京’中,要是用存储过程的话怎么写?效率比程序高吗?  
   
 

你查参数是否在A的字段组合中与查询参数是否在A上有区别吗?  
   
  设表为temp,SELECT   A   FROM   TEMP   WHERE   :P=A,这样难道查不出参数是否在A列上?

posted @ 2009-05-12 16:02 delphi2007 阅读(137) | 评论 (0)编辑 收藏

双击DBGrid记录行时在DBGridDBLClick事件中弹出一个窗体,但是在双击标题行时并不触发这个dblClick事件,应该怎么写代码? Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiDB/html/delphi_20061216114740273.html
rt

写在OnCellClick

type  
      TForm1   =   class(TForm)  
          DBGrid1:   TDBGrid;  
          ADOTable1:   TADOTable;  
          DataSource1:   TDataSource;  
          procedure   DBGrid1DblClick(Sender:   TObject);  
          procedure   DBGrid1MouseMove(Sender:   TObject;   Shift:   TShiftState;   X,  
              Y:   Integer);  
      private  
          GC:   TGridCoord;  
      public  
          {   Public   declarations   }  
      end;  
   
  var  
      Form1:   TForm1;  
   
  implementation  
   
  {$R   *.dfm}  
   
  procedure   TForm1.DBGrid1DblClick(Sender:   TObject);  
  begin  
      if   (GC.X   >   0)   and   (GC.Y   >   0)   then  
      begin  
          ShowMessage('DBCLICK');  
      end;  
  end;  
   
  procedure   TForm1.DBGrid1MouseMove(Sender:   TObject;   Shift:   TShiftState;   X,  
      Y:   Integer);  
  begin  
      GC   :=   DBGrid1.MouseCoord(x,   y);  
  end;

posted @ 2009-05-12 16:02 delphi2007 阅读(555) | 评论 (0)编辑 收藏

在用鼠标单击DBGrid标题单元格的时候总是在这个列的左侧出现一条黑色竖线,鼠标轻开后竖线消失,怎样在单击时不出现这条竖线? Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiDB/html/delphi_20061216114502274.html
rt

没有碰到过吗

是这样的,可能要重新写下DBGrid吧.  
  不过现在不用DBGrid了

在DBGrid的Options属性中将dgColumnResize设置为False

黑线的标准名称是效果线

posted @ 2009-05-12 16:02 delphi2007 阅读(269) | 评论 (0)编辑 收藏

如何采用数据库连接池解决数据连接问题 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiDB/html/delphi_20061216110359275.html
如何采用数据库连接池解决数据连接问题?欢迎大家一起讨论

up

关注!!

unit   Unit2;  
   
  interface  
  uses  
  Contnrs,   Classes,   ADODB,   Windows;  
   
  type  
      TConnnectionPool   =   class(TThread)  
      private  
          FConnStr:   String;  
          FMaxConn:   Integer;  
          FConnList:   TThreadList;  
          FUnUseConn:   TADOConnection;  
          procedure   GetUnUseConn;  
          function   GetCurrenCout:   Integer;  
      protected  
          procedure   Execute;   override;  
      public  
          Constructor   Create(ConnStr:   String;   maxConn:   Integer   =   20);  
          destructor   Destroy;   override;  
          function   GetConnection:   TADOConnection;  
      end;  
   
  implementation  
   
  {   TConnnectionPool   }  
   
  constructor   TConnnectionPool.Create(ConnStr:   String;   maxConn:   Integer);  
  begin  
          FreeOnTerminate   :=   True;  
          FConnStr   :=   FConnStr;  
          FConnList   :=   TThreadList.Create;  
          Inherited   Create(False);  
  end;  
   
  destructor   TConnnectionPool.Destroy;  
  var  
          i,count:   Integer;  
          List:   TList;  
          obj:   TObject;  
  begin  
      List   =   FConnList.LockList;  
      if   List.Count   >   0   then  
      begin  
              for   i   :=   0   to   List.Count   -   1   do  
              begin  
                      obj   :=   TObject(List.Items[i]);  
                      Obj.Free;  
              end;  
      end;  
      FConnList.Free;  
      inherited;  
  end;  
   
  procedure   TConnnectionPool.Execute;  
  var  
          aConn:   TADOConnection;  
          i,count:   Integer;  
          List:   TList;  
          obj:   TADOConnection;  
  begin  
          while   not   Terminated   do  
          begin  
                  Count   :=   GetCurrenCout;  
                  if   Count   <   FMaxConn   then  
                  begin  
                          aConn   :=   TADOConnection.Create(nil);  
                          aConn.ConnectionString   :=   FConnStr;  
                          aConn.Connected   :=   True;  
                          FConnList.Add(aConn);  
                  end  
                  else   if   count   >   FMaxConn   then  
                  begin  
                          List   :=   FConnList.LockList;  
                          for   i   :=   0   to   List.Count   -   1   do  
                          begin  
                              obj   :=   TADOConnection(List.Items[i]);  
                              if(obj.DataSetCount   =   0)   then  
                              begin  
                                      FConnList.Remove(obj);;  
                                      obj.Free;  
                              end;  
                          end;  
                          FConnList.UnlockList;  
                  end;  
                  GetUnUseConn;  
                  sleep(50);  
          end;  
  end;  
   
  function   TConnnectionPool.GetConnection:   TADOConnection;  
  var  
          obj:   TADOConnection;  
  begin  
          if   Assigned(FUnUseConn)   then  
          begin  
                  Result   :=   FUnUseConn;  
                  Exit;  
          end;  
          obj   :=   TADOConnection.Create(nil);  
          obj.ConnectionString   :=   FConnStr;  
          obj.Connected   :=   True;  
          FConnList.Add(obj);  
          Result   :=   obj;  
  end;  
   
  function   TConnnectionPool.GetCurrenCout:   Integer;  
  begin  
          Result   :=   FConnList.LockList.Count;  
          FConnList.UnlockList;  
  end;  
   
  procedure   TConnnectionPool.GetUnUseConn;  
  var  
          count,i:   Integer;  
          obj:   TADOConnection;  
          List:   TList;  
  begin  
          count   :=   GetCurrenCout;  
          if   count   <   1   then  
          begin  
                  FUnUseConn   :=   nil;  
                  Exit;  
          end;  
          List   :=   FConnList.LockList;  
          for   i   :=   0   to   List.Count   -   1   do  
          begin  
                  obj   :=   TADOConnection(List.Items[i]);  
                  if(obj.DataSetCount   =   0)   then  
                  begin  
                          FUnUseConn   :=   obj;  
                          break;  
                  end;  
          end;  
          FConnList.UnlockList;  
  end;  
   
  end.  
   
   
  不知道好不好用。。。

gz

。。。  
   
  学习

学习  
  顺路来讨点分,哈哈  
  我---山西-newsoft

要分

posted @ 2009-05-12 16:02 delphi2007 阅读(242) | 评论 (0)编辑 收藏

导入数据时界面假死 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiDB/html/delphi_20061216110133276.html
我做了个SQL脚本恢复工具,在向数据库恢复数据时,也就10万条左右吧。  
  界面就假死一样了,任务管理器中显示,未响应,但实际上是在运行的。  
  有没有好的方法可以解决这样的占用内存和CPU资源过大的问题?

用线程

这很常见阿,一是用状态条,可以计算一下腰处理数据条数,跟状态条进度对应起来,起码界面上用户可以看到程序正在执行中。  
  要不就只能用另一个线程处理了,用另一个线程偶尔也会暂时出现不响应的状况,但不会真死。

一种方法是使用多线程。  
  一种方法是使用TADOQuery的异步功能事件来实现。  
  另外一种是使用单个计算,单个显示(辅助ProgressBar)来实现。

进度条不能解决问题,因为这仍然是主线程,建议自己重新开个线程!

开个线程吧

TADOQuery的异步功能事件来实现还是不错的!

用线程吧  
  个人感觉还是用线程好一点儿

posted @ 2009-05-12 16:02 delphi2007 阅读(348) | 评论 (0)编辑 收藏

关于记录集问题 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiDB/html/delphi_20061216105905277.html
请问当我读取记录集的时候不用以下方式,我想一次读取两条记录,然后再循环下面两个,依次类推,应当怎么做啊,谢谢各位了!  
  while   not   adoquery.eof   do  
          begin  
                ......  
                next;     //每次只能读取一条记录  
          end;

在循环内部执行两次Next

呵呵,你读两个就保存两个,然后NEXT两次沙^_^  
  最好用findnext吧。

利用变量I来控制,I   mod   2=0

posted @ 2009-05-12 16:02 delphi2007 阅读(138) | 评论 (0)编辑 收藏

请问,怎么在DBGRID中改变CELL内容 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiDB/html/delphi_20061216104516278.html
我写了以下代码:但是还是显示数字  
  procedure   TMakeTicket.DBGridEh3DrawColumnCell(Sender:   TObject;  
      const   Rect:   TRect;   DataCol:   Integer;   Column:   TColumnEh;  
      State:   TGridDrawState);  
  begin  
      inherited;  
      with   DBGridEh3.Canvas   do  
      case   ADOQuery2.FieldByName('status').AsInteger   of  
      1:TextRect(Rect,Rect.Left,((Rect.Bottom-Rect.Top)-TextHeight('处理'))   div   2,'处理');  
      2:TextRect(Rect,Rect.Left,((Rect.Bottom-Rect.Top)-TextHeight('未处理'))   div   2,'未处理');  
        end;  
    DBGridEh3.DefaultDrawColumnCell(Rect,   DataCol,   Column,   State);  
  }

去掉inherited试试

procedure   TMakeTicket.DBGridEh3DrawColumnCell(Sender:   TObject;  
      const   Rect:   TRect;   DataCol:   Integer;   Column:   TColumnEh;  
      State:   TGridDrawState);  
  begin  
      inherited;  
      if   Column.FieldName   =   'Status'   then  
      begin  
          with   DBGridEh3.Canvas   do  
          begin  
              FillRect(Rect);  
              case   ADOQuery2.FieldByName('status').AsInteger   of  
              1:TextRect(Rect,Rect.Left,((Rect.Bottom-Rect.Top)-TextHeight('处理'))   div     2,'处理');  
              2:TextRect(Rect,Rect.Left,((Rect.Bottom-Rect.Top)-TextHeight('未处理'))   div   2,'未处理');  
          end;  
      end   else  
      DBGridEh3.DefaultDrawColumnCell(Rect,   DataCol,   Column,   State);

1:TextRect(Rect,Rect.Left,((Rect.Bottom-Rect.Top)-TextHeight('处理'))   div     2,'处理');  
              2:TextRect(Rect,Rect.Left,((Rect.Bottom-Rect.Top)-TextHeight('未处理'))   div   2,'未处理');  
   
  ============可以简洁点  
   
    1:TextOout(Rect.Left,   Rect.Top+2,'处理');  
    2:TextOout(Rect.Left,   Rect.Top+2,'未处理');

1:TextOout(Rect.Left+2,   Rect.Top+2,'处理');  
    2:TextOout(Rect.Left+2,   Rect.Top+2,'未处理');

posted @ 2009-05-12 16:02 delphi2007 阅读(220) | 评论 (0)编辑 收藏

麻烦大哥了,帮看看吧,很急,这样的Sql语句该怎样写? Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiDB/html/delphi_20061216082939279.html
有两个表,  
  Table1:   LoginoutInfo     --记录系统管理员进出时的时间,当然,用“结束任务”  
  的方法关闭程序是记录不到的,会只有Login,而没有Logout。  
  LoginoutInfo(user(char(20)),LogTime(DateTime),LogStatus(char(10)))  
  记录是这样的:  
  admin     2006-12-15   10:25:36       login  
  admin     2006-12-15   10:55:36       logout  
  admin     2006-12-15   10:59:10       login     --这里被结束任务,所以没有logout  
  user1     2006-12-15   11:09:20       login  
  user1     2006-12-15   11:15:11       logout  
  ......  
   
  Table2:   EventLogInfo  
  --记录管理员在系统里所有的操作  
  EventLogInfo(EvtTime(DateTime),EvtContent(nvarchar(100)))  
  记录是这样的:  
  2006-12-12   10:26:07         Delete   a   record  
  2006-12-12   10:26:12         add   a   record  
  2006-12-12   11:01:07         backup   database  
  2006-12-12   11:10:54         Delete   a   user  
  ....  
   
  我想得到这样的结果(其实就是把这些操作是谁做的加在描述后面):  
  2006-12-12   10:26:07         Delete   a   record   By   admin  
  2006-12-12   10:26:12         add   a   record   By   admin  
  2006-12-12   11:01:07         backup   database   By   admin  
  2006-12-12   11:10:54         Delete   a   user   By   user1  
  ....  
   
  请问,这样的语句如何写?  
  多谢了,很急,

delphi社区人气真的不行了!!

一次只能有一个管理员登陆

建议将表EventLogInfo增加一个用户字段来记录登陆的用户。  
  insert   into   EventLogInfo   values(.....Sql语句一样的写  
  Parambyname('EvtTime').value   :=   now;  
  parambyname('EvtContent').value   :=   '动作‘+’用户‘;

create   table   #LoginoutInfo(logNo   char(20),LogTime   DateTime,LogStatus   char(10))  
  insert   into   #LoginoutInfo  
  select   'admin','2006-12-15   10:25:36','login'  
  union   all   select   'admin','2006-12-15   10:55:36','logout'  
  union   all   select   'admin','2006-12-15   10:59:10','login'    
  union   all   select   'user1','2006-12-15   11:09:20','login'  
  union   all   select   'user1','2006-12-15   11:15:11','logout'  
   
  create   table   #event(EvtTime   DateTime,EvtContent   nvarchar(100))  
   
  insert   into   #event  
  select   '2006-12-12   10:26:07',   'Delete   a   record'  
  union   all   select   '2006-12-12   10:26:12',   'add   a   record'  
  union   all   select   '2006-12-12   11:01:07',   'backup   database'  
  union   all   select   '2006-12-12   11:10:54',   'Delete   a   user'  
  表帮大家建好了,

liaosummer  
   
  我明白您的意思,您的意思是说在记录eventlog的时候直接把操作人带上?  
  是的,  
  但是现在时间不允许了,  
  客户赶着要货,所以打算先用语句搞定,然后再改这里!!  
  特别多谢各位。。。  
 

不知道楼主的意思是不是说,要找出EventLogInfo.EvtTime在LoginoutInfo.LogTime之内的记录还是怎样.这两个应该要有一定的关联的吧??  
 

你都记下了是谁登陆的,记录动作的时候直接+用户名不就完了?  
  设个全局变量UserName  
 

着急还走弯路。。。

没救啦

select   a.Evttime,a.Evtcontent,b.user   from   table2   a     left     join   table1   b     on   b.logtime   <   a.evtime   order   by     b.logtime   desc     取小于当前操作时间中的最晚时间处所登陆的管理员用户  
  不过,上面的几个大侠都说了最好在table2中添加   User记录  
  注:随手写的没测试!

select   top   1   a.Evttime,a.Evtcontent,b.user   from   table2   a     left     join   table1   b     on   b.logtime   <   a.evtime   order   by     b.logtime   desc        
  忘了top1     [sql   server]

posted @ 2009-05-12 16:02 delphi2007 阅读(101) | 评论 (0)编辑 收藏

为何出现Error Loading Midas.dll消息? Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiDB/html/delphi_20061216011749280.html
用Delphi   7的dbExpress组件做。  
  建立一个TSQLConnection组件A,设置好参数后,正常连接SQL   Server数据库,并设置Active为True.  
  再建立一个TSimpleDataSet组件B,设置Connection为A,在B中的DataSet\CommanText添加select   *   from   detail,并将CommanType设置为ctQuery。  
   
  然后将B中的Active属性设置为True,这时就出现“Error   Loading   Midas.dll”的信息,是什么原因呢?
posted @ 2009-05-12 16:02 delphi2007 阅读(1016) | 评论 (2)编辑 收藏

delphi sql语句字符串的问题 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiDB/html/delphi_20061215232313281.html
SELECT   *  
  FROM   saveque  
  WHERE   rdate<#2006-12-7#;  
  (ACCESS库)  
  以上sql语句我放在ADOQuery1.SQL.Add('select   cpn   from   saveque   where   rdate<'+'#''+datetostr(DateTimePicker1.Date)+'#'+'');中老不对  
   
  应该怎么写啊!我是菜鸟帮帮我!  
  另外!这句sql查询语句在SQL2000server中也是这样写吗?  
  还有一个问题如果我想指定范围查询应该怎么写呢?  
  比如   2004-1-1     到   2005-1-1   日之间的所有数据?谢谢了  
   
 

ADOQuery1.SQL.Add('select   cpn   from   saveque   where   rdate<??')  
  adquser.Parameters.ParamByName('??').Value:=datetostr(DateTimePicker1.Date)  
 

select   cpn   from   saveque   where   rdate<'''+'#'+datetostr(DateTimePicker1.Date)+'#'+''  
  注意rdate<'''这里再加两个引号

这样写是对的,我验证过了:  
  select   cpn   from   saveque   where   rdate<#'+datetostr(DateTimePicker1.Date)+'#'  
   
  mssql   中这样写select   cpn   from   saveque   where   rdate<'+datetostr(DateTimePicker1.Date);  
   
  指定查找范围(mssql):select   cpn   from   saveque   where   rdate   between   '''   +   datettostr(datetimepicker1.date)   +   '''   and   '''   +   datettostr(datetimepicker2.date)   +   ''''  
   
 

mssql   中这样写select   cpn   from   saveque   where   rdate<'+datetostr(DateTimePicker1.Date);  
   
  ---------------------------------------  
   
  不好意思,应该是:  
   
  sqlstr:='select   cpn   from   saveque   where   rdate<'''+datetostr(DateTimePicker1.Date)   +   '''';

最好的方法是这样的:  
   
  'select   cpn   from   saveque   where   rdate<:aa   '  
   
  然后再在adoquery1.open前面放上下面这一句就可以啦.  
  adoquery1.Parameters.ParamByName('aa').Value:=trim(DateTimePicker1.Date);  
   
  在access   和sqlsever中通杀!

最后一个最简单明了!结帖!参与有分!谢谢!

结帖

posted @ 2009-05-12 16:02 delphi2007 阅读(275) | 评论 (0)编辑 收藏

DBgrid 显示两个表中字段值不同的值 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiDB/html/delphi_20061215211111282.html
大家好,新手学习遇到如下问题向各位高手求助,  
  有两个表  
  表a     名称             数量             表b     名称           数量  
          SIM模块         100                       避雷器           100  
          避雷器           100                       雨量计             50    
            电源             200                       电池板           100    
   
  表b作为入库表,表a做为库存表。   想将表b中的内容加到表中:名称相同的数量加到一起,不同的插入后一块显示。要在DBGrid中显示的   内容如下:  
     
      名称         数量  
   
  SIM模块       100  
  避雷器         200  
  电源             200  
  雨量计         50  
  电池板         100  
   
  我尝试在dataset的CommandTex中输入以下SQl语句  
   
  select   a.名称,a.数量+b.数量   as   数量  
  from   a,b   where   a.名称=b.名称  
  union  
  select   a.名称,a.数量   from   a,b   where   a.名称<>b.名称  
   
  这样的语句执行后在Dbgrid中显示的结果:  
      名称         数量  
  SIM模块       100    
  避雷器         100  
  避雷器         200  
  电源             200  
   
  我也知道选择是的a表中的字段值   但union   连接的是前后的字段类型必须相同  
  也尝试了插入子查询   但就是不能得到预想的结果   。。十分苦闷  
  请各大侠指点   。。谢谢  
   
   
   
   
 

简单.   老冯来霸占20分

Select   名称,    
                数量+  
                (Case   When   (Select   Sum(数量)   From   表B   Where   名称   =   表A.名称)   Is   Null   Then   0    
                            Else   (Select   Sum(数量)   From   表B   Where   名称   =   表A.名称)   End)   数量  
  From   表A  
   
  Union  
   
  Select   名称,   数量    
   
  From   表B    
   
  Where   名称   Not   In   (Select   Distinct   名称   From   表A)  
   
  Group   By   名称  
 

对不起,   笔误:  
  Select   名称,    
                数量+  
                (Case   When   (Select   Sum(数量)   From   表B   Where   名称   =   表A.名称)   Is   Null   Then   0    
                            Else   (Select   Sum(数量)   From   表B   Where   名称   =   表A.名称)   End)   数量  
  From   表A  
   
  Union  
   
  Select   名称,   Sum(数量)    
   
  From   表B    
   
  Where   名称   Not   In   (Select   Distinct   名称   From   表A)  
   
  Group   By   名称

非常感谢阿    
  可是当按照你的语句输入到ADODataset中的CommandText   中去之后   执行   令ADODataset.active:=true   之后   提示   无法指定的错误   不知为什么/  
   
  是不是将  
  Select   名称,    
                数量+  
                (Case   When   (Select   Sum(数量)   From   表B   Where   名称   =   表A.名称)   Is   Null   Then   0    
                            Else   (Select   Sum(数量)   From   表B   Where   名称   =   表A.名称)   End)   数量  
  最后的   数量   之前   加上个   as   呢?  
   
  。。  
 

Select   名称,   Sum(数量)   数量   //我漏了数量2个字  
   
  From   表B    
   
  Where   名称   Not   In   (Select   Distinct   名称   From   表A)  
   
  Group   By   名称

To:   老冯   ,高手   十分感谢啊。看明白了,但还得请教您,下面是我在ADODataset中输入的完整的sql语句,完全是按照你的思路写的,就是换了一下字母名称,StorIn是表B,StoreAll是表a,  
   
  select   PoductName,Product_Num+(Case   when   (Select   sum(Ptoduct_Num)     From   StorIn   Where   ProductName=StoreAll.ProdutName)   is   null   then   0   else   (select   sum(Product_Num)   from   StorIn   where    
  ProductName=StoreAll.Name)   end     Product_Num  
  from   StoreAll  
  Union  
    Selec   ProductName,   sum(Product_Num)   Product_Num  
  from   StorIn  
  where   ProductName   not   in   (select   distinct   Product_Name   from   StoreAll)  
  Group   by   ProductName  
   
  令ADODataset的属性Active:=   true后   显示的是:   未指定错误  
   
  很郁闷   。。我看到您的思路是没有问题的,但为什么会出现这样的提示,难道是Delphi中的用SQL   语句不能写这样长吗   ?

呵呵,你有笔误:  
   
  Select   PoductName,  
                Product_Num+(Case   when   (Select   sum(Ptoduct_Num)     From   StorIn   Where     ProductName=StoreAll.ProdutName)   is   null   then   0   else    
                                                              (select   sum(Product_Num)   from   StorIn   where    
  ProductName=StoreAll.Name)   end   )   Product_Num   //end   )你漏了括号  
  from   StoreAll  
  Union  
    Selec   ProductName,   sum(Product_Num)   Product_Num  
  from   StorIn  
  where   ProductName   not   in   (select   distinct   Product_Name   from   StoreAll)  
  Group   by   ProductName  
   
 

我的老天爷啊,   你好多单词错误啊。我给你修正了一下  
   
  表:   StoreAll   ,   StoreIn  
   
  字段:   ProductName,   Product_Num  
   
  Select   ProductName,  
                Product_Num+(Case   when   (Select   sum(Product_Num)     From   StoreIn   Where     ProductName=StoreAll.ProductName)   is   null   then   0   else    
                                                              (select   sum(Product_Num)   from   StoreIn   where    
  ProductName=StoreAll.ProductName)   end   )   Product_Num    
  from   StoreAll  
  Union  
    Select   ProductName,   sum(Product_Num)   Product_Num  
  from   StoreIn  
  where   ProductName   not   in   (select   distinct   ProductName   from   StoreAll)  
  Group   by   ProductName

是,我忘了个括号。。,太粗心了    
   
  但是加上之后   还是提示那样的:   未指定错误,我太郁闷了    
  这是不是Delphi   编译器的问题啊怎还出现这样的错误。。还得麻烦您,,谢谢

建议以后再把SQL语句写到应用程序里面去(虽然这种方法很不好)之前,   先在查询分析器里面运行一下。

你把我修正后的这段加到程序里面运行看看。

修正后的:  
   
  表:   StoreAll   ,   StoreIn  
   
  字段:   ProductName,   Product_Num  
   
  Select   ProductName,  
                Product_Num+(Case   when   (Select   sum(Product_Num)     From   StoreIn   Where     ProductName=StoreAll.ProductName)   is   null   then   0   else    
                                                              (select   sum(Product_Num)   from   StoreIn   where    
  ProductName=StoreAll.ProductName)   end   )   Product_Num    
  from   StoreAll  
  Union  
    Select   ProductName,   sum(Product_Num)   Product_Num  
  from   StoreIn  
  where   ProductName   not   in   (select   distinct   ProductName   from   StoreAll)  
  Group   by   ProductName  
   
  用ADODataset测试运行通过。

To:老冯   十分感谢   感谢   您一句一句的纠正语句单词的错误  
  终于发现原来语句中的很多错的单词    
  现将修改好的语句如下,    
  select   ProductName,  
                     
              Product_Num+(Case   when   (Select   sum(Product_Num)     From   StorIn   Where    
   
            ProductName=StoreAll.ProductName)   is   null   then   0   else      
                                                              (select   sum(Product_Num)     from   StorIn   where    
            ProductName=StoreAll.ProductName)   end)   Product_Num  
    from   StoreAll  
   
  Union  
   
  Select   ProductName,sum(Product_Num)   Product_Num  
   
  from   StorIn  
   
  where   ProductName   not   in   (select   distinct   ProductName   from   StoreAll)  
   
  Group   by   ProductName  
   
  还得   您看看,我发现是没有   错误了      
  执行之后   还是提示:   未指定错误   啊      
 

对了   那个表的名字是   StorIn   当时建表的时候r   后的e   没有   写

你后台是不是SQLSERVER?

后台用的是access2003

是不是有影响啊

哈哈哈哈,   ACCESS不支持嵌套查询。

如果用ACCESS和是不是没有其他的办法了  
   
   
   
  看来我必须用SQLServer了啊     再在SQLSERVer中建库    
   
  刚才我用delphi试着连接了一下SQLSERver数据库    
  用的是TADOConnection   ADOQuery   TDBGrid   来连接   当在“连接”的选项卡上设置  
  “3.在服务器上选择数据库”这项时   出现了“无效的授权说明”   不知是怎么回事

MicroSoft   OLE   DB   Provider   For   SQL   Server   --->>Next   --->   ...

SQLSERVER企业管理器上的——控制台根目录  
                                                        -     Microsoft   SQL   Servers  
                                                            -MR服务器组  
                                                                +(LOCAL   )(windowsNT)  
                                                            -SQl   SERVER组  
                                                                      (无项目)  
   
  (MR服务器组是新建的服务器组)  
   
  是不是   问题出在了   SQLSERVER组下没有项目   这个问题上阿  
 

是的   刚才我就是按照您说的那个顺序做的   当时   在“数据连接属性”对话框下设置   :3.在服务器上选择数据库   时   出现了“无效的授权说明”   就连接不下去了

呵呵,     你   再刷新   或重新注册一个。   事情够多的啦。呵呵呵呵

十分感谢你啊   非常感谢   。。。。  
  现在终于发现了一些问题  
  再有问题向您   请教。。感谢。。

在查询分析器里   连接连接sQLserver 时也找不到local,而是一个没有见过的名字 有没有必要卸掉SQLERver重装啊

posted @ 2009-05-12 16:02 delphi2007 阅读(291) | 评论 (0)编辑 收藏

经典的判断数据库连接断开问题,翻遍了许多地方没有答案。 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiDB/html/delphi_20061215202145283.html
程序正常连接状态下,服务器重启、或网络断开等原因将导致数据库连接非正常断开,这时ADOConnection1.Connected、ADOConnection1.State都显示是连接状态(分别为True和stOpen),但其实连接已经断开,服务器、网络正常后一样,目前唯一的办法是关闭并重开程序,这显然不人性化。  
   
  每次查询数据不经判断连接状态都来一次重新连接数据库明显不现实。  
   
  请问,如何判断AdoConnection是否失去了连接?好让我们重新连接数据库:  
      ADOConnection1.Connected   :=   False;  
      ADOConnection1.Connected   :=   True;  
 

try  
          ADOConnection1.Connected   :=   False;  
          ADOConnection1.Connected   :=   True;  
  except  
          有问题  
  end;

每次查询数据不经判断连接状态都来一次重新连接数据库明显不现实。  
   
  楼上这样不就是每次都重新连接数据库吗。

重点在于如何“判断”ADOConnection1.Connected   =   True但AdoConnection其实已经失去了连接?

用timer   刷,  
   
  动态创建   TADOConection   ,设置   ConnectionString   ,然后   Connected   :=   True;  
   
  异常判断就可以!  
   
  发分吧!!!

function   ConnectAppServer:   boolean;   //判断是否连接上了应用服务器  
  begin  
      Result   :=   True;  
      ADOConn.Connected   :=false;  
      try           //测试连接  
          ADOConn.Connected   :=   true;  
      except   //未连接上  
          Result   :=   False;  
      end;  
  end;  
   
  调用时:  
  if   ConnectAppServer   then  
      begin  
          进行处理功能;  
      end  
  else  
      begin  
          showmessage('对不起!数据库失去连接');  
          进行失败处理;  
      end;  
 

在查询的时候用  
  try  
  except  
  重连  
  end;  
 

楼上几位都是每次都要重新连接数据库才能判断出来,这样做不理想,起码响应速度慢。  
   
  就怕你们这么答,我才事先声明了,可能你们急着要分漏了看题?:(  
   
  如能解决好这个问题,我再加200分。  
 

需要时连接,平时断开

你实时去判断他断没有断开,是会耗费大量的网络资源的.

ADOConnection1BeforeDisconnect事件  
  或者  
  ADOConnection1AfterDisconnect事件  
  或者  
  ADOConnection1Disconnect事件来判断出发

楼上的有创意,学习了

我怎么感觉事件一点用都没有!?

你可以判断数据库的端口是否开放,如果返回false说明通讯有中断...

可以先执行操作,如果出现操作异常时,判断是否是因为数据库连接失败引起的,再重新执行你所要执行的操作了。

这种问题根本就没有讨论的价值  
   
  1、如果网络真的断开了,这个时候不管你的程序判断结果是什么,你都得关闭程序  
  2、如果没有断开,系统会自动尝试去连接的  
   
  如果每次都判断,那会造成系统很大的负担。

一般是选   去   “干事”   要是出错了,查一个出错类型才会知是网络断了  
   
  当然某些客户端很久用一次的,但又需要显示连接状态的,做个心跳查询定时检测下连接也是有必要的,只不过时间设长一点。。。

Hank(星星农场)  
  ----  
  这种问题根本就没有讨论的价值  
   
  1、如果网络真的断开了,这个时候不管你的程序判断结果是什么,你都得关闭程序  
  2、如果没有断开,系统会自动尝试去连接的  
   
  如果每次都判断,那会造成系统很大的负担。  
  ----  
   
  Hank(星星农场)的回答还有些许切题,不过也是没心思认真看题。  
   
  1、网络彻底断开了,还用问你干嘛,如来佛祖都没办法。  
  我写的是“服务器、网络正常后一样”,ADOConnection1显示是连接状态,但其实连接已经断开。  
   
  2、系统会自动尝试去连接的,系统如何去自动尝试?  
   
  3、如果每次都判断,那会造成系统很大的负担。的确是这么回事。  
   
  麻烦各位都认真看下题。

我认为   Hank(星星农场)   的观点是值得参考的  
  判断网络联接是否正常要看实际的应用程序中是否需要,而且如果用timer等来断开联接是非常耗费资源的.  
  我有个想法,假设我们认为联接是正常的,每次从数据库系统表中查询:  
  在sqlserver中可以select   sysdate,  
  在oracle中可以   select   sysdate   from   dual  
  如果不出错,则我们就认为是正常的,如果出错,刚关闭联接,再联接,你们觉得如何  
 

说明,我已经仔细看过题目了,也知道你的意思  
   
  1、系统运行的好好的,服务器重起,这个时候客户端是没有提示的,但是当客户端进行数据库相关操作时系统会提示断开,你想这个时候能给客户一个提示是没有意义的,因为在实际过程中如果重起要么管理员提前通知要么电话去问。  
   
  2、重起完后如果进行系统数据操作,系统会自己尝试去连接的,这不是自动连接吗?  
   
  3、如果真的要判断,那只有单独建立一个ADOConnection去尝试连接数据库,这样就太罗嗦了  
   
  4、如果你的应用是那种如果服务器连不上数据暂时保存在本地的玩法最好通过事务处理去做

前几天的系统中也出现了这样的需求.  
  试了一些办法:  
  ...............  
  1.用你的连接执行一个简单的查询操作,如select   getdate()看有无返回值.  
  2.采用多线程的方式,用一个ADOConnection专门来判断网络.并给系统一个全局变量来记录网络状态,在操作时只需判断变量状态值.  
  3.采用Indy方式,客户机和服务器分别放一个.客户机每发一个消息出去后,若服务器接收到则马上返回一个值.如客户机发一个"1+1"的消息,服务器马上返回"2".当然里边要加一些你自己的约定格式串,不然客户机多了分不清.在指定的时间内没接收到返回值的话说明网络已经出现故障.

基本上所有的系统都会面临这种问题的,我的解决办法是:  
   
  定义一个Timer,定期的执行一个最简单的查询操作,比如Select   SYSDATE   from   DUAL   根据结果判断是否断线,然后ReConnect

楼主你要知道,你又要判断是否连接,又不允许人家刷新检测,我觉得是不对的.  
  我估计你是怕刷新检测时时间太长,那么,你可以单独设置一个adoConnection,把它的timeout设置短一点,然后用一个数据集查询如:   select   1   as   testnum  
  如果出错就说明连接可能有问题了.  
   
 

你如果想靠检测网络是否连接来判断数据库连接是否正常的话,那是不行的.  
  你可以试一下:把网络拔了,马上又插上.1秒钟绝对能搞定,但数据库却断开了连接.

感觉没有好的办法.  
   
  因为网络断开也不是一个就能确定的.就像楼上所说的那样.   windows系统也不能一下就确定网络连接不上.   还需要判断一会的时间,   就像本地连接那样.   把网线拨了,   也不是立即就显示断开了.   还要在那动一会就提示   "   网络连接失败   "

请大家注意我的重点:  
   
  如何不通过查询来判断AdoConnection是否失去了连接,通过状态属性什么的。

我的一个想法,不知道可不可啊?  
  一般我们都是用  
  Try  
  except  
  end  
  来捕捉异常的。  
  自定义一个异常来显示不能与数据库连接???  
  每当有这个异常的时间,就自动重新连接数据库就可以了??  
  这样就不用刷新判断了??只有出现这个连接不上数据库的时候才会重连接了

GoldShield(李柏岑)   (   )   信誉:106         Blog     2006-12-22   13:34:48     得分:   0      
     
     
         
  前几天的系统中也出现了这样的需求.  
  试了一些办法:  
  ...............  
  1.用你的连接执行一个简单的查询操作,如select   getdate()看有无返回值.  
  2.采用多线程的方式,用一个ADOConnection专门来判断网络.并给系统一个全局变量来记录网络状态,在操作时只需判断变量状态值.  
  3.采用Indy方式,客户机和服务器分别放一个.客户机每发一个消息出去后,若服务器接收到则马上返回一个值.如客户机发一个"1+1"的消息,服务器马上返回"2".当然里边要加一些你自己的约定格式串,不然客户机多了分不清.在指定的时间内没接收到返回值的话说明网络已经出现故障.  
   
       
     
  支持

如果你想快可以用   IDIcmpClient为判断,直接用Adoconnection有个响应时间,比较长了点  
   
  function   conip_only:   Boolean;    
  begin  
      result   :=   false;  
      IdIcmpClient1.Host:='192.168.0.2';  
      try  
              IdIcmpClient1.Ping;  
              result   :=   true;  
      except  
                on   e:exception   do  
                showmessage(e.Message+'网络通讯中断.');  
      end;  
  end;

procedure   TdtmConnect.tiKeepConnectTimer(Sender:   TObject);  
  begin  
      try  
          conMain.Execute('Select   @@CONNECTIONS');  
          //MsgBox('服务器正常连接中...');  
      except  
          tiKeepConnect.Enabled   :=   False;     //停止时钟走动  
          ErrBox('网络断开,与服务器的连接已经中断。');  
   
          if   not   Assigned(frmConnect)   then  
              frmConnect   :=   TfrmConnect.Create(self);  
          try  
              frmConnect.ShowModal;  
          finally  
              FreeAndNil(frmConnect);  
          end;  
      end;  
  end;

什么情况下使用呢?  
  通常,网络断开的话,系统会出错的,这时候就需要检查网络了

TAdoConnect组件有多个事件可用于判断

我将程序中所有用到查询、执行SQL、执行存储过程的地方封装成几个函数,然后在这几个函数执行失败的时候调用如下函数:  
   
  //再次联接  
  function   TDataModuleForm.ReConnect(Connection:   TADOConnection):boolean;  
  var   i,j:integer;   FBreak,FErr:boolean;  
  label   lbl_try;  
  begin  
      result:=false;  
      FBreak:=false;  
      FErr:=false;  
      for   i:=0   to   connection.Errors.Count-1   do  
      begin  
            if   FBreak   then   Break;  
            if   connection.Errors[i].Number=-2147467259   then  
            begin  
                  FBreak:=true;  
                  connection.Errors.Clear;  
                  if   messagedlg('系统检测到数据库联接已断开,需要系统尝试重新联接数据库吗?',mtinformation,[mbOk,mbCancel],0)=1   then  
                  begin  
  lbl_try:  
                      connection.Close;  
                      FErr:=false;  
                      j:=connection.ConnectionTimeout;  
                      connection.ConnectionTimeout:=5;  
                      screen.Cursor:=-11;  
                      application.ProcessMessages;  
                      try  
                              try  
                                      connection.Connected:=true;  
                              except  
                                      FErr:=True;  
                              end;  
                      finally  
                              connection.ConnectionTimeout:=j;  
                              screen.Cursor:=0;  
                              connection.Errors.Clear;  
                      end;  
                      if   FErr   and   (Messagedlg('联接失败,再次尝试联接吗?',mtinformation,[mbOk,mbCancel],0)=1)   then   goto   lbl_try;  
                  end;  
            end;  
      end;  
      result:=not   FErr;  
  end;

try  
       
  except  
      判断是否是断开连接的异常  
  end;

kaper()与zczb(zczb)的解答比较有建设性,谢谢。

嗨,这个真的没必要搞得那么复杂,楼主这样才比较耗资源啊

这样啦:还是用timer1  
   
  多放个   adodataset1,    
   
  在timer1.ontimer里写:  
  try  
      adodataset1.close;  
      adodataset1.commandtext:='select   getdate()';  
      adodataset1.open;  
  expect  
      showmessage('连接断开');  
  end;  
       
 

我不喜欢做自动连接。因为例如日志写满。或者其它原因。你这样的动作,会导致系统长时间处于检查数据库的连接中,但事实上却是暂时连不上来的,务必会导致死循环!   我想楼主的意在寻找能够检测到数据断开连接应该也是为了能够自动连接吧,退一步说,软件的使用出现连接不上数据库的时候。无非几个原因。1,网络   2,数据库服务器,3,数据库软件。4。程序本身。   5。其它       这些原因都会迫使你停下来调整。没有检测和重新连接的必要!   个人愚见,

楼主想复杂了.  
   
  try  
  ......  
  .....  
  .....  
  except  
      adoconnection.close;//   为下一次连接作准备.  
  end  
 

还是未搞懂我的意思。

我们这里的软件遇到这个问题,解决的办法是,每次用数据库的时候都把connection和query打开一次,同时在界面上留有panel来提示网络断开还是数据库断开(下面两个函数是我们用来判断网络断开还是数据库断开的函数):  
  function   CheckNetConnection(IP:   string):   Boolean;  
  var  
      Echo:   TIdEcho;  
  begin  
      Echo   :=   TIdEcho.Create(nil);  
      with   Echo   do  
      begin  
          try  
              Host   :=   IP;  
              Connect(1000);  
              Result   :=   True;  
          except  
              Result   :=   False;  
          end;  
      end;  
      Echo.Free;  
  end;  
   
  function   CheckDBConnection(IP:   string):   Boolean;  
  var  
      Telnet:   TIdTelnet;  
  begin  
      Telnet   :=   TIdTelnet.Create(nil);  
      try  
          with   Telnet   do  
          begin  
              if   Connected   then   Disconnect;  
              Host   :=   IP;  
              Port   :=   1433;//数据库服务用的端口号(Sql   server使用这个端口号)  
              try  
                  Connect(1000);  
                  Result   :=   True;  
              except     //否则重连  
                  Result   :=   False;  
              end;  
          end;  
      finally  
          Telnet.Disconnect;  
          Telnet.Free;  
      end;  
  end;

上面两个函数在Timer中周期性检查,我们的timer时间间隔为10秒,显示稍微之后,不过客户能够容忍,另外断开网络的时候检索数据库还是偶尔卡一点,不过无需重起软件,只要处理网络和数据库就行了

每次有人找我问起楼主那个经典问题,我都是同样的回答..  
  可几乎每次问问题的人总以为我在开玩笑.  
   
  当数据库连接断开时,这时候需要做什么呢?是试图重连?不断检查连接状态?    
  NO!   不要这样做!  
  数据库为什么断开?多半网络问题或者数据库当机或重启.事实上,这时候试图程序自动重连,  
  毫无意义!这样做反而会为负担很重的网络更没有恢复的机会.  
   
  这时候该做什么?   是的,释放连接对象,很多封装底层连接的组件,都会暂存连接状态,  
  当底层实际连接失败,封装对象的状态却是连接正常,这时候,连接不可能得到恢复.  
  怎么让封装对象与底层连接状态一致?   很简单,让连接对象CLOSE!  
   
  怎么知道连接失败?   在对数据库操作时!   对于VCL,组件会扔出数据库类型的异常,要做的,就是抓住它.对于使用数据感知控件,在Application.OnException事件中也可以得到它.  
  在处理这样异常时,就按刚才说的那样,"让连接对象CLOSE"!  
   
  对于状态为CLOSE的连接对象,不需要再操心什么.在使用VCL封装Ado时,当连接对象AdoConnection状态为关闭时,任何一个数据库的操作,它都会自动去连接.这是缺省的属性设计.  
   
 

同意楼上,也许我们考虑的楼上的意见以后可以解决我们软件仅有的一顿的问题,那样提示\重连\而且还不顿,就比较好了

TDataForm   =   class(TDataModule)  
          //...  
          procedure   DataModuleCreate(Sender:   TObject);  
      private  
          FOldApplicationOnException     :   TExceptionEvent;  
          procedure   HandleException(Sender:   TObject;   E:   Exception);  
      ...  
      end.  
   
  procedure   TDataForm.DataModuleCreate(Sender:   TObject);  
  begin  
      ...  
      FOldApplicationOnException     :=     Application.OnException;  
      Application.OnException   :=     HandleException;  
  end;  
   
  procedure   TDataForm.HandleException(Sender:   TObject;   E:   Exception);  
  begin  
      if   E.ClassNameIs('EOleException')   then  
          if   ShowMsg(Screen.ActiveForm,   format(  
                  '数据库连接被意外中止,要重新连接吗?'#10#13+  
                  '错误原因:%s',  
                  [E.Message]))   =   IDYES   then  
          begin  
              MainConn.Connected     :=     False;  
              MainConn.Connected     :=     True;  
              Exit;  
          end;  
      if   Assigned(FOldApplicationOnException)   then  
          FOldApplicationOnException(Sender,   E)  
  end;

mark

我也遇到了类似的问题,   大家有时间看看  
  http://community.csdn.net/Expert/topic/5460/5460676.xml?temp=7.497805E-02

posted @ 2009-05-12 16:02 delphi2007 阅读(581) | 评论 (0)编辑 收藏

救命!!连接Oracle问题,在线等! Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiDB/html/delphi_20061215193831284.html
连接oracle数据库,电脑名称yd811,services   name:yd811,全局数据库名yd811.world  
   
  用安装过Oracle客户端的电脑连接,没有问题。连接名称是yd811  
   
  用安装过Oracle   obdc驱动的电脑连接就有问题,用ado   ,ODAC   5.7.0.28   ,DOA   4.0.7.1   分别连接都有问题(连接方式跟安装过Oracle客户端的方式一样)  
  问题一般都是:没有Listener监听器  
                            找不到对应Services   name  
                            ORA-12514:TNS:listener   does   not   currently   know   of   service   requested   in   connect   descriptor  
   
  我看过论坛上有好多人说用ODAC不用安装客户端酒可以直接连接,不知道你们是怎么连的,我看了DEMO也没有什么特殊的地方。

這個問題自己倒是解決了  
  就是選中net->option,填寫相關信息就可以了  
   
  不過這個net模式好像很多亞,竟然連case   when   語句都會報錯,好像是主要不支持種文字符,有沒有哪位大俠用過?

用ODAC真的不用安装客户端就可以直接连接?如果是,那我得找一个下了,呵呵。

ODAC   在哪下载?  
 

不安装客户端,是不是需要做个安装包?

ODAC中使用net方式就可以直接连接了,不用客户端的,只需要在程序中使用ODAC的控件即可

感谢大侠的力作,终于知道怎么连接了!  
  连接串是:  
   
  用户名/密码@ip地址:端口:DBid  
   
  还要注意:  
  with   OraSession1   do  
    begin  
                AutoCommit:=false;  
                Options.Net:=true;  
                ConnectString:=Format('%s/%s@%s:%d:%s',['test','test','192.168.1.1',1521,'ora9']);  
                LoginPrompt:=false;  
                Open();  
    end;  
   
  谢谢~  
 

楼主也是好人,学习了

不過這個net模式好像很多亞,竟然連case   when   語句都會報錯,好像是主要不支持種文字符,有沒有哪位大俠用過?oracle   的   plsql语法不是这样用的。sql   server这样用,oracle   是用  
  decode函数.   decode('字段名','条件1','值1',...)

posted @ 2009-05-12 16:02 delphi2007 阅读(195) | 评论 (0)编辑 收藏

delphi动态配置odbc Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiDB/html/delphi_20061215190528285.html
我用下面的代码动态配置odbc数据源连接access数据库,  
  编译可以通过,  
    SQLConfigDataSource(  
            0,  
            ODBC_ADD_SYS_DSN,  
            'Microsoft   Access   Driver   (*.mdb)',    
            'DSN=MyAccessDB;DBQ=C:\MyDB\MyDB.MDB;DefaultDir=C:\MyDB;FIL=MS   Access;MaxBufferSize=2048;PageTimeout=5;Description=我的数据库'  
      );  
  end;  
  这段代码我要问的是如何动态指定数据库文件路径,上面的代码是规定在c盘的某个文件夹下的,我要动态的,改怎么写,  
  有谁知道的请给我完整的代码,一定要完整的代码,

我用的修改注册表,与你的不符

建议使用OLE   DB   连接,不要用ODBC

posted @ 2009-05-12 16:02 delphi2007 阅读(163) | 评论 (0)编辑 收藏

三 层 式 架 构 方 案(这个东西谁有现成的,有应用过实际系统的,可以报个价!谢谢) Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiDB/html/delphi_20061215172915286.html
三   层   式   架   构   方   案  
  一、实时连接服务器,数据集中存储服务器上,全部客户端只有连接上服务器才可以调用服务器数据,要保证200人在线顺畅运行。  
  二、实现功能:  
  1、以MSSQL示例数据训Pubs里面的employee数据库为例实现添加、删除、修改、查询功能  
  2、客户端可以管理在线用户,可以查询到用户ID、用户名、计算机IP、计算机名、登录时间及离开时间,可以踢掉某个在线用户  
  3、服务器有固定IP的可以用,没有固定IP的用花生壳解析的也可以使用。  
  三、客户端业务模块用DLL来做,由EXE文件调用模块DLL。  
  ========================================================================  
  这个东西谁有现成的,有应用过实际系统的,可以报个价!谢谢  
 

我这到有一个可以反复调用的三层结构,是进销存管理系统的,只是还没完成,只得登陆和权限管理,你要没?

可不可以远程演示给我看  
   
 

如果可以加我QQ:329092565   手机:13960476705

程序是在我自己的机子上面,我又不在宿舍,只怕现在不能演示给你看了.要不等到我们7:50下课了回去给你演示啊!

你这个有没有实际应用到系统中过  
  能不能讲一下基于什么开发的  
 

delphi-数据库啊,用到是没用到,我根本都还没做完呢.

等一下你联系我  
 

http://vividw.go3.icpcn.com/    
  看下     eco...  
  需要定制开发可以联系我

我写的纸业和鞋业软件跟你的很符合.

QQ:83328047

这个我可以提供,我做的一个项目跟你的要求基本一样.  
   
  就是不能踢用户.  
  但是有数据连接池,   如果需要演示.  
  基类全部用sql脚本提交数据的,  
  QQ:830490  
  getchar#163.com

谢谢大家,请大家QQ联系好,好演示一下

哈哈....我这有

有就联系我,   我不会一直盯在这里,大哥们!

自已顶

哈哈...SORRY,可惜我不卖钱,只送给心诚的朋友.

我倒有个,   socket   三层的,   不过不能踢人,  
   
  用   dbExpress   +   FireBird   做的.   可以给你演示一下

posted @ 2009-05-12 16:02 delphi2007 阅读(157) | 评论 (0)编辑 收藏

这些SQL语句如何写 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiDB/html/delphi_20061215171559287.html
我用的access2000,我建了个表名为:JLGL,表里有个字段:Jan(数字类型)  
  问题1:现在我想获得这个字段的左边4个不重复的数字我是这样写的:  
  select   a.Jan   from   (select   distinct   Left(Jan,4)   from   JLGL)   a     可程序说是错的,请问这个语句怎么写?  
  问题2:我想查询Jan字段等于20068或者等于20069的所以数据,所以我就这样写了个sql语句:select   *   from   JLGL   where   Jan=20068   or   Jan=20069       可程序也说这个是错的,请问该怎么写?  
  问题3:请问如何不通过条件查询而直接获得刚插入表里的数据,谢谢

问题2:select   *   from   JLGL   where   Jan='20068'   or   Jan='20069'没有加引号

1.获得这个字段的左边4个不重复的数字  
  select   jan   from   jlgl   where   left(jan,4)   not   in   (SELECT   Left(jan,4)   AS   jan1   FROM   jlgl   GROUP   BY   Left(jan,4)   HAVING   Count(*)>1)  
  2.应该没错(数字类型不用引号),你可在access中试一下  
  3.好像不能  
 

问题1:  
  你的第一个语句肯定是要报错的啊,  
  select   a.Jan   from   (select   distinct   Left(Jan,4)   as   Jan   from   JLGL)   a    
  这样应该就可以,也就是在Left(Jan,4)后面加上别名。  
  问题2:  
  应该是没有错  
  问题3:  
  好像不可以  
 

问题3,那是不可能的。

不过,如果你的表里有表示序列的字段,就可以的  
  select   *   from   table   order   by   [序列字段]   desc  
  第一条数据就是最新加入的。

问题3sqlserver好像有个物理rowid

在access中select   *   from   JLBZPT   where   JDZQ>0   and   GLZT='ZY'   and   len(SYBM)>0   and   len(JDBM)>0   and   left(YXRQ,6)='"+year+"'   and   JDJG='MJ'该如何写才正确

问题2正确的是:select   *   from   JLGL   where   [Jan]='20068'   or   [Jan]='20069'

问题3:游标应该是指向刚插入的记录吧(前提:插入数据后还没有做任何操作)

posted @ 2009-05-12 16:02 delphi2007 阅读(147) | 评论 (0)编辑 收藏

请问如何判断dbgrideh换了行??? Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiDB/html/delphi_20061215162714288.html
如题,在什么事件里判断?语句怎么写啊?谢谢!

我要问的就是在鼠标点击dbgrideh时如何判断换了行?

dbgrideh连着dataset控件,判断dataset的事件不就可以拉  
 

posted @ 2009-05-12 16:02 delphi2007 阅读(203) | 评论 (0)编辑 收藏

DLL为什么使用完毕后会提示:内存访问错误呢? Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiDB/html/delphi_20061215160532289.html
自己写了个DLL,用delphi调用我自己DELPHI写的DLL,运行结果可以出来,但运行完毕后会提示内存访问错误。我第二次调用的时候就直接提示内存访问错误,无法运行。在程序中我使用了Record集合作为返回记录  
  uses  
      sharemem,  
      。。。。。。  
  var    
      。。。。。。  
    type  
          Tps   =   Record  
                    sno:   integer;  
                    sname:string;  
                    skt:string;  
      End;  
      Tp=array   of   Tps;  
   
  我的函数是  
  function   sel(s:integer,var   PResult:Tp):integer;   export;   stdcall;  
  begin  
      s:=0;  
      ......  
      if   (满足条件)   then  
      begin  
          s:=s+1;  
          setlength(pResult,s);  
          PResult[s-1].sno:=某数据;  
          PResult[s-1].sname:=某数据;  
          PResult[s-1].stk:=某数据;  
      end;  
  end;  
   
  请兄弟们帮忙看看哪里有问题啊!  
 

把string类型换成shortstring

可能是其他代码的原因,用注释的方法或条件编绎逐块排除

我试了一下,就是换成PCHAR也还是不行的了,应该就是这段代码出的问题,因为没加这段代码前都是好好的,加了就有问题,我运行完毕后执行结果是有的,但会报内存错误。我第二次运行的时候居然连运行都不能运行就直接出错了。

1.没有string返回值,就不要用sharemem(sharemem有时会有问题,我也碰到过)  
  2.改string为string[250]   //如果数据长度不超过250的话  
    或改为char[1000];  
    不要改为pchar,因为它要申请内存  
   
 

用low   high函数来访问记录数组

我一般在访问Dll时都用pchar操作,只是多写几个参数罢了,可以避免很多问题的。

Tp=array   of   Tps;  
      PTp   =   ^TP;  
   
  function   sel(s:integer,var   PResult:PTp):integer;   export;   stdcall;  
   
  Tp改用指针

posted @ 2009-05-12 16:02 delphi2007 阅读(167) | 评论 (0)编辑 收藏

Delphi的HTTP事件代码有错,大虾进来看。 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061206215249251.html
Procedure   MASXML(Const   MDataSet,MDataSets:TADODataSet);  
  Var   oReg:IXMLHttpRequest;  
  Begin  
        XMLDocument1.XML.Add('<voucher>   </voucher>');  
        oReg.open('POST',SysInf.cURL,False,varEmpty,varEmpty);  
        oReg.send(XMLDocument1.XML.Text);  
  End;  
   
  一执行到oReg.Open就出现内存错误,请大虾指教。  
   
 

内存错误?    
  晕死   说明白点

虾米来参观。。。。

posted @ 2009-04-22 10:45 delphi2007 阅读(195) | 评论 (0)编辑 收藏

CoXMLHTTP30在哪个单元文件里?oReq := CoXMLHTTP30.Create; 这句为什么老出错? Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061206214636252.html
我有一段代码:  
  procedure       TFrmZhGs.cmdUpLoadClick(Sender:       TObject);        
      var        
                      pXML:       WideString;        
                      strXML:       WideString;        
                      oReq:       IXMLHTTPRequest;        
                      reMsg       :String;        
                      root:       IXMLDOMDocument;        
                      node:       IXMLDOMNode;        
                      iLength:       Integer;        
      begin        
                      strXML       :=       txtXML.Text;        
                      If       strXML       =       ''       Then        
                                      Exit;        
                      addLog('上传数据');        
                      pXML       :=       'xml='           +       strXML;        
                      pXML       :=       URLEncoding(pXML);        
                      try        
                                      oReq       :=       CoXMLHTTP30.Create;        
                                      oReq.Open('POST',       POST_URL       +       'zhgs.asp',       False,varNull,varNull);        
                                      iLength       :=       Length(pXML);        
                                      oReq.setRequestHeader('Content-Length',       IntToStr(iLength));        
                                      oReq.setRequestHeader('CONTENT-TYPE',       'application/x-www-form-urlencoded');        
                                      oReq.send(pXML);        
                             
  end;        
   
   
      oReq       :=       CoXMLHTTP30.Create;   这句老实执行不过去,大虾救救。  
 

自顶。  
 

try        
                                      oReq       :=       CoXMLHTTP30.Create;        
                                      oReq.Open('POST',       POST_URL       +       'zhgs.asp',       False,varNull,varNull);        
                                      iLength       :=       Length(pXML);        
                                      oReq.setRequestHeader('Content-Length',       IntToStr(iLength));        
                                      oReq.setRequestHeader('CONTENT-TYPE',       'application/x-www-form-urlencoded');        
                                      oReq.send(pXML);        
                             
  end;        
   
  ================================  
   
  不是那句执行不过去    
  而是你try了   后面又没跟进异常保护模块   怎么不会出错    
  你这样写    
                      oReq       :=       CoXMLHTTP30.Create;        
                      try          
                                      oReq.Open('POST',       POST_URL       +       'zhgs.asp',       False,varNull,varNull);        
                                      iLength       :=       Length(pXML);        
                                      oReq.setRequestHeader('Content-Length',       IntToStr(iLength));        
                                      oReq.setRequestHeader('CONTENT-TYPE',       'application/x-www-form-urlencoded');        
                                      oReq.send(pXML);    
                      finally  
                                      oReq.free;  
                      end;                      
                             
  end;        
 

posted @ 2009-04-22 10:45 delphi2007 阅读(188) | 评论 (0)编辑 收藏

delphi里function怎么返回多个值呢? Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061206210840253.html
我自己写了一个function,要想同时返回三个double类型的数值,请问怎么实现呢?

用引用做为参数。如:  
   
  function   abc(var   aa,bb,cc:double):double;//共相当于返回4个double值  
  begin  
      aa:=......  
      bb:=......  
      cc:=.....  
      result:=......  
  end;  
  //---------------------------------------------  
  ...以下是调用  
  var  
      aatrue,bbtrue,cctrue,ddtrue:double;  
  begin  
      aatrue:=...  
      bbtrue:=...  
      cctrue:=...  
      ddtrue:=abc(aatrue,bbtrue,cctrue);  
  end;  
  //仓促写的,没有用大小写母,不好看,见谅

我测试的结果:  
   
  function   abc(var   aa,bb,cc:double):double;//共相当于返回4个double值  
  begin  
      aa:=12.6;  
      bb:=88.89;  
      cc:=2345.907;  
      result:=aa+bb+cc;  
  end;  
   
  procedure   TForm1.Button2Click(Sender:   TObject);  
  var  
      aatrue,bbtrue,cctrue,ddtrue:double;  
  begin  
      aatrue:=0.0;  
      bbtrue:=0.0;  
      cctrue:=0.0;  
      ddtrue:=abc(aatrue,bbtrue,cctrue);  
      memo1.Lines.Add('以下是四个变量新值:'+floattostr(aatrue)+','+floattostr(bbtrue)+','+floattostr(cctrue)+','+floattostr(ddtrue));  
  end;  
   
  结果:  
  12.6,88.89,2345.907,2447.397

result返回什么啊?  
  能写具体点吗?那三个返回值我是想分别得到的.

那如果我没有传递参数呢?C_LT_L,C_LA_B,C_HI_H三个参数都是类里的公共变量,现在想用这个函数来获得这三个变量  
  function   THHUCoord.GetParams();  
  begin  
      C_LT_L;  
      C_LA_B;  
      C_HI_H;  
  end;

要么就用var  
  要么就返回一个记录(结构体)

type   IWantData   =   record  
  aa:...;  
  bb:...;  
  cc:...;  
  end;  
   
  function   abc(var   aa,bb,cc:double):IWantData   ;//共相当于返回3个double值  
  var  
      ret:   IWantData;  
  begin  
  ret.aa:=......;  
  ret.bb:=......;  
  ret.cc:=.....;  
  result:=ret;  
  end;

强烈鄙视问题解决后不结贴的人!  
  强烈鄙视技术问题解决后把贴子转移到非技术区的人!  
  鄙视你们!  
   
  http://community.csdn.net/Expert/topic/5216/5216675.xml?temp=.9262659

函数   怎么能   返回多个值呢?  
   
 

To   楼上:  
   
  type  
          TTwo   =   record  
          x   :   String;  
          y   :   String;  
          z   :   String;  
  end;  
   
  Procedure   FunOne(var   a,b,c   :integer);   //传址(引用、别名)  
  begin  
        a   :=   9;   //给三个变量赋值  
        b   :=   8;  
        c   :=   7;  
  end;  
   
  function   FunTwo(InStr   :string)   :TTwo;             //返回记录  
  var   tempRec   :TTwo;  
  begin  
          temp.x   :=   copy(InStr,1,1);  
          temp.y   :=   copy(InStr,2,1);  
          temp.z   :=   copy(InStr,3,1);  
          result   :=   tempRec;  
  end;  
   
  procedure   TForm1.Button1Click(Sender:   TObject);  
  var  
        a,b,c   :   integer;  
        InStr   :   String;  
  begin  
        a   :=   0;//初值  
        b   :=   0;  
        c   :=   0;  
        funOne(a,b,c);  
        //测试经FunOne处理后(相当于“返回”)的a,b,c值变为9,8,7  
        showmessage(inttostr(a)+','+inttostr(b)+','+inttostr(c));  
   
        InStr   :=   'xyz';  
        //测试FunTwo()返回的3个记录成员值   x,y,z  
        showmessage(FunTwo(InStr).x+','+FunTwo(InStr).y+','+FunTwo(InStr).z);  
  end;  
   
  //上面两种方法,如果说第一种用“引用”做参数的方法只是相当于返回多值的话,那第二种,用记录,则是真正返回多值

temp.x       改为     tempRec.x  
  temp.y       改为     tempRec.y  
  temp.z       改为     tempRec.z

var   xxx;   不是已经可以解决了吗?

谢谢。  
  的确实现了,   多个值的改动。  
   
  ------------------  
  不过,   钻牛角的话,   这算不得   “返回多个值”的,  
   
  传地址调用的时候,只能说是,改变了   3   个值,   而只返回了   1   个变量   的  
  返回结构体,也是一个变量的,只是这个变量还是一个结构体  
   
  ??  
  不知道   Dephi     或   别的语言中,   有没有真正   返回多个值   的  
 

这种问题有什么意义吗?

Delphi已经够NB了,函数可以返回任意类型。  
  你试试C++,很多类型必须要明确使用指向类型的指针才能作为函数的返回值。  
 

认同楼上两层所说

最简单的方法,定义几个全局变量,在函数里赋值,在别处引用,当然,弊端不用我说,是很多的,我个人不推荐这么写,但是确实很简单

楼上的,你让别人用你的办法,还是不用你的办法啊?  
   
  :)

函数和过程其实是一样的,都不存在返回值的问题!  
  只是为了方便给一个返回值而已。  
  最后都是指针;  
  还是用VAR吧!

怎么不能结贴啊

还有一个方法真的可以返回一个ARRAY  
   
  function     Mytest(......):OleVariant;  
  begin  
      Result:=VarArrayCreate([0,2],varInteger);  
      Result[0]   :=   0;  
      Result[1]   :=   1;  
      Result[2]   :=   2;  
  end;  
 

或者是定义一个类型  
   
   
  TmyType   =   array   [0..2]   of   integer;  
   
   
  function   myText(...):TmyType;  
  begin  
      Result[0]   :=   1;  
      result[1]   :=   1;  
      result[2]   :=   0;  
  end;

posted @ 2009-04-22 10:45 delphi2007 阅读(812) | 评论 (0)编辑 收藏

新人求助关于类的构造和封装问题 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061206195523254.html
为了练习类的构造和封装,自己写了这样一个小程序,设计三个单元unit   Person,unit   ET,unit   Form,可是在写完Person单元的程序再在ET单元引用Person单元时出现了这样一个错误:找不到Person的DCU文件,于是自己尝试编译了Person单元的文件,又出现了这样一个错误:[Error]   Person.pas(17):   Unsatisfied   forward   or   external   declaration:   'TPerson.Create'。不知道该怎么改,麻烦大家看看,现在贴出Person单元的程序:  
  unit   Person;  
   
  interface  
      uses   classes,dialogs;  
  type  
      TPerson   =class  
      private  
          blood:char;  
      protected  
          DNA:string;  
      public  
          maName:string;  
          high:integer;  
      procedure   setNNA(a:   string);  
      function   getBlood:string;  
      function   getDNA:string;  
      constructor   Create;  
  end;  
  implementation  
      procedure   TPerson.setNNA(a:string);  
        begin  
            DNA:=a;  
        end;  
      function   TPerson.getDNA:string;  
          begin  
              result:=DNA;  
          end;  
      function   TPerson.getBlood:string;  
          begin  
              result:=blood;  
          end;  
  var  
          Color1:TPerson;  
  begin  
      Color1:=TPerson.Create;  
      Color1.DNA:='Color1   的   DNA   =AA913';  
      Color1.blood:='A';  
      ShowMessage('Color1.DNA   ='+Color1.DNA+#13  
                              +'Color1.blood   ='+Color1.blood);  
      Color1.Free;  
  end.  
 

implementation  
   
  constructor   TPerson.Create;  
  begin  
      inherited;  
      //你的代码  
  end;

posted @ 2009-04-22 10:45 delphi2007 阅读(112) | 评论 (0)编辑 收藏

CRC32算法问题 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061206182220256.html
#include   "stdafx.h"  
  #include   "crc.h"  
   
   
  DWORD   CCrc::CrcTable[256];  
  BOOL     CCrc::m_bInitCrc   =   FALSE;  
   
  //-----------------------------------------------------------------------------  
  //   generate   the   table   of   CRC   remainders   for   all   possible   bytes  
  //-----------------------------------------------------------------------------  
  VOID   CCrc::InitCrcTable()  
  {  
  static   bool   bInited   =   false;  
   
  if   (bInited) //   确保只初始化一次  
  return;  
   
  register   int   i,   j;  
  register   unsigned   long   crc_accum;  
  for   (   i   =   0;     i   <   256;     i++   )  
  {    
  crc_accum   =   (   (unsigned   long)   i   <<   24   );  
  for   (   j   =   0;     j   <   8;     j++   )  
  {  
  if(   crc_accum   &   0x80000000L   )    
  crc_accum   =   (   crc_accum   <<   1   )   ^   POLYNOMIAL;  
  else    
  crc_accum   =   (   crc_accum   <<   1   );    
  }  
  CrcTable[i]   =   crc_accum;    
  }  
   
  bInited   =   true;  
  }  
   
   
   
   
  //-----------------------------------------------------------------------------  
  //   calculate   32   crc  
  //-----------------------------------------------------------------------------  
  DWORD   CCrc::Crc(LPCTSTR   lpData)  
  {  
  if(   FALSE   ==   m_bInitCrc   )  
  {  
  InitCrcTable();  
  m_bInitCrc   =   TRUE;  
  }  
  unsigned   int   result;  
   
  //对超过127的字符,   必须用unsigned   char,   否则会出错  
  const   unsigned   char   *data   =   (const   unsigned   char   *)lpData;  
  if(   data[0]   ==   0   )   return   0;  
   
  result     =   *data++   <<   24;  
  if(   *data   )  
  {  
  result   |=   *data++   <<   16;  
  if(   *data   )  
  {  
  result   |=   *data++   <<   8;  
  if(   *data   )   result   |=   *data++;  
  }  
  }  
  result   =   ~   result;  
   
  while(   *data   )  
  {  
  result   =   (result   <<   8   |   *data)   ^   CrcTable[result   >>   24];  
  data++;  
  }  
   
  return   ~result;  
  }  
  ---------------------------  
  这是C++版的CRC32的算法,各位大哥帮忙翻译成DELPHI版的算法,小弟感激不尽

(*//  
  标题:CRC验证单元  
  说明:CRC16和CRC32  
  日期:2005-01-16  
  设计:Zswang  
  支持:wjhu111#21cn.com  
  //*)  
   
  unit   CRCUtils;  
   
  interface  
   
  uses   Windows,   Classes,   SysUtils;  
   
  function   UpdateCRC16(   //更新CRC16的值  
      mChar:   Char;   //字符  
      mSeed:   Word   //Seed  
  ):   Word;   //返回更新后的CRC16值  
   
  function   UpdateCRC32(   //更新CRC32的值  
      mChar:   Char;   //字符  
      mSeed:   DWORD   //Seed  
  ):   DWORD;   //返回更新后的CRC32值  
   
  function   StringCRC16(   //取得字符串的CRC16值  
      mString:   string   //字符串  
  ):   Word;   //返回字符串的CRC16值  
   
  function   StringCRC32(   //取得字符串的CRC32值  
      mString:   string   //字符串  
  ):   DWORD;//返回字符串的CRC32值  
   
  function   FileCRC16(   //取得文件的CRC16值  
      mFileName:   TFileName   //文件名  
  ):   Word;   //返回文件的CRC16值  
   
  function   FileCRC32(   //取得文件的CRC32值  
      mFileName:   TFileName   //文件名  
  ):   DWORD;   //返回文件的CRC32值  
   
  implementation  
   
  const  
      cBufferSize   =   $1000;   //预处理的缓冲大小  
   
  var  
      vCRC16Table:   array[Byte]   of   Word;   //CRC16表  
      vCRC32Table:   array[Byte]   of   DWORD;   //CRC32表  
   
  procedure   MakeCRC16Table;   //生存CRC16表  
  var  
      vCRC:   Word;  
      I,   J:   Byte;  
  begin  
      for   I   :=   0   to   255   do  
      begin  
          vCRC   :=   I;  
          for   J   :=   1   to   8   do  
              if   Odd(vCRC)   then  
                  vCRC   :=   (vCRC   shr   1)   xor   $8408  
              else   vCRC   :=   vCRC   shr   1;  
          vCRC16Table[I]   :=   vCRC;  
      end;  
  end;   {   MakeCRC16Table   }  
   
  procedure   MakeCRC32Table;   //生存CRC32表  
  var  
      vCRC:   DWORD;  
      I,   J:   Byte;  
  begin  
      for   I   :=   0   to   255   do  
      begin  
          vCRC   :=   I;  
          for   J   :=   1   to   8   do  
              if   Odd(vCRC)   then  
                  vCRC   :=   (vCRC   shr   1)   xor   $EDB88320  
              else   vCRC   :=   vCRC   shr   1;  
          vCRC32Table[I]   :=   vCRC;  
      end;  
  end;   {   MakeCRC32Table   }  
   
  function   UpdateCRC16(   //更新CRC16的值  
      mChar:   Char;   //字符  
      mSeed:   Word   //Seed  
  ):   Word;   //返回更新后的CRC16值  
  begin  
      Result   :=  
          vCRC16Table[(mSeed   and   $000000FF)   xor   Byte(mChar)]   xor   (mSeed   shr   8);  
  end;   {   UpdateCRC16   }  
   
  function   UpdateCRC32(   //更新CRC32的值  
      mChar:   Char;   //字符  
      mSeed:   DWORD   //Seed  
  ):   DWORD;   //返回更新后的CRC32值  
  begin  
      Result   :=  
          vCRC32Table[(mSeed   and   $000000FF)   xor   Byte(mChar)]   xor   (mSeed   shr   8);  
  end;   {   UpdateCRC32   }  
   
  function   StringCRC16(   //取得字符串的CRC16值  
      mString:   string   //字符串  
  ):   Word;   //返回字符串的CRC16值  
  var  
      I:   Integer;  
  begin  
      Result   :=   $FFFF;  
      for   I   :=   1   to   Length(mString)   do   Result   :=   UpdateCRC16(mString[I],   Result);  
      Result   :=   not   Result;  
  end;   {   StringCRC16   }  
   
  function   StringCRC32(   //取得字符串的CRC32值  
      mString:   string   //字符串  
  ):   DWORD;//返回字符串的CRC32值  
  var  
      I:   Integer;  
  begin  
      Result   :=   $FFFFFFFF;  
      for   I   :=   1   to   Length(mString)   do   Result   :=   UpdateCRC32(mString[I],   Result);  
      Result   :=   not   Result;  
  end;   {   StringCRC32   }  
   
  function   FileCRC16(   //取得文件的CRC16值  
      mFileName:   TFileName   //文件名  
  ):   Word;   //返回文件的CRC16值  
  var  
      vBuffer:   array[0..cBufferSize   -   1]   of   Char;  
      I,   J:   Integer;  
  begin  
      Result   :=   $FFFF;  
      if   not   FileExists(mFileName)   then   Exit;  
      with   TFileStream.Create(mFileName,   fmOpenRead)   do   try  
          I   :=   Read(vBuffer[0],   SizeOf(vBuffer));  
          while   I   >   0   do  
          begin  
              for   J   :=   0   to   I   -   1   do   Result   :=   UpdateCRC16(vBuffer[J],   Result);  
              I   :=   Read(vBuffer[0],   SizeOf(vBuffer));  
          end;  
          Result   :=   not   Result;  
      finally  
          Free;  
      end;  
  end;   {   FileCRC16   }  
   
  function   FileCRC32(   //取得文件的CRC32值  
      mFileName:   TFileName   //文件名  
  ):   DWORD;   //返回文件的CRC32值  
  var  
      vBuffer:   array[0..cBufferSize   -   1]   of   Char;  
      I,   J:   Integer;  
  begin  
      Result   :=   $FFFFFFFF;  
      if   not   FileExists(mFileName)   then   Exit;  
      with   TFileStream.Create(mFileName,   fmOpenRead)   do   try  
          I   :=   Read(vBuffer[0],   SizeOf(vBuffer));  
          while   I   >   0   do  
          begin  
              for   J   :=   0   to   I   -   1   do   Result   :=   UpdateCRC32(vBuffer[J],   Result);  
              I   :=   Read(vBuffer[0],   SizeOf(vBuffer));  
          end;  
          Result   :=   not   Result;  
      finally  
          Free;  
      end;  
  end;   {   FileCRC32   }  
   
  initialization  
      MakeCRC16Table;  
      MakeCRC32Table;  
   
  finalization  
   
  end.  
   
 

大哥你给出的算法跟我这个C++版的算法算出来的值还是不一样啊!

//照着写一个,测试通过  
   
  unit   Unit2;  
   
  interface  
   
  uses   Windows;  
   
  function   Crc(lpData:   LPCTSTR):   DWORD;  
   
  implementation  
   
  const  
      POLYNOMIAL   =   $EDB88320;   //   注意这个值是否定义一样  
   
  var  
      CrcTable:   array[0..256   -   1]   of   DWORD;  
      m_bInitCrc:   Boolean   =   False;  
   
  procedure   InitCrcTable;  
  {$J+}   //   静态变量  
  const  
      bInited:   Boolean   =   False;  
  {$J-}  
  var  
      I,   J:   Integer;  
      crc_accum:   Longword;  
  begin  
      if   bInited   then   Exit;   //   确保只初始化一次  
      for   I   :=   0   to   256   -   1   do  
      begin  
          crc_accum   :=   I   shl   24;  
          for   J   :=   0   to   8   -   1   do  
          begin  
              if   (crc_accum   and   $80000000)   <>   0   then  
                  crc_accum   :=   (crc_accum   shl   1)   xor   POLYNOMIAL  
              else   crc_accum   :=   crc_accum   shl   1;  
          end;  
          CrcTable[I]   :=   crc_accum;  
      end;  
      bInited   :=   True;  
  end;  
   
  function   Crc(lpData:   LPCTSTR):   DWORD;  
  var  
      Data:   PByte;  
  begin  
      Result   :=   0;  
      if   not   m_bInitCrc   then  
      begin  
          InitCrcTable();  
          m_bInitCrc   :=   True;  
      end;  
   
      Data   :=   PByte(lpData);  
      if   (Data   =   nil)   or   (Data^   =   0)   then   Exit;  
      Result   :=   Data^   shl   24;  
      Inc(Data);  
      if   Data^   <>   0   then  
      begin  
          Result   :=   Result   or   Data^   shl   16;  
          Inc(Data);  
          if   Data^   <>   0   then  
          begin  
              Result   :=   Result   or   Data^   shl   8;  
              Inc(Data);  
              if   Data^   <>   0   then  
              begin  
                  Result   :=   Result   or   Data^;  
                  Inc(Data);  
              end;  
          end;  
      end;  
      Result   :=   not   Result;  
   
      while   Data^   <>   0   do  
      begin  
          Result   :=   (Result   shl   8   or   Data^)   xor   CrcTable[Result   shr   24];  
          Inc(data);  
      end;  
      Result   :=   not   Result;  
  end;  
   
  end.

#define   POLYNOMIAL   0x04C11DB7L //   CRC种子  
  在DELPHI里应该是多少呢?

太感谢zswang(伴水清清)(专家门诊清洁工)   了,已经OK了:)

请教:如何确保各个文件的惟一性?  
  原本打算对各个文件生成MD5校验码来区分,这对小尺寸的文件可以,但对几十M、几百M的文件而言在效率上表现很低下  
  请教:还有什么好的点子解决这种问题,谢过    
  问题贴在这里:  
  http://community.csdn.net/Expert/topic/5213/5213302.xml?temp=.5651361

posted @ 2009-04-22 10:45 delphi2007 阅读(292) | 评论 (0)编辑 收藏

想建一个带分隔条的label 控件; Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061206182116257.html
想建一个带分隔条的label   控件;  
   
  是竖式的分隔条,能不能实现?如何实现?  
   
 

用TBevel控件,复制到你的窗体上看看效果  
   
  object   Label1:   TLabel  
      Left   =   72  
      Top   =   192  
      Width   =   32  
      Height   =   13  
      Caption   =   'Label1'  
  end  
  object   Bevel1:   TBevel  
      Left   =   105  
      Top   =   192  
      Width   =   3  
      Height   =   13  
  end  
  object   Label2:   TLabel  
      Left   =   108  
      Top   =   192  
      Width   =   32  
      Height   =   13  
      Caption   =   'Label2'  
  end  
 

我在复制到unit1.pas   下以后,报错:  
   
  [Error]   Unit1.pas(52):   Declaration   expected   but   'OBJECT'   found  
   
   
   
  我是放在这地方的;  
  unit   Unit1;  
   
  interface  
   
  uses  
      Windows,   Messages,   SysUtils,   Variants,   Classes,   Graphics,   Controls,   Forms,  
      Dialogs,   DB,   ADODB,   Grids,   DBGrids,   ExtCtrls,   DBCtrls,   StdCtrls;  
   
  type  
      TFrmPMLR   =   class(TForm)  
          ADOConnection1:   TADOConnection;  
          ADOTable1:   TADOTable;  
          DataSource1:   TDataSource;  
          DBGrid1:   TDBGrid;  
          DBNavigator1:   TDBNavigator;  
          Label1:   TLabel;  
          Button1:   TButton;  
          Button2:   TButton;  
          procedure   Button1Click(Sender:   TObject);  
          procedure   Button2Click(Sender:   TObject);  
      private  
          {   Private   declarations   }  
      public  
          {   Public   declarations   }  
      end;  
   
  var  
      FrmPMLR:   TFrmPMLR;  
   
  implementation  
   
  {$R   *.dfm}  
   
  procedure   TFrmPMLR.Button1Click(Sender:   TObject);  
  var  
  NewString:   string;  
  begin  
              InputQuery('输入查询条件','查询品名为',   NewString);  
              ADOTable1.Locate('PM',NewString,[LoPartialkey]);  
  end;  
   
  procedure   TFrmPMLR.Button2Click(Sender:   TObject);  
    var  
  NewString:   string;  
  begin  
              InputQuery('输入过滤条件','过滤品名为       ',   NewString);  
              ADOTable1.Filter:='PM   like   '+''''+'%'+NewString+'%'+'''';  
              ADOTable1.Filtered:=true;  
   
  end;  
   
    object     Label1:   TLabel;  
      Left   =   72  
      Top   =   192  
      Width   =   32  
      Height   =   13  
      Caption   =   'Label1'  
  end  
  object   Bevel1:   TBevel  
      Left   =   105  
      Top   =   192  
      Width   =   3  
      Height   =   13  
  end  
  object   Label2:   TLabel  
      Left   =   108  
      Top   =   192  
      Width   =   32  
      Height   =   13  
      Caption   =   'Label2'  
  end  
   
      Left   =   72  
      Top   =   192  
      Width   =   32  
      Height   =   13  
      Caption   =   'Label1'  
  end  
  object   Bevel1:   TBevel  
      Left   =   105  
      Top   =   192  
      Width   =   3  
      Height   =   13  
  end  
  object   Label2:   TLabel  
      Left   =   108  
      Top   =   192  
      Width   =   32  
      Height   =   13  
      Caption   =   'Label2'  
  end  
   
   
   
   
  end.  
   
   
   
   
   
 

强烈鄙视问题解决后不结贴的人!  
  强烈鄙视技术问题解决后把贴子转移到非技术区的人!  
  鄙视你们!  
   
  http://community.csdn.net/Expert/topic/5216/5216675.xml?temp=.9262659

复制到你的窗体上  
  复制到你的窗体上  
  复制到你的窗体上  
  复制到你的窗体上  
   
  -_-!!!!!!  
   
  不是复制到你的单元中

晕倒

我是新手,原来创建对象的代码可以直接往窗体上粘贴呀!  
   
 

posted @ 2009-04-22 10:45 delphi2007 阅读(186) | 评论 (0)编辑 收藏

InputQuery('输入查询条件','查询品名为' Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061206181606258.html
 
  InputQuery('输入查询条件','查询品名为',   NewString);  
   
  运行时,'查询品名为'才显示为:查询品;  
   
  为什么没有显示完呀!  
   
   
   
   
 

我是用加空格的方法解决的:  
  InputQuery('输入查询条件','查询品名为         ',   NewString);

真奇怪!我用lihuasoft同程的方法,就可以了;  
  这是DELPHI中的BUG,   还是别的什么原因?  
 

估计是InputQuery窗体封装的默认字体设置的原因吧。

是有这个问题,一般我都是写得极其简单或者加空格

posted @ 2009-04-22 10:45 delphi2007 阅读(192) | 评论 (0)编辑 收藏

报表的相关问题,急啊! Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061206170144259.html
我用的是QReport做报表。  
   
  我以前做是用QRDBText连数据库显示的,数据再多也会自动一页一页增加下去的。但是现在问题是我没有用数据库,直接就是要把计算出来的多行显示出来,我用QRRichText1去显示,这样最多就显示一页了,不会自动一页一页增加了。  
   
  请问用什么控件可以实现象QRDBText连数据库一样的效果啊?急啊。

不是很熟,看看demo

大家看看啊!急啊!

posted @ 2009-04-22 10:45 delphi2007 阅读(99) | 评论 (0)编辑 收藏

表格图形处理? Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061206163149261.html
请问:我想实现在dbgrid1的第一列加上图标(是男的一种是女的一种)我想根据男/女来判断加的图标;请问这个怎实现呢;我在网上找到一段码.
posted @ 2009-04-22 10:44 delphi2007 阅读(130) | 评论 (0)编辑 收藏

如何写这算法 Delphi / Windows SDK/API
http://www.delphi2007.net/DelphiBase/html/delphi_20061206162055262.html
有这样一个对应关系  
  1-A  
  2-B  
  3-C  
  ...  
  26-Z  
  27-AA  
  28-AB  
  ...  
  想输入数字后,显示对应的字母,代码要如何写?  
   
 

以下是我给你写的一个函数,可以实现你要求的算法(实际上是一个10进制整型转“26进制”字串的函数)  
   
  function   IntTo26(iInt:integer):string;  
  var  
        iTemp,iIndex,I:integer;  
        arr:array[1..2521]   of   char;  
        str:string;  
  begin  
        iTemp:=iInt;  
        str:='';  
        iIndex:=1;  
        repeat  
              arr[iIndex]:=char((iTemp   mod   26)+64);  
              if   (iTemp   mod   26)=0   then   arr[iIndex]:=char(90);  
              inc(iIndex);  
              iTemp:=iTemp   div   26   ;  
        until   iTemp   <   1;  
        for   i:=iIndex-1   downto   1   do  
                str:=str+arr[i];  
        result:=str;  
  end;  
   
  procedure   TForm1.Button1Click(Sender:   TObject);//测试数据  
  begin  
      showmessage('1       -->   '+IntTo26(   1)+#10  
                          +   '2       -->   '+IntTo26(   2)+#10  
                          +   '26     -->   '+IntTo26(26)+#10  
                          +   '27     -->   '+IntTo26(27)+#10  
                          +   '53     -->   '+IntTo26(53)+#10  
                          +   '54     -->   '+IntTo26(54)+#10  
                          +   '78     -->   '+IntTo26(78)+#10  
                          +   '79     -->   '+IntTo26(79)+#10  
                          +   '888   -->   '+IntTo26(888));  
  end;

测试结果为:  
  1       -->   A  
  2       -->   B  
  26     -->   AZ  
  27     -->   AA  
  53     -->   BA  
  54     -->   BB  
  78     -->   CZ  
  79     -->   CA  
  888   -->   AHD  
 

不好意思,上面的算法有点小小的问题,再等一下我改一改。

?

晕。连续回复不能超三次。晕死了。下面是修改后的,请测试:     (上面的作废)  
   
  function   IntTo26(iInt:integer):string;  
  var  
        iTemp,iIndex,I:integer;  
        arr:array[0..2521]   of   char;  
        str:string;  
  begin  
        iTemp:=iInt;  
        str:='';  
        iIndex:=1;  
        repeat  
              arr[iIndex]:=char((iTemp   mod   26)+64);  
              if   iTemp   mod   26   =   0   then  
                    begin  
                    arr[iIndex]:='Z';  
                    arr[iIndex+1]:=char(integer(arr[iIndex+1])-1);  
                    iTemp:=iTemp   -   26;  
                    end;  
              inc(iIndex);  
              iTemp:=iTemp   div   26   ;  
        until   iTemp   <1;  
        for   i:=iIndex-1   downto   1   do  
                str:=str+arr[i];  
        result:=str;  
  end;  
   
  procedure   TForm1.Button1Click(Sender:   TObject);       //     测试  
  begin  
          showmessage     ('1         -->   '+IntTo26(         1)+#10  
                                  +   '2         -->   '+IntTo26(         2)+#10  
                                  +   '26       -->   '+IntTo26(       26)+#10  
                                  +   '27       -->   '+IntTo26(       27)+#10  
                                  +   '52       -->   '+IntTo26(       52)+#10  
                                  +   '53       -->   '+IntTo26(       53)+#10  
                                  +   '54       -->   '+IntTo26(       54)+#10  
                                  +   '78       -->   '+IntTo26(       78)+#10  
                                  +   '79       -->   '+IntTo26(       79)+#10  
                                  +   '676     -->   '+IntTo26(     676)+#10  
                                  +   '17576-->   '+IntTo26(17576));  
  end;  
   
  //测试结果如下:  
  1         -->   A  
  2         -->   B  
  26       -->   Z  
  27       -->   AA  
  52       -->   AZ  
  53       -->   BA  
  54       -->   BB  
  78       -->   BZ  
  79       -->   CA  
  676     -->   YZ  
  17576-->   YYZ

posted @ 2009-04-22 10:44 delphi2007 阅读(105) | 评论 (0)编辑 收藏

仅列出标题
共34页: 1 2 3 4 5 6 7 8 9 Last