u_web_locate.pas

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

unit U_WEB_LOCATE;

interface

uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   StdCtrls, Buttons, ExtCtrls, TFlatButtonUnit, TFlatComboBoxUnit,
   TFlatEditUnit;

type
   TF_WEB_LOCATE = class(TForm)
      GroupBox1: TGroupBox;
      Label1: TLabel;
      Label3: TLabel;
      Label4: TLabel;
      GB_DESC: TGroupBox;
      MM_DESC: TMemo;
      RG_CXFS: TRadioGroup;
      Panel2: TPanel;
      BN_AND: TFlatButton;
      BN_OR: TFlatButton;
      BN_RESET: TFlatButton;
      BN_FH: TFlatButton;
      BN_QD: TFlatButton;
      CB_COMP: TFlatEdit;
      ED_CONT: TFlatEdit;
      CB_ITEM: TFlatComboBox;
      FlatButton1: TFlatButton;
      Bevel1: TBevel;
      procedure DealTag(Sender: Tobject; UpDown: integer; Tag: integer);
      procedure FormCreate(Sender: TObject);
      procedure FormClose(Sender: TObject; var Action: TCloseAction);
      procedure FormKeyDown(Sender: TObject; var Key: Word;
         Shift: TShiftState);
      procedure BN_QDClick(Sender: TObject);
      procedure BN_FHClick(Sender: TObject);
      procedure RG_CXFSClick(Sender: TObject);
      procedure BN_ANDClick(Sender: TObject);
      procedure BN_ORClick(Sender: TObject);
      procedure CB_COMPEnter(Sender: TObject);
      procedure BN_RESETClick(Sender: TObject);
      procedure CB_ITEMExit(Sender: TObject);
   private
      { Private declarations }
   public
      { Public declarations }
   end;

var
   F_WEB_LOCATE: TF_WEB_LOCATE;

implementation
uses Pub_program, ncp;
var
   m_cou: integer;
   m_str, m_search: string;

   {$R *.DFM}

procedure TF_WEB_LOCATE.FormCreate(Sender: TObject);
var
   i, j: integer;
   s: string;
begin
   m_search := '';
   j := -1;
   m_str := tran_str;
   clearall(sender);
   tncp.create(self);
   //ed_cont.Text := '';
   rg_cxfs.ItemIndex := 0;
   m_cou := strtoint(analy_str('item_count', m_str));
   mm_desc.Clear;
   with cb_item.Items do
      begin
         clear;
         for i := 0 to m_cou do
            begin
               s := trim(analy_str('col' + inttostr(i), m_str));
               add(inttostr(i) + ' - ' + s);
               if j = -1 then
                  begin
                     s := getstr(s, '', true);
                     if (pos('名称', s) > 0) or (pos('NAME', s) > 0) or (pos('姓名', s) > 0) or (pos('人', s) > 0) then
                        j := i;
                  end;
            end;
      end;
   cb_item.ItemIndex := iif(j > -1, j, 0);
end;

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

procedure TF_WEB_LOCATE.FormKeyDown(Sender: TObject; var Key: Word;
   Shift: TShiftState);
begin
   case Key of
      VK_RETURN: Perform(WM_NEXTDLGCTL, 0, 0);
      VK_Escape: close;
      VK_UP:
         if not (ActiveControl.ClassType = TFlatComboBox) then
            Perform(WM_NEXTDLGCTL, 1, 0);
      VK_DOWN:
         if not (ActiveControl.ClassType = TFlatComboBox) then
            Perform(WM_NEXTDLGCTL, 0, 0);
      VK_SPACE:
         if (ActiveControl.ClassType = TFlatComboBox) then
            (ActiveControl as TFlatComboBox).droppeddown := true
         else
            if (ActiveControl.Tag > 0) then
            DealTag(sender, 1, ActiveControl.Tag);
      VK_F2:
         bn_qdclick(bn_qd);
      VK_F3:
         if bn_and.Enabled then
            bn_andclick(bn_and);
      VK_F4:
         if bn_or.Enabled then
            bn_orclick(bn_or);
      VK_F5:
         if bn_reset.Enabled then
            bn_resetclick(bn_reset);
   end;
end;

procedure TF_WEB_LOCATE.DealTag(Sender: Tobject; UpDown: integer; Tag: integer);
var
   s: string;
begin
   case Tag of
      4:
         begin
            s := getpartstr(cb_comp.text, '-', '=');
            if (s = '=') then
               cb_comp.Text := iif(m_lang = 1, '# - 包含', '# - INCLUDE')
            else
               cb_comp.Text := iif(m_lang = 1, '= - 等于', '= - EQUAL');
         end;
      20:
         if ActiveControl is TFlatComboBox then
            TFlatComboBox(ActiveControl).DroppedDown := true;
   end;
end;

procedure TF_WEB_LOCATE.BN_QDClick(Sender: TObject);
begin
   if mm_desc.Text = '' then
      bn_andclick(sender);
   g_bsel := true;
   tran_str := m_search;
   close;
end;

procedure TF_WEB_LOCATE.BN_FHClick(Sender: TObject);
begin
   g_bsel := false;
   tran_str := '';
   close;
end;

procedure TF_WEB_LOCATE.RG_CXFSClick(Sender: TObject);
begin
   case rg_cxfs.ItemIndex of
      0:
         begin
            bn_and.Enabled := false;
            bn_or.Enabled := false;
            bn_reset.Enabled := false;
            gb_desc.Enabled := false;
            mm_desc.color := $00E9ECED;
            mm_desc.text := '';
            cb_item.ItemIndex := 0;
            cb_comp.text := iif(m_lang = 1, '= - 等于', '= - EQUAL');
            //ed_cont.SetFocus;
         end;
      1:
         begin
            bn_and.Enabled := true;
            bn_or.Enabled := true;
            bn_reset.Enabled := true;
            gb_desc.Enabled := true;
            mm_desc.color := clwhite;
         end;
   end;
