Programlama yapalım ve Öğrenelim.

Kaç Yıl, Ay ve Gün Kaldı Düzeltme Ek

var

Tarih1, Tarih2 : TDateTime;

Sayi : Integer;

fark_trh : TDate;

begin

Tarih1 := Now; // İlk tarih değer

Tarih2 := StrToDateTime(Edit1.Text); // İkinci tarih değer

fark_trh:=tarih2 - tarih1;

label1.caption:='Kalan Hizmet Süresi = '+ formatdatetime('yy',fark_trh)+' Yıl ' + formatdatetime('mm',fark_trh)+' Ay Kaldı ' + formatdatetime('dd',fark_trh)+' Gün Kaldı '

end;

** Yukarıda yapmış olduğunuz kodlamayı hiç çalıştırıp denediniz mi?

** Amacım sizi eleştirmek değil. Hata varsa düzeltmek ve en doğruya hep birlikte

ulaşmak. Unutmayınız ki, Kodbank'tan yeni başlayanlar daha fazla yararlanmakta.

** Edit1'e 31122007 şeklinde bir giriş " '31122007' is not a valid date and time "

şeklinde bir EConvertError hatası döndürür. '31/12/2007' için de aynı hata mesajı

sözkonusu. '31.12.2007' şeklinde bir giriş de ise kodlamanız doğru çalışır. Ancak

yine bir sorun var. Sistem tarihi ile Edit1'e girilen aynı olursa sonuç ne olur?

Peki ya, sistem tarihinden önceki bir gün girilirse veya 13(ay).32(gün).2007 şeklinde

bir veri girişinde nasıl bir sonuç üretir? Bunları kontrol altında tutmamışsınız.

İşinizi görmesi dileğimle,

Çalışmalarınızda başarılar dilerim.

NeverFear - kaheri579@hotmail.com

Delphi - .....................................

Dosya Tamir-Bakım İşlemleri

NeverFear - kaheri579@hotmail.com

procedure TForm1.BitBtn_TamirClick(Sender: TObject);

var Mesaj, Path, Dosya: string;

begin

Mesaj:= '';

Path:= 'C:DenemeData';

Dosya:= 'Dosyalar.db';

if CheckBox1.Checked then begin

Mesaj:= '';

if FileExists(Path + Dosya) then begin

if FileExists(Path + Copy(Dosya, 1, 8) + '.PX') then

// Üzerinde işlem yapılacak dosyanın adının 8 karekter olduğu varsayılmıştır.

// 8 karekterden büyük veya küçük olsaydı POS fonksiyonunu kullanmak zorundaydık.

// Daha önce Kodbank'a gönderdiğim "Delphi fonksiyonlarına birkaç örnek (derleme)"

// başlıklı konudan yardım alabilirsiniz.

DeleteFile(Path + Copy(Dosya, 1, 8) + '.PX');

with Table1 do begin

try

Active:= False;

DatabaseName:= Path;

TableName:= Dosya;

TableType:= ttParadox;

AddIndex('AnaKey', 'KayitNo', [ixPrimary, ixUnique]);

AddIndex('AltKey', 'AdiSoyadi', [ixUnique]);

Mesaj:= Copy(Dosya, 1, 8) + ' dosyası başarıyla kurtarıldı.';

except on EDatabaseError do

Mesaj:= Copy(Dosya, 1, 8) + ' dosyası kurtarılamadı.';

end;

end

else Mesaj:= Copy(Dosya, 1, 8) + ' dosyası bulunamadı.';

end

else ShowMessage('Kurtarılacak dosya seçilmemiş.');

end;

İşinizi görmesi dileğimle,

Çalışmalarınızda başarılar dilerim.

NeverFear - kaheri579@hotmail.com

Delphi - .....................................

select klasor yeni klasor olusturlu

Uses ShlObj;

// işin espirisi BIF_NEWDIALOGSTYLE aslında

var bi: TBROWSEINFO;

str: Array[0..MAX_PATH] of Char;

pIDListItem: PItemIDList;

pStr: PChar;

begin

