dpcon.pas

Delphi通讯源码。可给做通讯的朋友参考。

    if VarType(NullTest)<>varNull then
      if trim(NullTest)='' then
      begin
        labPassword.Enabled:=false;
        edtPassword.Enabled:=false;
      end
      else
      begin
        edtPassword.Text:=item.SubItems[6];
        labPassword.Enabled:=true;
        edtPassword.Enabled:=true;
      end
    else
    begin
      labPassword.Enabled:=false;
      edtPassword.Enabled:=false;
    end;

    NullTest:=recd.Fields['Interval'].value;
    if VarType(NullTest)<>varNull then
      if trim(NullTest)='' then
      begin
        labInterval.Enabled:=false;
        edtInterval.Enabled:=false;
      end
      else
      begin
        if trim(item.SubItems [7])='' then  edtInterval.Text:='0' else edtInterval.Text :=item.SubItems [7];
        labInterval.Enabled:=true;
        edtInterval.Enabled:=true;
      end
    else
    begin
      labInterval.Enabled:=false;
      edtInterval.Enabled:=false;
    end;
    NullTest:=recd.Fields['Reserve'].value;
    if VarType(NullTest)<>varNull then
      if trim(NullTest)='' then
      begin
        labReserve.Enabled:=false;
        edtReserve.Enabled:=false;
      end
      else
      begin
        edtReserve.Text:=item.SubItems[10];
        labReserve.Caption:=NullTest;
        labReserve.Enabled:=true;
        edtReserve.Enabled:=true;
      end
    else
    begin
      labReserve.Enabled:=false;
      edtReserve.Enabled:=false;
    end;
  end;
  if trim(item.SubItems[8])<>'' then cmbencode.ItemIndex:=strtoint(item.SubItems[8]);
  edtDescription.Text:=item.SubItems[9];
  recd.close;
  ADOOBJ.Close;
  recd := Unassigned;
  ADOOBJ:=Unassigned;
end;

procedure Tfrmcfg.TabLogShow(Sender: TObject);
var ADOOBJ,recd:OleVariant;
    lstitem:Tlistitem;
    NullTest:Variant;
begin
  if TabLog.Tag =1 then exit else TabLog.Tag:=1;
  ADOOBJ:=CreateOleObject('ADODB.Connection');
  recd:=CreateOleObject('adodb.recordset');
  ADOOBJ.Open(regval.LogDB );
  recd.open('select * from log order by id desc',adoobj,1);
  while not recd.eof do
  begin
    lstitem:=lstlog.Items.Add ;
    NullTest:=recd.Fields['State'].value;
    if VarType(NullTest)<>varNull then
    begin
      case  NullTest of
      0:lstitem.Caption:='work';
      1:lstitem.Caption:='over';
      2:lstitem.Caption:='retry';
      3:lstitem.Caption:='error';
      end;
      lstitem.ImageIndex:=NullTest+2;
    end;
    NullTest:=recd.Fields['PortID'].value;
    if VarType(NullTest) <>varNull then lstitem.SubItems.Add(NullTest) else lstitem.SubItems.Add('');

    NullTest:=recd.Fields['retry'].value;
    if VarType(NullTest)<>varNull then lstitem.SubItems.Add(NullTest) else lstitem.SubItems.Add('');

    NullTest:=recd.Fields['ReceiveTime'].value;
    if VarType(NullTest)<>varNull then lstitem.SubItems.Add(NullTest) else lstitem.SubItems.Add('');

    NullTest:=recd.Fields['CacheTime'].value;
    if VarType(NullTest)<>varNull then lstitem.SubItems.Add(NullTest) else lstitem.SubItems.Add('');

    NullTest:=recd.Fields['SendTime'].value;
    if VarType(NullTest)<>varNull then lstitem.SubItems.Add(NullTest) else lstitem.SubItems.Add('');

    NullTest:=recd.Fields['data'].value;
    if VarType(NullTest)<>varNull then lstitem.SubItems.Add(NullTest) else lstitem.SubItems.Add('');

    NullTest:=recd.Fields['ID'].value;
    lstitem.SubItems.Add(NullTest);
    recd.movenext;
  end;
  recd.close;
  ADOOBJ.Close;
  recd := Unassigned;
  ADOOBJ:=Unassigned;
