Club Delphi  
    Paypal   FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Internet
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Colaboración Paypal con ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 06-03-2013
MaxiDucoli MaxiDucoli is offline
Miembro
 
Registrado: feb 2006
Posts: 134
Poder: 21
MaxiDucoli Va por buen camino
Angry No puedo encontrar el problema

Hola, les dejo un archivo pas de una biblioteca que me ayuda a "leer" lo que entra y sale de los puertos.
Esto lo usaba con delpho 2009 y con Windows XP. Ahora tengo Delphi 2010 y Windows 7, pero la biblioteca no me funciona.
Podría algún experto ayudarme por favor a ver si se puede convertir para poder usarla con Delphi 2010 y Windows 7?

Muchas gracias de ante mano


Código:
unit cap_ip;

interface

uses
  Windows, Messages,Classes,winsock,sysutils,dialogs;
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;
                                 dwInBufferLen:DWORD;lpOutBuffer: PCHAR; dwOutBufferLen: DWORD;
                                 lpdwOutBytesReturned: LPDWORD;lpOverLapped: POINTER;
                                 lpOverLappedRoutine: POINTER): Integer; stdcall;
  TCloseSocket           = function (s: TSocket): Integer; stdcall;
  Tsend                  = function( s:TSOCKET; buf:pchar;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;
                       header:pchar;header_size:integer;data:pchar;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;buf:pchar;iBufSize:integer):integer;         //IP½â°üº¯Êý
//     function DecodeTcpPack(TcpBuf:pchar;iBufSize:integer):integer; 	//TCP½â°üº¯Êý
     //function DecodeUdpPack(p:pchar;i:integer):integer;		//UDP½â°üº¯Êý
     //function DecodeIcmpPack(p: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;

implementation
function 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^[i] <> nil) and (i<20) do
   begin
    FActiveIP[i]:=inet_ntoa(pptr^[i]^);
    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;
  dwBufferInLen:DWORD;
  dwBytesReturned:DWORD;
begin
   if high(FActiveIP)=-1 then exit;
   setlength(Fsocket,high(FActiveIP)+1);
   for i:=0 to high(FActiveIP) do
     begin
       Fsocket[i]:= 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[i]));
       iErrorCode := bind(Fsocket[i],sa, sizeof(sa));
       CheckSockError(iErrorCode);

       dwBufferInLen := 1 ;
       dwBytesReturned:=0;
 //ÉèÖÃFsocketΪSIO_RCVALL½ÓÊÕËùÓеÄIP°ü
       iErrorCode:=FWSAIoctl(Fsocket[i], SIO_RCVALL,@dwBufferInLen, sizeof(dwBufferInLen),
                        @dwBufferLen, sizeof(dwBufferLen),@dwBytesReturned ,nil ,nil);

	CheckSockError(iErrorCode);
        iErrorCode:=WSAAsyncSelect(Fsocket[i],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;buf:pchar;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;
  TcpData:pchar;
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
       begin
//        Result := DefWindowProc(Handle, Msg, wParam, lParam);
       end;
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[i]);
   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[i]);
end;

procedure Register;
begin
    RegisterComponents('Standard', [Tcap_ip]);
end;

end.
Responder Con Cita
  #2  
Antiguo 06-03-2013
Avatar de Casimiro Noteví
Casimiro Noteví Casimiro Noteví is offline
Merodeador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.671
Poder: 10
Casimiro Noteví Tiene un aura espectacularCasimiro Noteví Tiene un aura espectacular
¿Y por qué no te funciona?, ¿qué problema tienes?, ¿qué error sale?, ¿qué hace o qué no hace?, ¿cómo lo usas?, ¿por qué tiene comentarios en idioma ruso?
Responder Con Cita
  #3  
Antiguo 06-03-2013
MaxiDucoli MaxiDucoli is offline
Miembro
 
Registrado: feb 2006
Posts: 134
Poder: 21
MaxiDucoli Va por buen camino
Cita:
Empezado por Casimiro Notevi Ver Mensaje
¿Y por qué no te funciona?, ¿qué problema tienes?, ¿qué error sale?, ¿qué hace o qué no hace?, ¿cómo lo usas?, ¿por qué tiene comentarios en idioma ruso?

¿Y por qué no te funciona? --- No lo sé, por eso pido ayuda
¿qué problema tienes? ---- La cargo, se agrega a la paleta de botones y la puedo usar sin errores lo más bien.
¿qué error sale? ----- No tira error alguno, solo no hace lo que tiene que hacer
¿qué hace o qué no hace? ----- No hace nada (ue yo me haya dado cuenta) y lo que no hace es decirme los puertos que entran, leer los datos, los headers, las ip, etc, etc
¿cómo lo usas? -- Sólo lo agrego, tiene una propiedad STARTCAP. y un Procedure OnCap asi:

Código:
procedure TForm1.CapturarCap(ip, proto, sourceIP, destIP, SourcePort,
  DestPort: string; header: PWideChar; header_size: Integer; data: PWideChar;
  data_size: Integer);
begin
//sourceport := '80';
memo2.Lines.Add('HEADER : ' + header);
memo2.Lines.Add('DATA : ' + data);
end;
En este código quiero que en el memo2 me agregue el header y los datos, es solo de prueba.