bi.hwndOwner := Handle;

bi.pidlRoot := nil;

bi.pszDisplayName := @str;

bi.ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;

bi.lpfn := nil;

bi.lpszTitle:='Dizinini Seçiniz:';

pIDListItem := SHBrowseForFolder(bi);

if pIDListItem <> nil then

begin

pStr := @Str;

SHGetPathFromIDList(pIDListItem, pStr);

ShowMessage(pStr);

end;

Delphi - .....................................

VeriTabanı Bağlantı durumunu kontrol etme

Thread yapısı içerisinde veritabanı bağlantının olup olmadığını öğrenmek istiyorum...

Bu konuda yardımcı olabilir misiniz?

Teşekkürler

Delphi - .....................................

Treeview in Combobox içinde gösterme Unicode desteyi

Treeview in Combobox içinde gösterme Unicode desteyi ile mumkun mu?

mumkunse yardim edin.

Tesekkurler

Delphi - .....................................

mssql sayı okunuş

delphiturkiyeden alıntıdır

CREATE FUNCTION RakamOku (@Sayi bigint)

RETURNS nvarchar(300)

BEGIN

DECLARE @n int,@i int,@UcHane int,@Yed nvarchar(300),@UcluHane nvarchar(300),

@HangiBasamak int,@Negatif bit,@BasamakYaz bit,@SONUC nvarchar(300)

SET @n=9

SET @SONUC=NULL

BEGIN

SET @SONUC=''

IF (@Sayi=0) SET @SONUC='Sıfır' ELSE BEGIN

IF (@Sayi<0) BEGIN

SET @Negatif=1

SET @Sayi=-@Sayi

END ELSE SET @Negatif=0

SET @HangiBasamak=0;

WHILE (@Sayi>0) BEGIN

SET @UcHane=@Sayi % 1000

SET @Sayi=@Sayi / 1000

IF (@UcHane>0) SET @BasamakYaz=1 ELSE SET @BasamakYaz=0

IF ((@HangiBasamak=1) and (@UcHane=1)) SET @UcluHane=''

ELSE BEGIN

SET @UcluHane=''

SET @i=@UcHane%10 SET @UcHane=@UcHane/10

SET @UcluHane=CASE @i

WHEN 1 THEN 'Bir'

WHEN 2 THEN 'İki'

WHEN 3 THEN 'Üç'

WHEN 4 THEN 'Dört'

WHEN 5 THEN 'Beş'

WHEN 6 THEN 'Altı'

WHEN 7 THEN 'Yedi'

WHEN 8 THEN 'Sekiz'

WHEN 9 THEN 'Dokuz'

ELSE '' END

SET @i=@UcHane%10 SET @UcHane=@UcHane/10

SET @UcluHane=CASE @i

WHEN 1 THEN 'On'

WHEN 2 THEN 'Yirmi'

WHEN 3 THEN 'Otuz'

WHEN 4 THEN 'Kırk'

WHEN 5 THEN 'Elli'

WHEN 6 THEN 'Altmış'

WHEN 7 THEN 'Yetmiş'

WHEN 8 THEN 'Seksen'

WHEN 9 THEN 'Doksan'

ELSE '' END+@UcluHane

SET @i=@UcHane%10 --SET @UcHane=@UcHane/10

IF (@i>0) SET @Yed='Yüz' ELSE SET @Yed=''

IF (@i>1) SET @Yed=CASE @i

WHEN 1 THEN 'Bir'

WHEN 2 THEN 'İki'

WHEN 3 THEN 'Üç'

WHEN 4 THEN 'Dört'

WHEN 5 THEN 'Beş'

WHEN 6 THEN 'Altı'

WHEN 7 THEN 'Yedi'

WHEN 8 THEN 'Sekiz'

WHEN 9 THEN 'Dokuz'

ELSE '' END+@Yed

SET @UcluHane=@Yed+@UcluHane;

END

IF (@BasamakYaz=1) SET @SONUC=@UcluHane+CASE @HangiBasamak

WHEN 1 THEN 'Bin'

WHEN 2 THEN 'Milyon'

WHEN 3 THEN 'Milyar'

WHEN 4 THEN 'Trilyon'

WHEN 5 THEN 'Katrilyon'

WHEN 6 THEN 'Kentrilyon'

WHEN 7 THEN 'Sekstilyon'

WHEN 8 THEN 'Septilyon'

WHEN 9 THEN 'Oktilyon'

ELSE '' END+@SONUC

SET @HangiBasamak=@HangiBasamak+1

END

IF (@Negatif=1) SET @SONUC='Eksi'+@SONUC

END

RETURN @SONUC

END

CREATE FUNCTION ParaOku (@Sayi float)

RETURNS nvarchar(300)

BEGIN

DECLARE @Tam nvarchar(20),@Ondalik nvarchar(20),@SONUC nvarchar(300),

@TamSayi bigint,@OndSayi int

SET @Tam='YTL'

SET @Ondalik='YKr'

SET @TamSayi=@Sayi

SET @SONUC=dbo.RakamOku(@TamSayi)+' '+@Tam

SET @TamSayi=Round((@Sayi-@TamSayi)*100,2)

SET @SONUC=@SONUC+' '+dbo.RakamOku(@TamSayi,@Dil)+' '+@Ondalik

RETURN @SONUC

END

Delphi - .....................................

T.C.M.B. Döviz Kurlarını Alma

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,

IdHTTP, OleCtnrs, StdCtrls, Buttons, InvokeRegistry, Rio, SOAPHTTPClient,

Grids;

type

TForm1 = class(TForm)

IdHTTP1: TIdHTTP;

BitBtn1: TBitBtn;

HTTPRIO1: THTTPRIO;

ListBox1: TListBox;

StringGrid1: TStringGrid;

procedure BitBtn1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);

var

ss,ss1,aa:String;

i,h:integer;

begin

ListBox1.Clear;

try

ss:=IdHTTP1.get('http://www.tcmb.gov.tr/kurlar/today.html');

ss1 :=copy(ss,pos(''#$A,ss)+4,pos(''#$A'',ss));

ss1:=copy (ss1,1,pos(#$A,ss1)-1);

ListBox1.Items.Add(' '+trim('Kur '+ss1));

delete (ss,1,pos(ss1,ss)+Length(ss1));

ss1:=copy (ss,1,pos(''#$A,ss)-1);

ListBox1.Items.Add(' '+trim(ss1));

Delete (ss,1,Pos(''#$A,ss)+4);

i:=0;

repeat

ss1:=copy (ss,pos('/TRY ',ss)+4,pos(#$A,ss)-(pos('/TRY ',ss)+4));

ListBox1.Items.Add(ss1);

Delete (ss,1,Pos(#$A,ss));

inc(i);

until i>=18;

i:=0;

StringGrid1.RowCount:=18;

repeat

aa:=ListBox1.Items.Strings[i];

h:=0;

repeat

aa:=TrimLeft(aa+' ');

StringGrid1.Cells[h,i]:=copy (aa,1,pos(' ',aa));

delete (aa,1,pos(' ',aa));

inc(h);

until h>=5 ;

inc(i);

until i>=18 ;

StringGrid1.ColWidths[0]:=250;

except

Showmessage('İnternet Bağlantınızı Kontrol Ediniz');

end;

end.

Delphi - .....................................

integer to binary string

function IntToBinStr(num: integer): string;

var

i: integer;

begin

for i := 0 to 31 do

Result := IntToStr((num shr i) and 1) + Result;

end;

Delphi - .....................................

bcd to string-string to bcd

function NumStringToBCD(const inStr: string): string;

function Pack(ch1, ch2: Char): Char;

begin

Assert((ch1 >= '0') and (ch1 <= '9'));

Assert((ch2 >= '0') and (ch2 <= '9'));

{Ord('0') is $30, so we can just use the low nybble of the character

as value.}

Result := Chr((Ord(ch1) and $F) or ((Ord(ch2) and $F) shl 4))

end;

var

i: Integer;

begin

if Odd(Length(inStr)) then

Result := NumStringToBCD('0' + instr)

else begin

SetLength(Result, Length(inStr) div 2);

for i := 1 to Length(Result) do

Result[i] := Pack(inStr[2 * i - 1], inStr[2 * i]);

end;

function BCDToNumString(const inStr: string): string;

procedure UnPack(ch: Char; var ch1, ch2: Char);

begin

ch1 := Chr((Ord(ch) and $F) + $30);

ch2 := Chr(((Ord(ch) shr 4) and $F) + $30);

Assert((ch1 >= '0') and (ch1 <= '9'));

Assert((ch2 >= '0') and (ch2 <= '9'));

end;

var

i: Integer;

begin

SetLength(Result, Length(inStr) * 2);

for i := 1 to Length(inStr) do

UnPack(inStr[i], Result[2 * i - 1], Result[2 * i]);

end;

procedure TForm1.Button1Click(Sender: TObject);

var

S1, S2: string;

begin

S1 := '15151515151515151515';

S2 := NumStringToBCD(S1);

memo1.lines.add('S1: ' + S1);

memo1.lines.add('Length(S2): ' + IntToStr(Length(S2)));

memo1.lines.add('S2 unpacked again: ' + BCDToNumString(S2));

end;

Delphi - .....................................

packet sniff

Selam arkadas,lar; Bir zamanlar yünlerce uyumadan bu konu üstüne birs,iler aram?s,t?m nette. Gelen giden IP paketlerini sniff etme. Hatta makinamda firwall kurulu iken bile fireeall ile ayn? seviyede çal?s,acak ve gelen giden paketleri gösterecek bir s,ey. Sonunda uzun çabalar sonucu nas?l yap?lacag?n? ögrendim. Ve sizlerle paylas,mak istedim. Kodu as,ag(?ya b?rak?yorum. Bu arada yakalad?g(?m paketi uygulamalara (explorer, mirc, icq, messenger gibi) ulas,madan yok etmeyi (firewall) bulamd?m henüz s,ayet bunu bas,aran olursa lütfen paylas,s?n. is,te kod ...

Unit ipheader;

Interface

Uses

windows, winsock;

Const

TCPFlag_URG = 0;

TCPFlag_ACK = 2;

TCPFlag_PSH = 4;

TCPFlag_RST = 8;

TCPFlag_SYN = 16;

TCPFlag_FYN = 32;

IPPROTO_IP = 0; //dummy for IP

IPPROTO_ICMP = 1; // control message protocol

IPPROTO_IGMP = 2; //internet group management protocol

IPPROTO_GGP = 3; // gateway^2 (deprecated)

IPPROTO_TCP = 6; // tcp

IPPROTO_PUP = 12; // pup

IPPROTO_UDP = 17; // user datagram protocol

IPPROTO_IDP = 22; // xns idp

IPPROTO_ND = 77; // UNOFFICIAL net disk proto

IPPROTO_RAW = 255; // raw IP packet

IPPROTO_MAX = 256;

SIO_RCVALL = $98000001;

Type

TIPPROTO = Record

itype: word;

name: String;

End;

PIP_Header = ^TIP_Header;

TIP_Header = Packed Record

ip_verlen: Byte;

ip_tos: Byte;

ip_totallength: Word;

ip_id: Word;

ip_offset: Word;

ip_ttl: Byte;

ip_protocol: Byte;

ip_checksum: Word;

ip_srcaddr: LongWord;

ip_destaddr: LongWord;

data:array [0..0] of char;

End;

PUDP_Header = ^TUDP_Header;

TUDP_Header = Packed Record

src_portno: Word;

dst_portno: Word;

udp_length: Word;

udp_checksum: Word;

End;

PTCP_Header = ^TTCP_Header;

TTCP_Header = Packed Record

src_portno: Word;

dst_portno: Word;

Sequenceno: LongWord;

Acknowledgeno: LongWord;

DataOffset: Byte;

flag: byte;

Windows: WORD;

checksum: WORD;

UrgentPointer: WORD;

End;

Const

IPPROTO: Array[0..8] Of TIPPROTO = (

(iType: IPPROTO_IP; name: 'IP'),

(iType: IPPROTO_ICMP; name: 'ICMP'),

(iType: IPPROTO_IGMP; name: 'IGMP'),

(iType: IPPROTO_GGP; name: 'GGP'),

(iType: IPPROTO_TCP; name: 'TCP'),

(iType: IPPROTO_PUP; name: 'PUP'),

(iType: IPPROTO_UDP; name: 'UDP'),

(iType: IPPROTO_IDP; name: 'IDP'),

(iType: IPPROTO_ND; name: 'ND'));

Implementation

End.

unit sniffer_w2k_delphi;

interface

uses

ipheader, Controls, Grids, hexeditor, ComCtrls, Classes, StdCtrls ,

winsock,Windows, Messages, SysUtils, Graphics, Forms, Dialogs ;

const WM_ASYNCSELECT = WM_USER + 0;

type

TSessionClosed = procedure (Sender: TObject; Socket: TSocket) of object;

TSessionAvailable = procedure (Sender: TObject; Socket: TSocket) of object;

TSessionConnected = procedure (Sender: TObject; Socket: TSocket) of object;

TErrorOccurred = procedure (Sender: TObject; Error: integer; Msg: string) of object;

TDataAvailable = procedure (Sender: TObject; Socket: TSocket) of object;

TForm1 = class(TForm)

Button1: TButton;

ListView1: TListView;

HexEditor1: THexEditor;

Button2: TButton;

Button3: TButton;

ComboBox1: TComboBox;

Label1: TLabel;

procedure Button1Click(Sender: TObject);

procedure ListView1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure Button3Click(Sender: TObject);

private

{ Déclarations privées }

FDataAvailable: TDataAvailable;

FSessionClosed: TSessionClosed;

FSessionAvailable: TSessionAvailable;

FSessionConnected: TSessionConnected;

RawSocket: TSocket;

Procedure AnalysisDataPacket;

protected

procedure WMASyncSelect(var msg: TMessage); message WM_user+0;

public

function EnumInterfaces: Boolean;

end;

var

Form1: TForm1;

Const

MAX_CHAR = 1024 * 5;

IP_HDRINCL = 2;

SIO_RCVALL = $98000001;

Function WSAIoctl(s: Tsocket;

dwIoControlCode: dword;

lpvInBuffer: pointer;

cbInBuffer: DWORD;

lpvOUTBuffer: pointer;

cbOUTBuffer: dword;

lpcbBytesReturned: LPDWORD;

lpOverlapped: pointer;

lpCompletionROUTINE: pointer): integer; stdcall; external 'ws2_32.dll';

const SIO_GET_INTERFACE_LIST = $4004747F;

IFF_UP = $00000001;

IFF_BROADCAST = $00000002;

IFF_LOOPBACK = $00000004;

IFF_POINTTOPOINT = $00000008;

IFF_MULTICAST = $00000010;

type sockaddr_gen = packed record

AddressIn: sockaddr_in;

filler: packed array[0..7] of char;

end;

type INTERFACE_INFO = packed record

iiFlags: u_long; // ?? ???????

iiAddress: sockaddr_gen; // ?? ???????

iiBroadcastAddress: sockaddr_gen; // Broadcast ??

iiNetmask: sockaddr_gen; // ?? ????

end;

implementation

{$R *.DFM}

procedure Tform1.WMASyncSelect(var msg: TMessage);

var l,ws_rcv:integer;

str:string;

Buffer : Array[0..32768] of Char;

begin

case LoWord(msg.lParam) of

FD_READ:

begin

if Assigned(FDataAvailable) then FDataAvailable(Self,msg.wParam);

AnalysisDataPacket;

end;

FD_CLOSE:

begin

if Assigned(FSessionClosed) then FSessionClosed(Self,msg.wParam);

end;

FD_ACCEPT:

begin

if Assigned(FSessionAvailable) then FSessionAvailable(Self,msg.wParam);

end;

FD_CONNECT:

begin

if Assigned(FSessionConnected) then FSessionConnected(Self,msg.wParam);

end;

Procedure TForm1.AnalysisDataPacket;

Var

count, iRet, filterip: Integer;

buf: Array[0..MAX_CHAR] Of char;

pipheader: PIP_Header; // PIP_Header

ptcpheader:PTCP_Header;

pudpheader:PUDP_Header;

buf2: pchar;

listdata: Tlistitem;

i,j: Integer;

str: String;

s: String;

src_port,dest_port:word;

Begin

filterip := 0;

Application.ProcessMessages ;

iRet := recv(RawSocket, buf, sizeof(buf), 0);

//If iret = -1 Then Continue;

pipheader := PIP_Header(@buf);

{ Case filterip Of

1: ;

2: ;

3: ;

Else ;

End; //case

}

getmem(buf2, iRet);

copymemory(buf2, @buf, iRet);

listdata := ListView1.Items.Add;

listdata.Caption := FormatDateTime('hh:nn:ss:zzz', now);

listdata.Data := buf2;

listdata.SubItems.Add(strpas(Inet_Ntoa(TInAddr(pipheader.ip_srcaddr))));

listdata.SubItems.Add(strpas(Inet_Ntoa(TInAddr(pipheader.ip_destaddr))));

For i := 0 To 8 Do

If pipheader.ip_protocol = IPPROTO[i].itype Then

str := IPPROTO[i].name;

listdata.SubItems.Add(str);

listdata.SubItems.Add(inttostr(ntohs(pipheader.ip_totallength)));

If pipheader.ip_protocol=6 then

begin

ptcpheader := PTCP_Header(@pipheader.data );

src_port:= ntohs(ptcpheader.src_portno ) ;

dest_port:= ntohs(ptcpheader.dst_portno ) ;

listdata.SubItems.Add(inttostr(src_port));

listdata.SubItems.Add(inttostr(dest_port));

end;

If pipheader.ip_protocol=17 then

begin

pudpheader := PUDP_Header(@pipheader.data );

src_port:= ntohs(pudpheader.src_portno ) ;

dest_port:= ntohs(pudpheader.dst_portno ) ;

listdata.SubItems.Add(inttostr(src_port));

listdata.SubItems.Add(inttostr(dest_port));

end;

End;

procedure TForm1.Button1Click(Sender: TObject);

Var

WSAData: TWSAData;

rcvtimeo, result: Integer;

host: Array[0..50] Of char;

sHost:string;

hostent: Phostent;

ip: ^integer;

sa: TSockAddr;

dwBufferInLen, dwBytesReturned, dwBufferOutLen: DWORD;

Begin

if combobox1.text='' then

begin

showmessage('you must supply an IP!!');

exit;

end;

WSAStartup(MakeWord(2, 2), WSAData);

Try

RawSocket := socket(AF_INET, SOCK_RAW, IPPROTO_IP);

If RawSocket = INVALID_SOCKET Then

Raise Exception.Create('INVALID_SOCKET');

rcvtimeo := 5000;

result := setsockopt(RawSocket, SOL_SOCKET, SO_RCVTIMEO, pchar(@rcvtimeo), sizeof(rcvtimeo));

If result = SOCKET_ERROR Then

Raise Exception.Create('SetSocket failed');

//gethostname(@host, sizeof(host));

//hostent := gethostbyname(@host);

shost:=combobox1.text;

hostent := gethostbyname(pchar(shost));

ip := @hostent.h_addr_list^[0];

sa.sin_family := AF_INET;

sa.sin_port := htons(7000);

sa.sin_addr.s_addr := ip^;

result := bind(RawSocket, sa, sizeof(sa));

If result = SOCKET_ERROR Then

Raise Exception.Create('bind failed');

dwBufferInLen:=1;

dwBufferOutLen:=0;

result := WSAIoctl(RawSocket, SIO_RCVALL, @dwBufferInLen,

sizeof(dwBufferInLen), @dwBufferOutLen, sizeof(dwBufferOutLen),

@dwBytesReturned, Nil, Nil);

If result = SOCKET_ERROR Then

Raise Exception.Create('SOCKET_ERROR');

result := WSAASyncSelect(RawSocket,handle,

WM_ASYNCSELECT,

FD_READ );

if result <> 0 then

begin

showmessage('WSAASyncSelect socket error');

closesocket(RawSocket);

WSACleanup;

end;

button1.Enabled :=false;

button2.Enabled :=true;

//AnalysisDataPacket;

Except

closesocket(RawSocket);

WSACleanup;

End; //finally

End;

procedure TForm1.ListView1Click(Sender: TObject);

begin

if form1.HexEditor1.DataSize>0 then

begin

form1.HexEditor1.SelStart :=0;

form1.HexEditor1.Selend := form1.HexEditor1.DataSize -1;

form1.HexEditor1.DeleteSelection ;

end;

try

form1.HexEditor1.InsertBuffer (listview1.Selected.data,strtoint(listview1.Selected.SubItems [3]),0);

form1.HexEditor1.SelStart :=0;

form1.HexEditor1.Selend :=0;

except

on E: Exception do showmessage(E.Message);

end;

procedure TForm1.Button2Click(Sender: TObject);

var bytes,i:integer;

begin

WSAASyncSelect(RawSocket ,Handle,WM_ASYNCSELECT,0);

WSACleanUp;

button1.Enabled :=true;

button2.Enabled :=false;

{

for i:=0 to ListView1.Items.Count-1 do

begin

bytes:=bytes+strtoint(ListView1.Items[i].SubItems [3]);

end;

showmessage(

inttostr(ListView1.Items.Count)+ ' frames'+chr(10)+chr(13)

+inttostr(bytes)+ ' bytes'+chr(10)+chr(13)

+'avg frame: ' + inttostr(bytes div ListView1.Items.Count)

) ;

}

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

EnumInterfaces;

if ComboBox1.Items.Count >0 then ComboBox1.ItemIndex :=0;

button1.Enabled :=true;

button2.Enabled :=false;

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

ListView1.Items.Clear ;

end;

function tform1.EnumInterfaces: Boolean;

var s: TSocket;

wsaD: WSADATA;

NumInterfaces: Integer;

BytesReturned, SetFlags: u_long;

pAddrInet: SOCKADDR_IN;

pAddrString: PCHAR;

PtrA: pointer;

Buffer: array[0..20] of INTERFACE_INFO;

i: Integer;

begin

result := true;

WSAStartup($0101, wsaD);

s := Socket(AF_INET, SOCK_STREAM, 0);

if (s = INVALID_SOCKET) then exit;

try

PtrA := @bytesReturned;

if (WSAIoCtl(s, SIO_GET_INTERFACE_LIST, nil, 0, @Buffer, 1024, PtrA, nil,

nil)

<> SOCKET_ERROR)

then

begin

NumInterfaces := BytesReturned div SizeOf(INTERFACE_INFO);

for i := 0 to NumInterfaces - 1 do

begin

pAddrInet := Buffer[i].iiAddress.addressIn;

pAddrString := inet_ntoa(pAddrInet.sin_addr);

ComboBox1.Items.Add (pAddrString );

SetFlags := Buffer[i].iiFlags;

//if (SetFlags and IFF_UP) <> IFF_UP then

//if (SetFlags and IFF_BROADCAST) = IFF_BROADCAST then

//if (SetFlags and IFF_LOOPBACK) = IFF_LOOPBACK then

end;

except

end;

// ?????? ???

CloseSocket(s);

WSACleanUp;

result := false;

end;

end.

Yukardaki kod çal?s,makta, formun üstüne bir adet Tlist koymal?s?n?z ...

Birde Hex editor Companenti istiyo. Ama olmasada olur .. Sadece veriyi wiev etmek için laz?m. S,imdi bu kodu kullanarak IP paketlerini istediginiz gibi yakalayabilirsiniz. Ama yok edemiyorum. Eden biri c?karsa lutfen paylas,s,?n

Delphi - .....................................