end;

procedure TF_WEB_LOCATE.BN_ANDClick(Sender: TObject);
var
   s, s1: string;
   i: integer;
begin
   if trim(cb_item.Text) = '' then
      begin
         MessageDlg(label1.caption + null_msg, mtinformation, [mbok], 0);
         cb_item.SetFocus;
         abort;
      end;
   if trim(cb_comp.Text) = '' then
      begin
         MessageDlg(label3.caption + null_msg, mtinformation, [mbok], 0);
         cb_comp.SetFocus;
         abort;
      end;
   s1 := getstr(ed_cont.Text, '', true);
   if s1 = '' then
      begin
         MessageDlg(label4.caption + null_msg, mtinformation, [mbok], 0);
         ed_cont.SetFocus;
         abort;
      end;
   s := getpartstr(cb_item.Text, '-', '', false, true);
   if (pos('时间', s) > 0) or (pos('日期', s) > 0) or (pos('DATE', s) > 0) or (pos('TIME', s) > 0) then
      begin
         if not verifydate(ed_cont) then
            begin
               ed_cont.SetFocus;
               abort;
            end;
         cb_comp.text := '# - include';
      end
   else
      if (pos('名称', s) > 0) or (pos('姓名', s) > 0) or (pos('NAME', s) > 0) or (pos('人', s) > 0) then
      begin
         if getpartstr(cb_comp.text, '-', '=') = '=' then
            cb_comp.Text := '^ - only first'
         else
            cb_comp.text := '# - include';
      end
   else
      begin
         i := 1;
         while i <= Length(s1) do
            if (s1[i] >= #160) and (s1[i + 1] >= #160) then //因为有汉字，所以肯定包含;
               begin
                  if getpartstr(cb_comp.text, '-', '=') = '=' then
                     cb_comp.Text := '^ - only first'
                  else
                     cb_comp.text := '# - include';
                  break;
               end
            else
               Inc(i, 2);
      end;
   ed_cont.Text := uppercase_wy(ed_cont.Text);
   s := '( ' + getpartstr(cb_item.Text, '-', '', false) + ' ' + getpartstr(cb_comp.Text, '-', '') + ' ' + ed_cont.text + ')';
   if mm_desc.text = '' then
      begin
         mm_desc.Text := s;
         m_search := m_search + '(logic:fir*col:' + getpartstr(cb_item.Text) + '*comp:' + getpartstr(cb_comp.Text) + '*cont:' + ed_cont.Text + '*)*';
      end
   else
      if pos(s, mm_desc.text) = 0 then
      begin
         mm_desc.Text := mm_desc.Text + iif(m_lang = 1, ' 并且 ', ' AND ') + s;
         m_search := m_search + '(logic:and*col:' + getpartstr(cb_item.Text) + '*comp:' + getpartstr(cb_comp.Text) + '*cont:' + ed_cont.Text + '*)*';
      end;
   cb_comp.text := iif(m_lang = 1, '= - 等于', '= - EQUAL');
   ed_cont.text := '';
   cb_item.setfocus;
end;

procedure TF_WEB_LOCATE.BN_ORClick(Sender: TObject);
var
   s: string;
begin
   if trim(cb_item.Text) = '' then
      begin
         MessageDlg(label1.caption + null_msg, mtinformation, [mbok], 0);
         cb_item.SetFocus;
         abort;
      end;
   if trim(cb_comp.Text) = '' then
      begin
         MessageDlg(label3.caption + null_msg, mtinformation, [mbok], 0);
         cb_comp.SetFocus;
         abort;
      end;
   s := '( ' + getpartstr(cb_item.Text, '-', '', false) + ' ' + getpartstr(cb_comp.Text, '-', '', false) + ' ' + ed_cont.text + ')';
   if mm_desc.text = '' then
      begin
         mm_desc.Text := s;
         m_search := m_search + '(logic:fir*col:' + getpartstr(cb_item.Text) + '*comp:' + getpartstr(cb_comp.Text) + '*cont:' + ed_cont.Text + '*)*';
      end
   else
      if pos(s, mm_desc.text) = 0 then
      begin
         mm_desc.Text := mm_desc.Text + iif(m_lang = 1, ' 或者 ', ' OR ') + s;
         m_search := m_search + '(logic:or*col:' + getpartstr(cb_item.Text) + '*comp:' + getpartstr(cb_comp.Text) + '*cont:' + ed_cont.Text + '*)*';
      end;
   cb_comp.text := iif(m_lang = 1, '= - 等于', '= - EQUAL');
   ed_cont.text := '';
   cb_item.setfocus;
end;

procedure TF_WEB_LOCATE.CB_COMPEnter(Sender: TObject);
begin
   if trim(cb_comp.text) = '' then
      cb_comp.text := iif(m_lang = 1, '= - 等于', '= - EQUAL');
end;

procedure TF_WEB_LOCATE.BN_RESETClick(Sender: TObject);
begin
   mm_desc.text := '';
   m_search := '';
   cb_item.itemindex := 0;
   cb_comp.text := iif(m_lang = 1, '= - 等于', '= - EQUAL');
   ed_cont.text := '';
   cb_item.setfocus;
end;

procedure TF_WEB_LOCATE.CB_ITEMExit(Sender: TObject);
begin
   if not analy_com_wy(sender) then
      begin
         (sender as TFlatComboBox).droppeddown := true;
         exit;
      end;
end;

end.