u_web_dict.pas

以前写的一个利用P2P 技术的一个通讯的例子。里面用到了 DBISAM 、INDY 控件。

unit U_WEB_DICT;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   ExtCtrls, StdCtrls, Grids, AdvGrid, TFlatEditUnit, TFlatButtonUnit,
   BaseGrid;

type
   TF_WEB_DICT = class(TForm)
      PN_VIP: TPanel;
      PN_BN: TPanel;
      LB_NO: TLabel;
      LB_NAME: TLabel;
      SG_JL: TAdvStringGrid;
      LB_NAMEE: TLabel;
      BN_QD: TFlatButton;
      BN_CON: TFlatButton;
      BN_ADD: TFlatButton;
      BN_PRN: TFlatButton;
      BN_DEL: TFlatButton;
      BN_QX: TFlatButton;
      ED_DEPNO: TFlatEdit;
      ED_NAME: TFlatEdit;
      ED_NAMEE: TFlatEdit;
      function savetodb(sender: TObject): boolean;
      procedure BN_QDClick(Sender: TObject);
      procedure BN_QXClick(Sender: TObject);
      procedure FormClose(Sender: TObject; var Action: TCloseAction);
      procedure FormCreate(Sender: TObject);
      procedure FormKeyDown(Sender: TObject; var Key: Word;
         Shift: TShiftState);
      procedure SG_JLDblClick(Sender: TObject);
      procedure BN_DELClick(Sender: TObject);
      procedure ED_DEPNOKeyPress(Sender: TObject; var Key: Char);
      procedure ED_DEPNOExit(Sender: TObject);
      procedure BN_CONClick(Sender: TObject);
      procedure FormActivate(Sender: TObject);
      procedure BN_ADDClick(Sender: TObject);
      procedure SG_JLGetCellColor(Sender: TObject; ARow, ACol: Integer;
         AState: TGridDrawState; ABrush: TBrush; AFont: TFont);
      procedure BN_PRNClick(Sender: TObject);
      procedure ED_NAMEEExit(Sender: TObject);
      procedure ED_NAMEExit(Sender: TObject);
      procedure SG_JLCanSort(Sender: TObject; ACol: Integer;
         var DoSort: Boolean);
      procedure SG_JLClickSort(Sender: TObject; ACol: Integer);
   private
      { Private declarations }
   public
      { Public declarations }
   end;

var
   F_WEB_DICT: TF_WEB_DICT;

implementation
uses Pub_program, U_WEB_DM, U_WEB_LOCATE, U_WEB_GRIDPRN;
var
   updrow, arow, m_diff: integer;

   {$R *.DFM}

function TF_WEB_DICT.savetodb(sender: TObject): boolean;
var
   i: integer;
   s: string;
begin
   try //此过程只将所有STRING-GRID 中的数据存入数据库。
      f_web_dm.webdb.Connected := true;
      f_web_dm.webdb.StartTransaction;

      with sg_jl do
         for i := 1 to rowcount - 1 do
            begin
               s := cells[colcount, i];
               if (s = 'normal') or (s = '') then
                  continue;
               with f_web_dm.qy_wangy do
                  begin
                     close;
                     sql.Clear;
                     if s = 'add' then
                        begin
                           sql.Add('insert into dictdb(flag,code,name,namee) values(:vflag,:vcode,:vname,:vnamee)');
                           parambyname('vcode').asstring := cells[0, i];
                           parambyname('vname').asstring := cells[1, i];
                           parambyname('vnamee').asstring := cells[2, i];
                        end
                     else
                        if s = 'modify' then
                        begin
                           sql.Add('update dictdb set name=:vname,namee=:vnamee,code=:vcode where flag=:vflag and code=:vcode_o');
                           parambyname('vcode_o').asstring := getstr(cells[colcount + 1, i], cells[0, i]);
                           parambyname('vcode').asstring := cells[0, i];
                           parambyname('vname').asstring := cells[1, i];
                           parambyname('vnamee').asstring := cells[2, i];
                        end
                     else
                        begin
                           sql.Add('delete dictdb where flag=:vflag and code=:vcode_o');
                           parambyname('vcode_o').asstring := getstr(cells[colcount + 1, i], cells[0, i]);
                        end;
                     parambyname('vflag').asinteger := m_diff;
                     prepare;
                     execsql;
                     close;
                  end;
            end;
      f_web_dm.webdb.Commit;
      result := true;
      if sender = BN_QD then
         MessageDlg(succ_msg, mtinformation, [mbok], 0);
   except
      f_web_dm.webdb.Rollback;
      MessageDlg(err_msg, mtWarning, [mbok], 0);
      result := false;
   end;

end;

procedure TF_WEB_DICT.BN_QDClick(Sender: TObject);
begin
   if (sender = bn_qd) and check_pn(pn_vip) then
      ed_nameeexit(bn_qd);
   if savetodb(bn_qd) then
      after_save_wy(sg_jl, true, sg_jl.colcount, sg_jl.colcount - 1);
   bn_del.Enabled := false;
end;

procedure TF_WEB_DICT.BN_QXClick(Sender: TObject);
begin
   if not noedit_sg(sg_jl, sg_jl.colcount) then
      if MessageDlg(asksave_msg, mtConfirmation, [mbyes, mbno], 0) = mrno then
         exit;
   close;
end;

procedure TF_WEB_DICT.FormClose(Sender: TObject;
   var Action: TCloseAction);
begin
   action := cafree;
end;

procedure TF_WEB_DICT.FormCreate(Sender: TObject);
var
   s: string;
begin
   clearall(sender);
   updrow := -1;
   m_diff := g_diff;
   case m_diff of
      0:
         begin
            caption := iif(m_lang = 1, '国籍区域设置', 'NATION SETTING');
         end;
      1:
         begin
            caption := iif(m_lang = 1, '事务性质设置', 'CASE TYPE SETTING');
         end;
      2:
         begin
            caption := iif(m_lang = 1, '重要程度设置', 'IMPORTANT SETTING');
         end;
      3:
         begin
            caption := iif(m_lang = 1, '紧急程度设置', 'URGENT SETTING');
         end;
      10:
         begin
            caption := iif(m_lang = 1, '飞机航班设置', 'FLIGHT SETTING');
            ed_depno.MaxLength := 12;
            lb_no.Caption := iif(m_lang = 1, '航班号', 'FLIGHT NO');
            lb_namee.Caption := iif(m_lang = 1, '航班时刻', 'TIME');
            case m_lang of
               1: s := '航 班 号*16*航班名称*40*航班时刻*12*数据状态*16*';
               2: s := 'FLIGHT NO*16*NAME*40*TIME*12*DATA STAT*16*';
            end;
         end;
      12:
         begin
            caption := iif(m_lang = 1, '维修级别设置', 'MAINTAIN LEVEL SETTING');
            ed_depno.MaxLength := 1;
         end;
      13:
         begin
            caption := iif(m_lang = 1, '维修项目设置', 'MAINTAIN ITEM SETTING');
            ed_depno.MaxLength := 3;
         end;
      14:
         begin
            caption := iif(m_lang = 1, '协议类别设置', 'MAINTAIN ITEM SETTING');
            ed_depno.MaxLength := 3;
         end;
      15:
         begin
            caption := iif(m_lang = 1, '消费大类设置', 'COST TYPE SETTING');
            ed_depno.MaxLength := 3;
         end;
      16:
         begin
            caption := iif(m_lang = 1, '会议室摆台方式设置', 'MEETING LAYOUT SETTING');
            ed_depno.MaxLength := 3;
         end;
      17:
         begin
            caption := iif(m_lang = 1, '折扣类型大类设置', 'DISC TYPE SETTING');
            ed_depno.MaxLength := 3;
         end;
      18:
         begin
            caption := iif(m_lang = 1, '客房大类设置', 'ROOM TYPE SETTING');
            ed_depno.MaxLength := 3;
         end;
      19:
         begin
            caption := iif(m_lang = 1, '维修类别设置', 'MAINTAIN TYPE SETTING');
            ed_depno.MaxLength := 3;
         end;
      20:
         begin
            caption := iif(m_lang = 1, '维修人员设置', 'MAINTAIN TYPE SETTING');
            ed_depno.MaxLength := 4;
         end;
      21:
         begin
            caption := iif(m_lang = 1, '酒店名称设置', 'HOTEL NAME SETTING');
            ed_depno.MaxLength := 4;
            bn_del.Enabled := false;
         end;
      22:
         begin
            caption := iif(m_lang = 1, '预订取消原因设置', 'HOTEL NAME SETTING');
            ed_depno.MaxLength := 4;
            bn_del.Enabled := false;
         end;
      23:
         begin
            caption := iif(m_lang = 1, '维修回复内容设置', 'MNTN REPLY SETTING');
            ed_depno.MaxLength := 3;
            bn_del.Enabled := false;
         end;
      24:
         begin
            caption := iif(m_lang = 1, '电脑报房回复原因设置', 'MNTN REPLY SETTING');
            ed_depno.MaxLength := 3;
            bn_del.Enabled := false;