Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Internet (https://www.clubdelphi.com/foros/forumdisplay.php?f=3)
-   -   No puedo encontrar el problema (https://www.clubdelphi.com/foros/showthread.php?t=82418)

MaxiDucoli 06-03-2013 01:29:03
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.

Casimiro Noteví 06-03-2013 01:39:13
¿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?

MaxiDucoli 06-03-2013 01:46:10
Cita:
Empezado por Casimiro Notevi (Mensaje 456048)
¿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.

Casimiro Noteví 06-03-2013 01:52:23
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.

MaxiDucoli 06-03-2013 04:30:41
Cita:
Empezado por Casimiro Notevi (Mensaje 456050)
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 :)

Casimiro Noteví 06-03-2013 11:28:40
Cita:
Empezado por MaxiDucoli (Mensaje 456057)
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.

MaxiDucoli 07-03-2013 00:14:37
Cita:
Empezado por Casimiro Notevi (Mensaje 456076)
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)));

Casimiro Noteví 07-03-2013 00:54:34
Prueba con

Buffer: array[0..63] of ansichar;

MaxiDucoli 07-03-2013 01:02:20
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 :)
:p


La franja horaria es GMT +2. Ahora son las 23:57:39.

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