end;

procedure Tfrmcfg.btLDelAllClick(Sender: TObject);
var itmp:integer;
begin
 for itmp:=0 to lstlog.Items.Count -1 do
   if Tbutton(Sender).Name='btLDel' then
     (if lstlog.Items[itmp].Selected then lstlog.Items[itmp].Checked :=true)
       else lstlog.Items[itmp].Checked:=true;
end;

procedure Tfrmcfg.btlRefreshClick(Sender: TObject);
var ADOOBJ:OleVariant;
     itmp:integer;
begin
   if TabLog.Tag =1 then TabLog.Tag:=0 else exit;
   ADOOBJ:=CreateOleObject('ADODB.Connection');
   ADOOBJ.Open(regval.LogDB );
   for itmp:=0 to lstlog.Items.Count-1 do if lstlog.Items[itmp].Checked then ADOOBJ.execute('delete from log where id='+lstlog.Items[itmp].SubItems[6]);
   ADOOBJ.Close;
   ADOOBJ:=Unassigned;
   if Tbutton(Sender).Name='BTok' then  exit;
   lstLog.Clear;
   TabLogShow(sender);
end;

procedure Tfrmcfg.TabQueueShow(Sender: TObject);
var ADOOBJ,recd:OleVariant;
    lstitem:Tlistitem;
    NullTest:Variant;
begin
  if TabQueue.Tag =1 then exit else TabQueue.Tag:=1;
  ADOOBJ:=CreateOleObject('ADODB.Connection');
  recd:=CreateOleObject('adodb.recordset');
  ADOOBJ.Open(regval.QueueDB);
  recd.open('select * from data order by id desc',adoobj,1);
  while not recd.eof do
  begin
    lstitem:=lstqueue.Items.Add ;

    NullTest:=recd.Fields['PortID'].value;
    if VarType(NullTest) <>varNull then lstitem.caption:=NullTest else lstitem.caption:='';

    NullTest:=recd.Fields['stamp'].value;
    if VarType(NullTest)<>varNull then lstitem.SubItems.Add(NullTest) else lstitem.SubItems.Add('');

    NullTest:=recd.Fields['retry'].value;
    if VarType(NullTest)<>varNull then lstitem.SubItems.Add(NullTest) else lstitem.SubItems.Add('');

    NullTest:=recd.Fields['State'].value;
    if VarType(NullTest)<>varNull then
    begin
      case  NullTest of
      0:lstitem.SubItems.Add('work');
      1:lstitem.SubItems.Add('over');
      2:lstitem.SubItems.Add('retry');
      3:lstitem.SubItems.Add('error');
      end;
      lstitem.ImageIndex:=NullTest+2;
    end;

     NullTest:=recd.Fields['data'].value;
    if VarType(NullTest)<>varNull then lstitem.SubItems.Add(NullTest) else lstitem.SubItems.Add('');

     NullTest:=recd.Fields['ID'].value;
    lstitem.SubItems.Add(NullTest);
    recd.movenext;
  end;
  recd.close;
  ADOOBJ.Close;
  recd := Unassigned;
  ADOOBJ:=Unassigned;
end;

procedure Tfrmcfg.btQDelClick(Sender: TObject);
var itmp:integer;
begin
 for itmp:=0 to lstQueue.Items.Count -1 do
   if Tbutton(Sender).Name='btQDel' then
    (if lstQueue.Items[itmp].Selected then lstQueue.Items[itmp].Checked :=true)
      else lstQueue.Items[itmp].Checked:=true;
end;

procedure Tfrmcfg.btQRefreshClick(Sender: TObject);
var ADOOBJ:OleVariant;
     itmp:integer;