¿por qué tiene comentarios en idioma ruso? --- Es una biblioteca que la bajé de algún lugar alguna vez. Creo que tiene que ser chino- Mira: http://www.codeforge.com/read/141889/cap_ip.pas__html

Muchas gracias.
Responder Con Cita
  #4  
Antiguo 06-03-2013
Avatar de Casimiro Noteví
Casimiro Noteví Casimiro Noteví is offline
Merodeador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.671
Poder: 10
Casimiro Noteví Tiene un aura espectacularCasimiro Noteví Tiene un aura espectacular
Seguramente es por el unicode, haz una búsqueda por los foros, se ha tratado otras veces, pero básicamente tendrás que cambiar algunas variables string por ansistring. En fin, paciencia y a probar.
Responder Con Cita
  #5  
Antiguo 06-03-2013
MaxiDucoli MaxiDucoli is offline
Miembro
 
Registrado: feb 2006
Posts: 134
Poder: 21
MaxiDucoli Va por buen camino
Cita:
Empezado por Casimiro Notevi Ver Mensaje
Seguramente es por el unicode, haz una búsqueda por los foros, se ha tratado otras veces, pero básicamente tendrás que cambiar algunas variables string por ansistring. En fin, paciencia y a probar.
hay una variable buffer que me dá error y creo que es por el PAnsiChar, pero ya probé de todo y no puedo hacer que funcione.
No puedes darme una mano tratando de compilarlo a ver si se te ocurre qué puede ser?
Gracias
Responder Con Cita
  #6  
Antiguo 06-03-2013
Avatar de Casimiro Noteví
Casimiro Noteví Casimiro Noteví is offline
Merodeador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.671
Poder: 10
Casimiro Noteví Tiene un aura espectacularCasimiro Noteví Tiene un aura espectacular
Cita:
Empezado por MaxiDucoli Ver Mensaje
hay una variable buffer que me dá error y creo que es por el PAnsiChar, pero ya probé de todo y no puedo hacer que funcione.
No puedes darme una mano tratando de compilarlo a ver si se te ocurre qué puede ser?
Gracias
Sí, podría si explicaras algo, antes has dicho que no da ningún error y ahora dices que "da error", así que con información confusa es casi imposible ayudar.

De todas formas, buscar por "ansichar", "unicode", etc. ya que se ha tratado muchas veces ese tema.
Responder Con Cita
  #7  
Antiguo 07-03-2013
MaxiDucoli MaxiDucoli is offline
Miembro
 
Registrado: feb 2006
Posts: 134
Poder: 21
MaxiDucoli Va por buen camino
Cita:
Empezado por Casimiro Notevi Ver Mensaje
Sí, podría si explicaras algo, antes has dicho que no da ningún error y ahora dices que "da error", así que con información confusa es casi imposible ayudar.

De todas formas, buscar por "ansichar", "unicode", etc. ya que se ha tratado muchas veces ese tema.
No sé pasar esto, al compilar me dice "Incompatible ARRAY and PAnsiChar:

Código:
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  Buffer: Array[0..63] of Char;
  I: Integer;
begin
  setlength(FActiveIP,20);
  GetHostName(Buffer, SizeOf(Buffer));
  phe := GetHostByName(buffer);


Este es el que trato de convertir. Creo que solo esto es el error, por que instalé el Virtual Box, puse XP e instalé el Delphi 7 y funciona lo más bien de esa manera.

Código:
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  Buffer: Array[0..63] of Char;
  I: Integer;
begin
  setlength(FActiveIP,20);

  GetHostName(PAnsiChar(AnsiString(Buffer)), SizeOf(Buffer));
  phe := GetHostByName(PAnsiChar(AnsiString(buffer)));
Responder Con Cita
  #8  
Antiguo 07-03-2013
Avatar de Casimiro Noteví
Casimiro Noteví Casimiro Noteví is offline
Merodeador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.671
Poder: 10
Casimiro Noteví Tiene un aura espectacularCasimiro Noteví Tiene un aura espectacular
Prueba con

Buffer: array[0..63] of ansichar;
Responder Con Cita
  #9  
Antiguo 07-03-2013
MaxiDucoli MaxiDucoli is offline
Miembro
 
Registrado: feb 2006
Posts: 134
Poder: 21
MaxiDucoli Va por buen camino
Thumbs up Listo!

Solucionado!!!!
Era eso de la incompatibilidad en el Char y el PAnsiChar.
Lo único que hice fue agregar un PAnsiChar(@Buffer[0]) y listo!
Y en cada incompatibilidad lo mismo y problema resuelto!!
Gracias por las ideas, me ayudaron en todo
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Como Puedo encontrar procesos Gerson12 Varios 4 19-04-2012 12:34:09
Donde Puedo Encontrar Icono microbiano Varios 3 30-09-2010 23:20:21
Donde Puedo encontrar ZEOS para Builder C++ rodno C++ Builder 1 09-02-2009 19:33:30
¿Donde puedo encontrar paquetes SDK? Drake C++ Builder 1 24-01-2006 23:53:55
donde puedo encontrar los instaladores de delphi 7 cero Varios 3 06-08-2004 22:21:25


La franja horaria es GMT +2. Ahora son las 01:20:25.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi