DelphiPCap实例(200)

谁有DelphiPCap实例，高分送上！

//cap_ip单元unit cap_ip;interfaceuses Windows, Messages,Classes,winsock,sysutils;const WM_CapIp = WM_USER + 200; STATUS_FAILED =$FFFF; //定义异常出错代码 MAX_PACK_LEN =65535; //接收的最大IP报文 MAX_ADDR_LEN =16; //点分十进制地址的最大长度 MAX_PROTO_TEXT_LEN =16; //子协议名称(如"TCP")最大长度 MAX_PROTO_NUM =12; //子协议数量 MAX_HOSTNAME_LAN =255; //最大主机名长度 CMD_PARAM_HELP =true; IOC_IN =$80000000; IOC_VENDOR =$18000000; IOC_out =$40000000; SIO_RCVALL =IOC_IN or IOC_VENDOR or 1;// or IOC_out; SIO_RCVALL_MCAST =IOC_IN or IOC_VENDOR or 2; SIO_RCVALL_IGMPMCAST =IOC_IN or IOC_VENDOR or 3; SIO_KEEPALIVE_VALS =IOC_IN or IOC_VENDOR or 4; SIO_ABSORB_RTRALERT =IOC_IN or IOC_VENDOR or 5; SIO_UCAST_IF =IOC_IN or IOC_VENDOR or 6; SIO_LIMIT_BROADCASTS =IOC_IN or IOC_VENDOR or 7; SIO_INDEX_BIND =IOC_IN or IOC_VENDOR or 8; SIO_INDEX_MCASTIF =IOC_IN or IOC_VENDOR or 9; SIO_INDEX_ADD_MCAST =IOC_IN or IOC_VENDOR or 10; SIO_INDEX_DEL_MCAST =IOC_IN or IOC_VENDOR or 11; type tcp_keepalive=record onoff:Longword; keepalivetime:Longword; keepaliveinterval:Longword; end;// New WSAIoctl Options//IP头 type _iphdr=record h_lenver :byte; //4位首部长度+4位IP版本号 tos :char; //8位服务类型TOS total_len :char; //16位总长度（字节） ident :word; //16位标识 frag_and_flags :word; //3位标志位 ttl :byte; //8位生存时间 TTL proto :byte; //8位协议 (TCP, UDP 或其他) checksum :word; //16位IP首部校验和 sourceIP :Longword; //32位源IP地址 destIP :Longword; //32位目的IP地址 end; IP_HEADER=_iphdr; type _tcphdr=record //定义TCP首部 TCP_Sport :word; //16位源端口 TCP_Dport :word; //16位目的端口 th_seq :longword; //32位序列号 th_ack :longword; //32位确认号 th_lenres :byte; //4位首部长度/6位保留字 th_flag :char; //6位标志位 th_win :word; //16位窗口大小 th_sum :word; //16位校验和 th_urp :word; //16位紧急数据偏移量 end; TCP_HEADER=_tcphdr; type _udphdr=record //定义UDP首部 uh_sport :word; //16位源端口 uh_dport :word; //16位目的端口 uh_len :word; //16位长度 uh_sum :word; //16位校验和 end; UDP_HEADER=_udphdr; type _icmphdr=record //定义ICMP首部 i_type :byte; //8位类型 i_code :byte; //8位代码 i_cksum :word; //16位校验和 i_id :word; //识别号（一般用进程号作为识别号）// i_seq :word; //报文序列号 timestamp :word; //时间戳 end; ICMP_HEADER=_icmphdr; type _protomap=record //定义子协议映射表 ProtoNum :integer; ProtoText :array[0..MAX_PROTO_TEXT_LEN] of char; end; TPROTOMAP=_protomap;type ESocketException = class(Exception); TWSAStartup = function (wVersionRequired: word; var WSData: TWSAData): Integer; stdcall; TOpenSocket = function (af, Struct, protocol: Integer): TSocket; stdcall; TInet_addr = function (cp: PChar): u_long; stdcall; Thtons = function (hostshort: u_short): u_short; stdcall; TConnect = function (s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall; TWSAIoctl = function (s: TSocket; cmd: DWORD;lpInBuffer: PCHAR; dwInBufferLenWORD;lpOutBuffer: PCHAR; dwOutBufferLen: DWORD; lpdwOutBytesReturned: LPDWORD;lpOverLapped: POINTER; lpOverLappedRoutine: POINTER): Integer; stdcall; TCloseSocket = function (s: TSocket): Integer; stdcall; Tsend = function( s:TSOCKET; bufchar;Len:integer;flags:integer):Integer;stdcall; Trecv = function( s:TSOCKET; var buf;Len:integer;flags:integer):Integer;stdcall; TWSAAsyncSelect =function (s: TSocket; HWindow: HWND; wMsg: u_int; lEvent: Longint): Integer; stdcall; TWSACleanup =function():integer;stdcall; TOnCap = procedure(ip,proto,sourceIP,destIP,SourcePort,DestPort: string; headerchar;header_size:integer;datachar;data_size:integer) of object; TOnError = procedure(Error : string) of object; Tcap_ip = class(TComponent) private Fhand_dll :HModule; // Handle for mpr.dll FWindowHandle : HWND; FOnCap :TOnCap; //捕捉数据的事件 FOnError :TOnError; //发生错误的事件 Fsocket :array of Tsocket; FActiveIP :array of string;//存放可用的IP FWSAStartup : TWSAStartup; FOpenSocket : TOpenSocket; FInet_addr : TInet_addr; Fhtons : Thtons; FConnect : TConnect; FCloseSocket : TCloseSocket; Fsend :Tsend; FWSAIoctl :TWSAIoctl; Frecv :Trecv; FWSACleanup :TWSACleanup; FWSAAsyncSelect :TWSAAsyncSelect; protected procedure WndProc(var MsgRec: TMessage); function DecodeIpPack(ip:string;bufchar;iBufSize:integer):integer; //IP解包函数// function DecodeTcpPack(TcpBufchar;iBufSize:integer):integer; //TCP解包函数 //function DecodeUdpPack(pchar;i:integer):integer; //UDP解包函数 //function DecodeIcmpPack(pchar;i:integer):integer; //ICMP解包函数 function CheckProtocol(iProtocol:integer):string; //协议检查 procedure cap_ip(socket_no:integer); procedure get_ActiveIP; //得当前的IP列表 procedure set_socket_state; //设置网卡状态 function CheckSockError(iErrorCode:integer):boolean; //出错处理函数 public Fpause :boolean;//暂停 Finitsocket :boolean;//是否已初始化 constructor Create(Owner : TComponent); override; destructor Destroy; override; function init_socket:boolean;//初始化 procedure StartCap;//开始捕捉 procedure pause; //暂停 procedure StopCap;//结束捕捉 property Handle : HWND read FWindowHandle; published property OnCap : TOnCap read FOnCap write FOnCap; property OnError : TOnError read FOnError write FOnError; end;procedure Register;implementationfunction XSocketWindowProc(ahWnd : HWND;auMsg : Integer;awParam : WPARAM; alParam : LPARAM): Integer; stdcall;var Obj : Tcap_ip; MsgRec : TMessage;begin { At window creation ask windows to store a pointer to our object } Obj := Tcap_ip(GetWindowLong(ahWnd, 0)); { If the pointer is not assigned, just call the default procedure } if not Assigned(Obj) then Result := DefWindowProc(ahWnd, auMsg, awParam, alParam) else begin { Delphi use a TMessage type to pass paramter to his own kind of } { windows procedure. So we are doing the same... } MsgRec.Msg := auMsg; MsgRec.wParam := awParam; MsgRec.lParam := alParam; Obj.WndProc(MsgRec); Result := MsgRec.Result; end;end;var XSocketWindowClass: TWndClass = ( style : 0; lpfnWndProc : @XSocketWindowProc; cbClsExtra : 0; cbWndExtra : SizeOf(Pointer); hInstance : 0; hIcon : 0; hCursor : 0; hbrBackground : 0; lpszMenuName : nil; lpszClassName : 'TCap_ip');function XSocketAllocateHWnd(Obj : TObject): HWND;var TempClass : TWndClass; ClassRegistered : Boolean;begin { Check if the window class is already registered } XSocketWindowClass.hInstance := HInstance; ClassRegistered := GetClassInfo(HInstance, XSocketWindowClass.lpszClassName, TempClass); if not ClassRegistered then begin { Not yet registered, do it right now } Result := Windows.RegisterClass(XSocketWindowClass); if Result = 0 then Exit; end; { Now create a new window } Result := CreateWindowEx(WS_EX_TOOLWINDOW, XSocketWindowClass.lpszClassName, '', { Window name } WS_POPUP, { Window Style } 0, 0, { X, Y } 0, 0, { Width, Height } 0, { hWndParent } 0, { hMenu } HInstance, { hInstance } nil); { CreateParam } { if successfull, the ask windows to store the object reference } { into the reserved byte (see RegisterClass) } if (Result <> 0) and Assigned(Obj) then SetWindowLong(Result, 0, Integer(Obj));end;{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}{ Free the window handle }procedure XSocketDeallocateHWnd(Wnd: HWND);begin DestroyWindow(Wnd);end;//当前机的所有IP地址procedure Tcap_ip.get_ActiveIP;type TaPInAddr = Array[0..20] of PInAddr; PaPInAddr = ^TaPInAddr;var phe: PHostEnt; pptr: PaPInAddr; Buffer: Array[0..63] of Char; I: Integer;begin setlength(FActiveIP,20); GetHostName(Buffer, SizeOf(Buffer)); phe := GetHostByName(buffer); if phe = nil then begin setlength(FActiveIP,0); if Assigned(FOnError) then FOnError('没有找到可绑定的IP!'); exit; end; pPtr := PaPInAddr(phe^.h_addr_list); I := 0; while (pPtr^ <> nil) and (i<20) do begin FActiveIP:=inet_ntoa(pptr^^); Inc(I); end; setlength(FActiveIP,i);end;procedure Tcap_ip.set_socket_state;var i,iErrorCode:integer; sa: tSockAddrIn; dwBufferLen:array[0..10]of DWORD; dwBufferInLenWORD; dwBytesReturnedWORD;begin if high(FActiveIP)=-1 then exit; setlength(Fsocket,high(FActiveIP)+1); for i:=0 to high(FActiveIP) do begin Fsocket:= socket(AF_INET , SOCK_RAW , IPPROTO_IP); sa.sin_family:= AF_INET; sa.sin_port := htons(i); sa.sin_addr.S_addr:=Inet_addr(pchar(FActiveIP)); iErrorCode := bind(Fsocket,sa, sizeof(sa)); CheckSockError(iErrorCode); dwBufferInLen := 1 ; dwBytesReturned:=0; //设置Fsocket为SIO_RCVALL接收所有的IP包 iErrorCode:=FWSAIoctl(Fsocket, SIO_RCVALL,@dwBufferInLen, sizeof(dwBufferInLen), @dwBufferLen, sizeof(dwBufferLen),@dwBytesReturned ,nil ,nil); CheckSockError(iErrorCode); iErrorCode:=WSAAsyncSelect(Fsocket,FWindowHandle,WM_CapIp+i,FD_READ or FD_CLOSE); CheckSockError(iErrorCode); end;end;//读IP数据procedure Tcap_ip.cap_ip(socket_no:integer);var iErrorCode:integer; RecvBuf:array[0..MAX_PACK_LEN] of char;begin fillchar(RecvBuf,sizeof(RecvBuf),0); iErrorCode := frecv(Fsocket[socket_no], RecvBuf, sizeof(RecvBuf), 0); CheckSockError(iErrorCode); if not Fpause then begin iErrorCode := DecodeIpPack(FActiveIP[socket_no],RecvBuf, iErrorCode); CheckSockError(iErrorCode); end;end;//协议识别程序function Tcap_ip.CheckProtocol(iProtocol:integer):string;var i:integer;begin result:=''; case iProtocol of IPPROTO_IP :result:='IP'; IPPROTO_ICMP :result:='ICMP'; IPPROTO_IGMP :result:='IGMP'; IPPROTO_GGP :result:='GGP'; IPPROTO_TCP :result:='TCP'; IPPROTO_PUP :result:='PUP'; IPPROTO_UDP :result:='UDP'; IPPROTO_IDP :result:='IDP'; IPPROTO_ND :result:='NP'; IPPROTO_RAW :result:='RAW'; IPPROTO_MAX :result:='MAX'; else result:=''; end;end;//IP解包程序function Tcap_ip.DecodeIpPack(ip:string;bufchar;iBufSize:integer):integer;var SourcePort,DestPort:word; iProtocol, iTTL:integer; szProtocol :array[0..MAX_PROTO_TEXT_LEN] of char; szSourceIP :array[0..MAX_ADDR_LEN] of char; szDestIP :array[0..MAX_ADDR_LEN] of char; pIpheader:IP_HEADER; pTcpHeader:TCP_HEADER; pUdpHeader:UDP_HEADER; pIcmpHeader:ICMP_HEADER; saSource, saDest:TSockAddrIn; iIphLen,data_size:integer; TcpHeaderLen:integer; TcpDatachar;begin result:=0; CopyMemory(@pIpheader,buf,sizeof(pIpheader));//协议甄别 iProtocol := pIpheader.proto; StrLCopy(szProtocol, pchar(CheckProtocol(iProtocol)),15);//源地址 saSource.sin_addr.s_addr := pIpheader.sourceIP; strlcopy(szSourceIP, inet_ntoa(saSource.sin_addr), MAX_ADDR_LEN);//目的地址 saDest.sin_addr.s_addr := pIpheader.destIP; strLcopy(szDestIP, inet_ntoa(saDest.sin_addr), MAX_ADDR_LEN); iTTL := pIpheader.ttl;//计算IP首部的长度 iIphLen :=sizeof(pIpheader);//根据协议类型分别调用相应的函数 case iProtocol of IPPROTO_TCP :begin CopyMemory(@pTcpHeader,buf+iIphLen,sizeof(pTcpHeader)); SourcePort := ntohs(pTcpHeader.TCP_Sport);//源端口 DestPort := ntohs(pTcpHeader.TCP_Dport); //目的端口 TcpData:=buf+iIphLen+sizeof(pTcpHeader); data_size:=iBufSize-iIphLen-sizeof(pTcpHeader); end; IPPROTO_UDP :begin CopyMemory(@pUdpHeader,buf+iIphLen,sizeof(pUdpHeader)); SourcePort := ntohs(pUdpHeader.uh_sport);//源端口 DestPort := ntohs(pUdpHeader.uh_dport); //目的端口 TcpData:=buf+iIphLen+sizeof(pUdpHeader); data_size:=iBufSize-iIphLen-sizeof(pUdpHeader); end; IPPROTO_ICMP :begin CopyMemory(@pIcmpHeader,buf+iIphLen,sizeof(pIcmpHeader)); SourcePort := pIcmpHeader.i_type;//类型 DestPort := pIcmpHeader.i_code; //代码 TcpData:=buf+iIphLen+sizeof(pIcmpHeader); data_size:=iBufSize-iIphLen-sizeof(pIcmpHeader); end; else begin SourcePort :=0; DestPort := 0; //代码 TcpData:=buf+iIphLen; data_size:=iBufSize-iIphLen; end; end; if Assigned(FOnCap) then FOnCap(ip,szProtocol,szSourceIP,szDestIP,inttostr(SourcePort),inttostr(DestPort) ,buf,iBufSize-data_size,TcpData,data_size);end;//SOCK错误处理程序function Tcap_ip.CheckSockError(iErrorCode:integer):boolean; //出错处理函数begin if(iErrorCode=SOCKET_ERROR) then begin if Assigned(FOnError) then FOnError(inttostr(GetLastError)+SysErrorMessage(GetLastError)); result:=true; end else result:=false;end;procedure Tcap_ip.WndProc(var MsgRec: TMessage);begin with MsgRec do if (Msg >=WM_CapIp) and (Msg <= WM_CapIp+high(FActiveIP)) then cap_ip(msg-WM_CapIp) else Result := DefWindowProc(Handle, Msg, wParam, lParam);end;constructor Tcap_ip.Create(Owner : TComponent);begin Inherited Create(Owner); Fpause:=false; Finitsocket:=false; setlength(Fsocket,0); FWindowHandle := XSocketAllocateHWnd(Self);end;{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}destructor Tcap_ip.Destroy;var i:integer;begin for i:=0 to high(Fsocket) do FCloseSocket(Fsocket); if self.Finitsocket then begin FWSACleanup; if Fhand_dll <> 0 then FreeLibrary(Fhand_dll); end; inherited Destroy;end;function Tcap_ip.init_socket:boolean;//初始化var GInitData:TWSAData;begin result:=true; IF Finitsocket then exit; Fhand_dll := LoadLibrary('ws2_32.dll'); if Fhand_dll = 0 then begin raise ESocketException.Create('Unable to register ws2_32.dll'); result:=false; exit; end; @FWSAStartup := GetProcAddress(Fhand_dll, 'WSAStartup'); @FOpenSocket := GetProcAddress(Fhand_dll, 'socket'); @FInet_addr := GetProcAddress(Fhand_dll, 'inet_addr'); @Fhtons := GetProcAddress(Fhand_dll, 'htons'); @FConnect := GetProcAddress(Fhand_dll, 'connect'); @FCloseSocket := GetProcAddress(Fhand_dll, 'closesocket'); @Fsend := GetProcAddress(Fhand_dll, 'send'); @FWSAIoctl := GetProcAddress(Fhand_dll, 'WSAIoctl'); @Frecv := GetProcAddress(Fhand_dll, 'recv'); @FWSACleanup := GetProcAddress(Fhand_dll, 'WSACleanup'); @FWSAAsyncSelect:=GetProcAddress(Fhand_dll, 'WSAAsyncSelect'); if (@FWSAStartup =nil) or(@Fhtons =nil) or (@FConnect =nil) or (@Fsend =nil) or (@FWSACleanup=nil) or (@FOpenSocket =nil) or (@FInet_addr =nil)or (@FCloseSocket =nil) or (@recv=nil)or (@FWSAIoctl=nil) or (@FWSAAsyncSelect=nil) then begin raise ESocketException.Create('加载dll函数错误!'); result:=false; exit; end; if FWSAStartup($201,GInitData)<>0 then begin raise ESocketException.Create('初始化SOCKET2函数失败!'); result:=false; exit; end; Finitsocket:=true;end;procedure Tcap_ip.StartCap;begin if not Finitsocket then if not init_socket then exit; get_ActiveIP; set_socket_state;end;procedure Tcap_ip.pause;begin if Finitsocket and (high(Fsocket)>-1) then Fpause:=not Fpause;end;procedure Tcap_ip.StopCap;var i:integer;begin for i:=0 to high(Fsocket) do FCloseSocket(Fsocket);end;procedure Register;begin RegisterComponents('Standard', [Tcap_ip]);end;end.//////////////////////////////////////////////////////////////////////////////////这是EXE单元unit cap_main;interfaceuses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, cap_ip, StdCtrls, ExtCtrls, Grids, ComCtrls, Buttons, Menus;type Tmy_data=record buf:array of char;end;type TForm1 = class(TForm) BitBtn1: TBitBtn; BitBtn2: TBitBtn; BitBtn3: TBitBtn; BitBtn4: TBitBtn; PageControl1: TPageControl; TabSheet1: TTabSheet; TabSheet2: TTabSheet; StringGrid1: TStringGrid; Splitter1: TSplitter; Edit2: TEdit; Label1: TLabel; Panel1: TPanel; Memo1: TMemo; Splitter2: TSplitter; Memo2: TMemo; BitBtn5: TBitBtn; Label2: TLabel; Edit1: TEdit; ComboBox1: TComboBox; Label7: TLabel; ComboBox2: TComboBox; Label8: TLabel; BitBtn6: TBitBtn; procedure FormCreate(Sender: TObject); procedure cap_ip1Cap(ip, proto, sourceIP, destIP, SourcePort, DestPort: String; header: PChar; header_size: Integer; data: PChar; data_size: Integer); procedure BitBtn1Click(Sender: TObject); procedure BitBtn2Click(Sender: TObject); procedure BitBtn3Click(Sender: TObject); procedure StringGrid1Click(Sender: TObject); procedure BitBtn5Click(Sender: TObject); procedure BitBtn6Click(Sender: TObject); procedure BitBtn4Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } public function check_filter(proto, sourceIP, destIP, SourcePort,DestPort: String; data: PChar;data_size: Integer):boolean; end;var Form1: TForm1; buf_list:array of Tmy_data; filter_str:string; cap_ip1:Tcap_ip;implementation{$R *.DFM}procedure TForm1.FormCreate(Sender: TObject);begin with StringGrid1.Rows[0] do begin Add('协议类型'); Add('源地址'); Add('源端口'); Add('目的地址'); Add('目的端口'); Add('数据大小'); Add('数据内容'); end; setlength(buf_list,strtoint(edit2.text)); cap_ip1:=Tcap_ip.Create(self); cap_ip1.OnCap:=cap_ip1Cap;end;function TForm1.check_filter(proto, sourceIP, destIP, SourcePort,DestPort: String;data: PChar;data_size: Integer):boolean;var i:integer; temp_str:string;begin result:=true; if filter_str='' then begin result:=false; exit; end; if (filter_str='排除协议'+proto) then exit; if (filter_str='排除源地址'+sourceIP) then exit; if (filter_str='排除源端口'+SourcePort) then exit; if (filter_str='排除目的地址'+destIP) then exit; if (filter_str='排除目的端口'+DestPort) then exit; if (ComboBox2.text='包含') and (ComboBox1.Text<>'内容') then begin if (filter_str='包含协议'+proto) then begin result:=false;exit;end; if (filter_str='包含源地址'+sourceIP) then begin result:=false;exit;end; if (filter_str='包含源端口'+SourcePort) then begin result:=false;exit;end; if (filter_str='包含目的地址'+destIP) then begin result:=false;exit;end; if (filter_str='包含目的端口'+DestPort) then begin result:=false;exit;end; result:=true;exit; end; if (filter_str<>'包含内容') then begin result:=false;exit; end; setlength(buf_list[StringGrid1.RowCount-2].buf,data_size); copymemory(buf_list[StringGrid1.RowCount-2].buf,data,data_size); temp_str:=''; for i:=0 to data_size-1 do temp_str:=temp_str+buf_list[StringGrid1.RowCount-2].buf; temp_str:=AnsiLowerCase(temp_str); if (filter_str='包含内容') then begin if pos(AnsiLowerCase(edit1.text),temp_str)>0 then begin result:=false; exit; end else begin result:=true; exit; end; end else if (filter_str='排除内容') then begin if pos(AnsiLowerCase(edit1.text),temp_str)>0 then begin result:=true; exit; end else begin result:=false; exit; end; end; result:=false;end;procedure TForm1.cap_ip1Cap(ip, proto, sourceIP, destIP, SourcePort, DestPort: String; header: PChar; header_size: Integer; data: PChar; data_size: Integer);begin if check_filter(proto,sourceIP, destIP, SourcePort,DestPort, data,data_size) then exit; with StringGrid1 do begin Cells[0,StringGrid1.RowCount-1]:=proto; Cells[1,StringGrid1.RowCount-1]:=sourceIP; Cells[2,StringGrid1.RowCount-1]:=SourcePort; Cells[3,StringGrid1.RowCount-1]:=destIP; Cells[4,StringGrid1.RowCount-1]:=DestPort; Cells[5,StringGrid1.RowCount-1]:=inttostr(data_size); Cells[6,StringGrid1.RowCount-1]:=data; end; setlength(buf_list[StringGrid1.RowCount-2].buf,data_size); copymemory(buf_list[StringGrid1.RowCount-2].buf,data,data_size); if (StringGrid1.RowCount>strtoint(edit2.text)) then StringGrid1.RowCount:=2 else begin StringGrid1.RowCount:=StringGrid1.RowCount+1; StringGrid1.Rows[StringGrid1.RowCount].Clear; end; stringgrid1.toprow:=StringGrid1.RowCount- StringGrid1.VisibleRowCount;end;procedure TForm1.BitBtn1Click(Sender: TObject);begin cap_ip1.StartCap;end;procedure TForm1.BitBtn2Click(Sender: TObject);begin cap_ip1.pause; if cap_ip1.Fpause then BitBtn2.Caption:='继续捕捉' else BitBtn2.Caption:='暂停捕捉';end;procedure TForm1.BitBtn3Click(Sender: TObject);begincap_ip1.StopCap;end;procedure TForm1.StringGrid1Click(Sender: TObject);var text_str,hex_str,all_str:string; i:integer; no: Integer;begin memo1.lines.Clear; memo2.lines.Clear; text_str:='';hex_str:='';all_str:=''; i:=0; while i<= high(buf_list[stringgrid1.Selection.Top-1].buf) do begin no:=ord(buf_list[stringgrid1.Selection.Top-1].buf); hex_str:=hex_str+format('%0.2x',[no])+' '; if no<20 then begin text_str:=text_str+'.'; all_str:=all_str+'.'; end else begin text_str:=text_str+buf_list[stringgrid1.Selection.Top-1].buf; all_str:=all_str+buf_list[stringgrid1.Selection.Top-1].buf; end; if ((i mod 8)=7) then begin memo1.lines.add(hex_str+' | '+text_str); text_str:='';hex_str:=''; end; inc(i); end; if hex_str<>'' then memo1.lines.add(hex_str+format('%'+inttostr(24-length(hex_str))+'s',[' '])+' | '+text_str); memo2.lines.Add(all_str);end;procedure TForm1.BitBtn5Click(Sender: TObject);begin StringGrid1.RowCount:=2; StringGrid1.Rows[1].Clear;end;procedure TForm1.BitBtn6Click(Sender: TObject);begin filter_str:=''; if (ComboBox2.text='') or (ComboBox1.Text='') or (edit1.Text='') then showmessage('内容不全!') else if ComboBox1.Text='内容' then filter_str:=self.ComboBox2.text+self.ComboBox1.Text else filter_str:=self.ComboBox2.text+self.ComboBox1.Text+AnsiUpperCase(edit1.Text);end;procedure TForm1.BitBtn4Click(Sender: TObject);begin close;end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);begin cap_ip1.Free;end;end.

接受答案，并感谢xernet！