begin
   if TabQueue.Tag =1 then TabQueue.Tag:=0 else exit;
   ADOOBJ:=CreateOleObject('ADODB.Connection');
   ADOOBJ.Open(regval.QueueDB);
   for itmp:=0 to lstQueue.Items.Count-1 do if lstQueue.Items[itmp].Checked then ADOOBJ.execute('delete from data where id='+lstQueue.Items[itmp].SubItems[4]);
   ADOOBJ.Close;
   ADOOBJ:=Unassigned;
   if Tbutton(Sender).Name='BTok' then  exit;
   lstQueue.Clear;
   TabQueueShow(sender);
end;

procedure Tfrmcfg.btPDelClick(Sender: TObject);
begin
  if lstport.SelCount=0 then exit;
  lstport.Selected.Checked:=true;
  lstport.Selected.MakeVisible(false);
end;

procedure Tfrmcfg.edtPortnameChange(Sender: TObject);
begin
  if lstport.Items.Count=0 then exit;
  if (TControl(sender).Hint='') and (lstport.Selected.SubItems[11]<>'update') then
  begin
     TControl(sender).Hint:='update';
     exit;
  end;
  if TComponent(sender).Tag=1 then lstport.Selected.Caption:=edtportname.Text else lstport.Selected.SubItems[TComponent(sender).Tag]:=Tedit(sender).Text;
  lstport.Selected.SubItems[11]:='update';
end;

procedure Tfrmcfg.btPAddClick(Sender: TObject);
var lstitem:Tlistitem;itmp:integer;
begin
  lstitem:=lstport.Items.Add;
  lstitem.Caption:='port'+inttostr(lstport.Items.Count);
  for itmp:=0 to 11 do lstitem.SubItems.Add('');
  lstport.Selected:=lstitem;
  lstitem.MakeVisible(false);
end;

procedure Tfrmcfg.cmbProtocolChange(Sender: TObject);
begin
  if lstport.Items.Count=0 then exit;
  lstport.Selected.SubItems[11]:='update';
  lstport.Selected.SubItems[0]:=cmbprotocol.Items[cmbprotocol.ItemIndex];
  lstPortSelectItem(Sender,lstport.Selected,true);
end;

procedure Tfrmcfg.cmbEncodeChange(Sender: TObject);
begin
  if lstport.Items.Count=0 then exit;
  lstport.Selected.SubItems[8]:=inttostr(cmbencode.ItemIndex);
  lstport.Selected.SubItems[11]:='update';
end;

procedure Tfrmcfg.btpRefreshClick(Sender: TObject);
var itmp,irun:integer;
    ADOOBJ:OleVariant;
    sSql:string;
    sval:array[0..4] of string;
    snul:array[0..5] of string;
begin
   if TabPortCfg.Tag =1 then TabPortCfg.Tag:=0 else exit;
   ADOOBJ:=CreateOleObject('ADODB.Connection');
   ADOOBJ.Open(regval.ConfigDB);
   with lstport do
   begin
     for itmp:=0 to items.Count-1 do
     begin
       sSql:='';
       if items[itmp].Checked then
         (if trim(items[itmp].SubItems[1])<>'' then sSql:='DELETE from port where id='+items[itmp].SubItems[1]+'')
       else
       begin
         irun:=cmbprotocol.Items.IndexOf(items[itmp].SubItems[0]);
         if irun=-1 then irun:=0;
         sval[0]:=inttostr(cmbprotocol.ItemsEx[irun].ImageIndex);
         if sval[0]='-1' then sval[0]:='0';
         sval[1]:=trim(items[itmp].SubItems[3]);
         if sval[1]='' then sval[1]:='0';
         sval[2]:=trim(items[itmp].SubItems[4]);
         if sval[2]='' then sval[2]:='0';
         sval[3]:=trim(items[itmp].SubItems[7]);
         if sval[3]='' then sval[3]:='0';
         sval[4]:=trim(items[itmp].SubItems[8]);
         if sval[4]='' then sval[4]:='0';

         snul[0]:=trim(Items[itmp].Caption);
         if snul[0]='' then snul[0]:='port'+inttostr(itmp);

         snul[1]:=trim(items[itmp].SubItems[2]);
         if snul[1]='' then snul[1]:=' ';

         snul[2]:=trim(items[itmp].SubItems[5]);
         if snul[2]='' then snul[2]:=' ';

         snul[3]:=trim(items[itmp].SubItems[6]);
         if snul[3]='' then snul[3]:=' ';

         snul[4]:=trim(items[itmp].SubItems[9]);
         if snul[4]='' then snul[4]:=' ';

         snul[5]:=trim(items[itmp].SubItems[10]);
         if snul[5]='' then snul[5]:=' ';


         if trim(items[itmp].SubItems[1])='' then
            sSql:='insert into port (portname,protocol,address,port,timeout,user,password,interval,encode,Description,Reserve) values ('''+snul[0]+''','+sval[0]+','''+snul[1]+''','+sval[1]+','+sval[2]+','''+snul[2]+''','''+snul[3]+''','+sval[3]+','+sval[4]+','''+snul[4]+''','''+snul[5]+''')'
          else
            if  items[itmp].SubItems[11]='update' then
              sSql:='update port set portname='''+snul[0]+''',protocol='+sval[0]+',address='''+snul[1]+''',port='+sval[1]+',timeout='+sval[2]+',user='''+snul[2]+''',password='''+snul[3]+''',interval='+sval[3]+',encode='+sval[4]+',Description='''+snul[4]+''',Reserve='''+snul[5]+''' where id='+items[itmp].SubItems[1];
      end;
      if sSql<>'' then
      ADOOBJ.Execute(sSql);
    end;
    ADOOBJ.Close;
    ADOOBJ:=Unassigned;
    if Tbutton(Sender).Name='BTok' then  exit;
    bindcmb;
    if SelCount=0 then itmp:=0 else itmp:=Selected.Index;
    Clear;
    TabPortCfgShow(sender);
    if items.Count=0 then exit;
    if Items.Count <=itmp then itmp:=0;
    Items[itmp].Selected:=true;
    Items[itmp].MakeVisible(false);
  end;
end;

procedure Tfrmcfg.BindCmb;
var ADOOBJ,recd:OleVariant;
    NullTest:Variant;
    itmp:integer;
    item:TComboExItem;
begin
  ADOOBJ:=CreateOleObject('ADODB.Connection');
  recd:=CreateOleObject('adodb.recordset');
  ADOOBJ.Open(regval.ConfigDB);
  recd.open('select pro.type as type, pot.portname as name,pot.id from port pot,protocol pro where pot.protocol=pro.id',adoobj,1);
  cmbsource.Clear;
  cmbtarget.Clear;
  item:=cmbsource.ItemsEx.Add;
  item.Caption:='None';
  item.ImageIndex:=-1;
  item:=cmbtarget.ItemsEx.Add;
  item.Caption:='None';
  item.ImageIndex:=-1;
  while not recd.eof do  //bind portname to cmbsource、cmbtarget
  begin
    NullTest:=recd.Fields['type'].value;
    if VarType(NullTest)<>varNull then itmp:=NullTest else itmp:=0;
    if itmp=0 then item:=cmbsource.ItemsEx.Add else item:=cmbtarget.ItemsEx.Add;
    NullTest:=recd.Fields['ID'].value;
    if VarType(NullTest)<>varNull then itmp:=NullTest;
    NullTest:=recd.Fields['name'].value;
    if VarType(NullTest)=varNull then NullTest:='port'+inttostr(itmp);
    item.Caption:=NullTest;
    item.ImageIndex:=itmp;
    recd.movenext;
  end;
    recd.close;
    ADOOBJ.Close;
    recd:=Unassigned;
    ADOOBJ:=Unassigned;
end;
Procedure Tfrmcfg.WinFocus(var msg:Tmessage);
begin
  if GetFocus<>handle then BringWindowToTop(handle);
end;
{
Procedure Tfrmcfg.DataChange(var msg:Tmessage);
begin
  btQRefreshClick(btQRefresh);
  btlRefreshClick(btlRefresh);
end;
}

end.