WINSOCKET 编程，求代码？ ( 积分: 200 )

WINSOCKET 编程，求代码？

WINSOCKET 编程，求代码？

www.51merit.com
上有！！！
全部 20+20=40 RMB

QQ:42872272

1.TCP的例子：
===============================================================================
{--------------------------------------------------------------
Simple Example.
Implement TCP(both Client and Server) with Socket API
<zw84611@sina.com>
--------------------------------------------------------------}

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
WinSock, StdCtrls;

const
WM_SOCK = WM_USER + 1; //自定义windows消息
TCP_PORT = 5432; //设定TCP端口号

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
HasConnected, IsServer: boolean;
CliSocket, SvrSocket: integer;
SvrAddrIn, CliAddrIn:TSockAddrIn;
procedure InitSocket;
procedure SendData(Content: string);
procedure ReadData(var Message: TMessage); message WM_SOCK;
procedure SockConnect;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.InitSocket;
var
wsadata: TWsadata;
err{, optval}: integer;
begin

WSAStartup($0101,WSAData);

CliSocket := socket(AF_INET, SOCK_STREAM,IPPROTO_IP);
SvrSocket := socket(AF_INET, SOCK_STREAM,IPPROTO_IP);

if (CliSocket = INVALID_SOCKET)or(SvrSocket = INVALID_SOCKET) then
begin
ShowMessage(inttostr(WSAGetLastError())+' Socket创建失败');
CloseSocket(CliSocket);
exit;
end;

SvrAddrIn.sin_addr.s_addr:= INADDR_ANY;
SvrAddrIn.sin_family := AF_INET;
SvrAddrIn.sin_port :=htons(TCP_PORT);
Bind(SvrSocket, SvrAddrIn, sizeof(SvrAddrIn));

err := Listen(SvrSocket,5);
if err<>0 then ShowMessage('Listen error.');

{optval := 1;
if SetSockopt(SvrSocket,SOL_SOCKET,SO_REUSEADDR,pchar(@optval),sizeof(optval)) = SOCKET_ERROR then
begin
showmessage('SO_REUSEADDR set error.');
end; }

//绑定消息映射
WSAAsyncSelect(SvrSocket, Handle , WM_SOCK, FD_READ or FD_ACCEPT or FD_CONNECT or FD_WRITE or FD_CLOSE);
WSAAsyncSelect(CliSocket, Handle , WM_SOCK, FD_READ or FD_ACCEPT or FD_CONNECT or FD_WRITE or FD_CLOSE);

end;

procedure TForm1.SockConnect;
var
err: integer;
begin

CliAddrIn.sin_addr.s_addr:=inet_addr(PChar(Edit1.Text));
CliAddrIn.sin_family := AF_INET;
CliAddrIn.sin_port :=htons(TCP_PORT);
repeat
err:=connect(CliSocket,CliAddrIn, SizeOf(CliAddrIn));
if err = -1 then
begin
{ if we use WSAAsyncSelect(CliSocket...) in order to receive data at
Client side, here will get error, but it still works. why?
}
//ShowMessage('connect error.');
//ListBox1.Items.Add('connect error.');
HasConnected := false;
break;
end
else
begin
HasConnected := true;
IsServer := false;
end;
until err=0;

end;

procedure TForm1.SendData(Content: string);
begin
Send(CliSocket,Content[1],length(Content),0);
end;

procedure TForm1.ReadData(var Message: TMessage);
var
Event: word;
Buf:array[0..1023] of char;
AddrLen, DataLen: integer;
begin
//
AddrLen := sizeof(SvrAddrIn);
Event := WSAGetSelectEvent(Message.LParam);
//FillChar(SvrAddrIn,AddrLen,0);

case Event of
FD_CONNECT:
begin
ListBox1.Items.Add('connect');
HasConnected := true;
//do nothing?
end;
FD_ACCEPT:
begin
IsServer := true;
HasConnected := true;
ListBox1.Items.Add('accept');
//CloseSocket(CliSocket);
CliSocket := Accept(SvrSocket,@SvrAddrIn,@AddrLen);
ListBox1.Items.Add(format(' port:%d, addr:%s',[SvrAddrIn.sin_port,
inet_ntoa(SvrAddrIn.sin_addr)]));
end;
FD_READ:
begin
DataLen := Recv(CliSocket,Buf,1024,0);
buf[DataLen] := #0;
ListBox1.Items.Add(Buf);
{DataLen := RecvFrom(CliSocket,Buf,sizeof(buf),0,CliAddrIn,AddrLen);
ListBox1.Items.Add(format(' port:%d, addr:%s',[CliAddrIn.sin_port,
inet_ntoa(CliAddrIn.sin_addr)])+strpas(buf));}
end;
FD_WRITE:
begin
ListBox1.Items.Add('write');
end;
FD_OOB:
begin
ListBox1.Items.Add('FD_OOB');
end;
FD_CLOSE:
begin
HasConnected := false;
ListBox1.Items.Add('close');
end;
end; //end of case
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
//202.104.32.230
if (not IsServer)and(not HasConnected) then SockConnect;
SendData('hello, world');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CloseSocket(SvrSocket);
CloseSocket(CliSocket);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
HasConnected := false;
IsServer := false;
InitSocket;
end;

end.


2.UDP的例子：
===============================================================================
unit udp;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, winsock,
StdCtrls;

const
WM_SOCK = WM_USER + 1; //自定义windows消息
UDPPORT = 646; //设定UDP端口号

type
Tfrmmain = class(TForm)
Button1: TButton;
Edit1: TEdit;
Memo1: TMemo;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
s: TSocket;
addr: TSockAddr;
FSockAddrIn : TSockAddrIn;
//利用消息实时获知UDP消息
procedure ReadData(var Message: TMessage);
message WM_SOCK;
public
{ Public declarations }
procedure SendData(Content: String);
end;

var
frmmain: Tfrmmain;

implementation

{$R *.DFM}

procedure Tfrmmain.FormCreate(Sender: TObject);
var
TempWSAData: TWSAData;
//optval: integer;
begin
// 初始化SOCKET
if WSAStartup($101, TempWSAData)=1 then
showmessage('StartUp Error!');

s := Socket(AF_INET, SOCK_DGRAM, 0);
if (s = INVALID_SOCKET) then //Socket创建失败
begin
showmessage(inttostr(WSAGetLastError())+' Socket创建失败');
CloseSocket(s);
// exit;
end;
//发送方SockAddr绑定
addr.sin_family := AF_INET;
addr.sin_addr.S_addr := INADDR_ANY;
addr.sin_port := htons(UDPPORT);
if Bind(s, addr, sizeof(addr)) <> 0 then
begin
showmessage('bind fail');
end;
{optval:= 1;
if setsockopt(s,SOL_SOCKET,SO_BROADCAST,pchar(@optval),sizeof(optval)) = SOCKET_ERROR then
begin
showmessage('无法进行UDP广播');
end;}
WSAAsyncSelect(s, frmmain.Handle , WM_SOCK, FD_READ);
//接收端SockAddrIn设定
FSockAddrIn.SIn_Family := AF_INET;
FSockAddrIn.SIn_Port := htons(UDPPORT);
label3.Caption := '端口：'+inttostr(UDPPORT);
end;

procedure Tfrmmain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CloseSocket(s);
end;

procedure Tfrmmain.ReadData(var Message: TMessage);
var
buffer: Array [1..4096] of char;
len: integer;
flen: integer;
Event: word;
value: string;
begin
flen:=sizeof(FSockAddrIn);
FSockAddrIn.SIn_Port := htons(UDPPORT);
Event := WSAGetSelectEvent(Message.LParam);
if Event = FD_READ then
begin
len := recvfrom(s, buffer, sizeof(buffer), 0, FSockAddrIn, flen);
value := copy(buffer, 1, len);
Memo1.Lines.add(value)
end;
end;

procedure Tfrmmain.SendData(Content: String);
var
value{,hostname}: string;
len: integer;
begin

FSockAddrIn.SIn_Addr.S_addr := inet_addr(pchar(Edit1.text)); //INADDR_BROADCAST; //INADDR_BROADCAST = -1 ?
value := Content;
len := sendto(s, value[1], Length(value), 0, FSockAddrIn, sizeof(FSockAddrIn));
if (WSAGetLastError() <> WSAEWOULDBLOCK) and (WSAGetLastError() <> 0) then
showmessage(inttostr(WSAGetLastError()));
if len = SOCKET_ERROR then
showmessage('send fail');
if len <> Length(value) then
showmessage('Not Send all');
end;

procedure Tfrmmain.Button1Click(Sender: TObject);
begin
senddata(Edit2.text);
end;

end.

3. UDP广播的例子：
================================================================================

unit udp;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, winsock,
StdCtrls;

const
WM_SOCK = WM_USER + 1; //自定义windows消息
UDPPORT = 6543; //设定UDP端口号

type
Tfrmmain = class(TForm)
Button1: TButton;
Edit1: TEdit;
Memo1: TMemo;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
s: TSocket;
addr: TSockAddr;
FSockAddrIn : TSockAddrIn;
//mreq:ip_mreq;
//利用消息实时获知UDP消息
procedure ReadData(var Message: TMessage); message WM_SOCK;
public
{ Public declarations }
procedure SendData(Content: String);
end;

var
frmmain: Tfrmmain;

implementation

{$R *.DFM}

procedure Tfrmmain.FormCreate(Sender: TObject);
var
TempWSAData: TWSAData;
optval: integer;
begin
// 初始化SOCKET
if WSAStartup($101, TempWSAData)=1 then
showmessage('StartUp Error!');

s := Socket(AF_INET, SOCK_DGRAM, 0);
if (s = INVALID_SOCKET) then //Socket创建失败
begin
showmessage(inttostr(WSAGetLastError())+' Socket创建失败');
CloseSocket(s);
//exit;
end;
//发送方SockAddr绑定
addr.sin_family := AF_INET;
addr.sin_addr.S_addr := INADDR_ANY;
addr.sin_port := htons(UDPPORT);
if Bind(s, addr, sizeof(addr)) <> 0 then
begin
showmessage('bind fail');
end;

optval:= 1;
if setsockopt(s,SOL_SOCKET,SO_BROADCAST,pchar(@optval),sizeof(optval)) = SOCKET_ERROR then
begin
showmessage('无法进行UDP广播');
end;

WSAAsyncSelect(s, frmmain.Handle , WM_SOCK, FD_READ);
//接收端SockAddrIn设定
FSockAddrIn.SIn_Family := AF_INET;
FSockAddrIn.SIn_Port := htons(UDPPORT);

label3.Caption := '端口：'+inttostr(UDPPORT);
end;

procedure Tfrmmain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CloseSocket(s);
end;

procedure Tfrmmain.ReadData(var Message: TMessage);
var
buffer: Array [1..4096] of char;
len: integer;
flen: integer;
Event: word;
value: string;
begin
flen:=sizeof(FSockAddrIn);
FSockAddrIn.SIn_Port := htons(UDPPORT);
Event := WSAGetSelectEvent(Message.LParam);
if Event = FD_READ then
begin
len := recvfrom(s, buffer, sizeof(buffer), 0, FSockAddrIn, flen);
value := copy(buffer, 1, len);
Memo1.Lines.add(value)
end;
end;

procedure Tfrmmain.SendData(Content: String);
var
value{,hostname}: string;
len: integer;
begin
FSockAddrIn.SIn_Addr.S_addr := INADDR_BROADCAST;
//FSockAddrIn.SIn_Addr.S_addr := inet_addr(pchar(Edit1.text)); //INADDR_BROADCAST; //INADDR_BROADCAST = -1 ?
value := Content;
len := sendto(s, value[1], Length(value), 0, FSockAddrIn, sizeof(FSockAddrIn));
if (WSAGetLastError() <> WSAEWOULDBLOCK) and (WSAGetLastError() <> 0) then
showmessage(inttostr(WSAGetLastError()));
if len = SOCKET_ERROR then
showmessage('send fail');
if len <> Length(value) then
showmessage('Not Send all');
end;

procedure Tfrmmain.Button1Click(Sender: TObject);
begin
senddata(Edit2.text);
end;

end.

4.UDP多播的例子：
===============================================================================
unit udp;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, winsock,
StdCtrls;

const
WM_SOCK = WM_USER + 1; //自定义windows消息
UDPPORT = 6543; //设定UDP端口号

//D类地址224.0.0.0 - 239.255.255.255
//若为224.0.0.1则本机也能收到，否则本机收不到，其它机器能收到。
MY_GROUP = '224.0.0.2';


(*
* Argument structure for IP_ADD_MEMBERSHIP and IP_DROP_MEMBERSHIP.
* Delphi5自带的winsock.pas中没有ip_mreq的定义。
*)

type
ip_mreq = record
imr_multiaddr: in_addr; (* IP multicast address of group *)
imr_interface: in_addr; (* local IP address of interface *)
end;
TIpMReq = ip_mreq;
PIpMReq = ^ip_mreq;

type
Tfrmmain = class(TForm)
Button1: TButton;
Edit1: TEdit;
Memo1: TMemo;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
s: TSocket;
addr: TSockAddr;
FSockAddrIn : TSockAddrIn;
mreq:ip_mreq;
//利用消息实时获知UDP消息
procedure ReadData(var Message: TMessage); message WM_SOCK;
public
{ Public declarations }
procedure SendData(Content: String);
end;

var
frmmain: Tfrmmain;

implementation

{$R *.DFM}

procedure Tfrmmain.FormCreate(Sender: TObject);
var
TempWSAData: TWSAData;
//optval: integer;
begin
Edit1.Text := MY_GROUP;
// 初始化SOCKET
if WSAStartup($101, TempWSAData)=1 then
showmessage('StartUp Error!');

s := Socket(AF_INET, SOCK_DGRAM, 0);
if (s = INVALID_SOCKET) then //Socket创建失败
begin
showmessage(inttostr(WSAGetLastError())+' Socket创建失败');
CloseSocket(s);
//exit;
end;
//发送方SockAddr绑定
addr.sin_family := AF_INET;
addr.sin_addr.S_addr := INADDR_ANY;
addr.sin_port := htons(UDPPORT);
if Bind(s, addr, sizeof(addr)) <> 0 then
begin
showmessage('bind fail');
end;

{optval:= 1;
if setsockopt(s,SOL_SOCKET,SO_BROADCAST,pchar(@optval),sizeof(optval)) = SOCKET_ERROR then
begin
showmessage('无法进行UDP广播');
end;}

mreq.imr_multiaddr.S_addr := inet_addr(pchar(MY_GROUP));//htonl(INADDR_ALLHOSTS_GROUP);
mreq.imr_interface.S_addr := htonl(INADDR_ANY);
if setsockopt(s,IPPROTO_IP,IP_ADD_MEMBERSHIP,pchar(@mreq),sizeof(mreq)) = SOCKET_ERROR then
begin
showmessage('无法进行UDP组播');
end;


WSAAsyncSelect(s, frmmain.Handle , WM_SOCK, FD_READ);
//接收端SockAddrIn设定
FSockAddrIn.SIn_Family := AF_INET;
FSockAddrIn.SIn_Port := htons(UDPPORT);

label3.Caption := '端口：'+inttostr(UDPPORT);
end;

procedure Tfrmmain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CloseSocket(s);
end;

procedure Tfrmmain.ReadData(var Message: TMessage);
var
buffer: Array [1..4096] of char;
len: integer;
flen: integer;
Event: word;
value: string;
begin
flen:=sizeof(FSockAddrIn);
Event := WSAGetSelectEvent(Message.LParam);
if Event = FD_READ then
begin
len := recvfrom(s, buffer, sizeof(buffer), 0, FSockAddrIn, flen);
value := copy(buffer, 1, len);
Memo1.Lines.add(value)
end;
end;

procedure Tfrmmain.SendData(Content: String);
var
value{,hostname}: string;
len: integer;
begin
//FSockAddrIn.SIn_Addr.S_addr := INADDR_BROADCAST;
FSockAddrIn.SIn_Addr.S_addr := inet_addr(pchar(MY_GROUP));
value := Content;
len := sendto(s, value[1], Length(value), 0, FSockAddrIn, sizeof(FSockAddrIn));
if (WSAGetLastError() <> WSAEWOULDBLOCK) and (WSAGetLastError() <> 0) then
showmessage(inttostr(WSAGetLastError()));
if len = SOCKET_ERROR then
showmessage('send fail');
if len <> Length(value) then
showmessage('Not Send all');
end;

procedure Tfrmmain.Button1Click(Sender: TObject);
begin
senddata(Edit2.text);
end;

end.

5. FTP断点续传的简单例子：
================================================================================
{--------------------------------------------------------------
Simple Example.
Implement simple FTP client with Socket API
FTP下载文件，支持断点序传
<zw84611@sina.com>
--------------------------------------------------------------}

unit FtpDownloadThread;

interface

uses
Windows, Messages, SysUtils, Classes, WinSock;

const
TCP_PORT = 21; //设定TCP端口号

type
TFtpStatus = class(TObject)
Content: string;
end;

TFtpDownloadThread = class(TThread)
private
SvrAddr, FilePath: string;
CmdSocket, DatSocket: integer;
CmdAddrIn, DatAddrIn: TSockAddrIn;
DatAddr: string;
DatPort: WORD;
Status: TFtpStatus;
procedure SendCmd(Content: string);
procedure RecvReply(var Buf: array of char);
public
FtpUrl: string;
LocalFile: string;
OnStatusEvent: TNotifyEvent;
procedure Execute; override;
procedure ShowStatus;
end;


implementation

{
in: url: 'ftp://x.x.x.x/aabb/ccdd/c.txt'
out: FptSvr: x.x.x.x
out: FtpDir: /aabb/ccdd/c.txt
}
procedure FtpUrl2AddrPath(url: string; var FtpSvr, FilePath: string);
var
s: string;
i: integer;
begin
s := url;
delete(s, 1, 6);
i := pos('/', s);
if i = 0 then
begin
FtpSvr := s;
FilePath := '';
end
else
begin
FtpSvr := copy(s, 1, i-1);
delete(s, 1, i-1);
FilePath := s;
end;
end;

function GetCode(s: string): string;
var
i: integer;
begin
i := pos(' ', s);
result := copy(s, 1, i-1);
end;

{
get ip addr and tcp port from PASV reply
}
procedure GetDatSocketAddrPort(str: string; var Addr: string; var Port: WORD);
var
sl: TStringList;
s: string;
i: integer;
begin

i := pos('(', str);
s := Copy(str, i+1, length(str));
str := s;
i := pos(')', str);
s := Copy(str, 1, i-1);

sl := TStringList.Create;
sl.CommaText := s;
Addr := sl[0] + '.' + sl[1] + '.' + sl[2] + '.' + sl[3];
Port := strtoint(sl[4])*256 + strtoint(sl[5]);
sl.Free;
end;

{
get file size from RETR reply
}
function GetRemoteSize(str: string): integer;
var
i: integer;
s: string;
begin
i := pos('(', str);
s := Copy(str, i+1, length(str));
str := s;
i := pos(')', str);
s := Copy(str, 1, i-1);

i := pos(' ', s);
str := copy(s, 1, i-1);
result := strtoint(str);
end;

procedure TFtpDownloadThread.Execute;
var
WsaData: TWsadata;
err, len: integer;
Buf: array[0..1023] of char;

fo : TFileStream;
FileExist: boolean;
LocalSize, RemoteSize: integer;
begin

FtpUrl2AddrPath(FtpUrl, SvrAddr, FilePath);
Status := TFtpStatus.Create;

WSAStartup($0101,WSAData);

CmdSocket := socket(AF_INET, SOCK_STREAM,IPPROTO_IP);

if (CmdSocket = INVALID_SOCKET) then
begin
Windows.MessageBox(0, pchar(inttostr(WSAGetLastError())+' Socket创建失败'), '错误', mb_ok);
CloseSocket(CmdSocket);
exit;
end;

CmdAddrIn.sin_addr.s_addr:=inet_addr(PChar(SvrAddr));
CmdAddrIn.sin_family := AF_INET;
CmdAddrIn.sin_port :=htons(TCP_PORT);
err:=connect(CmdSocket,CmdAddrIn, SizeOf(CmdAddrIn));

RecvReply(Buf);

SendCmd('USER anonymous');
RecvReply(Buf);
if GetCode(buf) <> '331' then exit;

SendCmd('PASS usr@anonymous.com');
RecvReply(Buf);
if GetCode(buf) <> '230' then exit;

SendCmd('TYPE I');
RecvReply(Buf);
if GetCode(buf) <> '200' then exit;

SendCmd('PASV');
RecvReply(Buf);
if GetCode(buf) <> '227' then exit;

GetDatSocketAddrPort(buf, DatAddr, DatPort);
DatSocket := socket(AF_INET, SOCK_STREAM,IPPROTO_IP);
DatAddrIn.sin_addr.s_addr:=inet_addr(PChar(DatAddr));
DatAddrIn.sin_family := AF_INET;
DatAddrIn.sin_port := htons(DatPort);
err := connect(DatSocket,DatAddrIn, SizeOf(DatAddrIn));

LocalSize := 0;
FileExist := FileExists(LocalFile);
if FileExist then
begin
fo := TFileStream.Create(LocalFile, fmOpenReadWrite);
fo.Position:=fo.size;
LocalSize := fo.size;
end;

repeat
SendCmd('REST '+inttostr(LocalSize));
RecvReply(Buf);
if GetCode(buf) <> '350' then exit;

SendCmd('RETR '+FilePath);
RecvReply(Buf);
until (GetCode(buf) = '150');

RemoteSize := GetRemoteSize(buf);

if not FileExist then
begin
fo := TFileStream.Create(LocalFile, fmCreate);
end;

while true do
begin
len := Recv(DatSocket, Buf, 1024, 0);
if len < 1 then break;
fo.WriteBuffer(buf[0], len);

Status.Content := '>>'+inttostr(fo.Position)+'/'+inttostr(RemoteSize);
Synchronize(ShowStatus);
end;

fo.Free;

Status.Content := '>>Complete!';
Synchronize(ShowStatus);

CloseSocket(CmdSocket);
CloseSocket(DatSocket);
Status.Free;

end;

procedure TFtpDownloadThread.ShowStatus;
begin
if assigned(OnStatusEvent) then OnStatusEvent(Status);
end;

procedure TFtpDownloadThread.SendCmd(Content: string);
begin
Content := Content +#13+#10;
Send(CmdSocket, Content[1], length(Content), 0);

Status.Content := '>' + Content;
Synchronize(ShowStatus);
end;

procedure TFtpDownloadThread.RecvReply(var Buf: array of char);
var
len: integer;
begin
len := Recv(CmdSocket, Buf, 1024, 0);
Buf[len] := #0;

Status.Content := Buf;
Synchronize(ShowStatus);
end;

end.

6. 递归搜索FTP所有目录的例子：
================================================================================
{-------------------------------------------------------------------------------
Browse FTP files
This is not a vcl component, it's just a unit, needn't install.
-------------------------------------------------------------------------------}

unit FtpBrowse;

interface

uses
Windows, WinInet, ComCtrls, Classes, SysUtils, Dialogs;

type
TFtpBrowseThread=class(TThread)
private
{ Private declarations }
FtpHandle, InetHandle: HINTERNET;
//DirList: TStringList;
//Dir: string;
//FindHandle : HInternet;
//FindData : TWin32FindData;
FileName: string;
//DirName: string;
procedure Execute; override;
procedure OpenFailed;
procedure EndOfBrowse;
procedure GetFindData(Dir: string);
procedure AddItem;
function GetCurDirName: string;
public
{ Public declarations }
ProxyName, ProxyPass: LPCSTR;
FtpSvr, UsrName, PassWord: string;
constructor Create(Proxy_Name, Proxy_Pass: LPCSTR; Ftp_Svr, Usr_Name, Pass_Word: string);
destructor Destroy; override;
end;

implementation
uses Unit1;

procedure TFtpBrowseThread.GetFindData(Dir: string);
var
//TemNode: TTreeNode;
//FileName: string;
FindData : TWin32FindData;
FindHandle : HInternet;
DirList: TStringList;
i: integer;
b, bb: boolean;
begin

DirList := TStringList.Create;

FindHandle := FtpFindFirstFile(FtpHandle, pchar('*.*'), FindData, 0, 0);
if FindHandle <> nil then
if FindData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY then
begin
FileName := FindData.CFileName;

if (FileName <> '.') and (FileName <> '..') then
begin
DirList.Add(FileName);

FileName := Dir + '/' + FileName + '/';
synchronize(AddItem);
end;
end
else
begin
FileName := Dir + '/' + FindData.CFileName;
synchronize(AddItem);
end;

while InternetFindNextFile(FindHandle, @FindData) do
if FindData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY then
begin
FileName := FindData.CFileName;

if (FileName <> '.') and (FileName <> '..') then
begin
DirList.Add(FileName);

FileName := Dir + '/' + FileName + '/';
synchronize(AddItem);
end;
end
else
begin
FileName := Dir + '/' + FindData.CFileName;
synchronize(AddItem);
end;

InternetCloseHandle(Findhandle);

for i:=0 to (DirList.Count-1) do
begin
b := false;
while (not b) do
b := FtpSetCurrentDirectory(FTPHandle, PChar(DirList.Strings));

GetFindData(Trim(Dir) + '/' + DirList.Strings);

bb := false;
while (not bb) do
bb := FtpSetCurrentDirectory(FTPHandle, '..');
end;

DirList.Free;

end;

constructor TFtpBrowseThread.Create(Proxy_Name, Proxy_Pass: LPCSTR; Ftp_Svr, Usr_Name, Pass_Word: string);
begin

ProxyName := Proxy_Name;
ProxyPass := Proxy_Pass;
FtpSvr := Ftp_Svr;
UsrName := Usr_Name;
PassWord := Pass_Word;

FreeOnTerminate := True;
inherited Create(True);

end;

destructor TFtpBrowseThread.Destroy;
begin
//DirList.Free;
end;

procedure TFtpBrowseThread.OpenFailed;
begin
ShowMessage('failed!');
end;

procedure TFtpBrowseThread.AddItem;
begin
Form1.ListBox1.Items.Add(trim(FileName));
//Form1.ListBox1.Items.Add(trim(GetCurDirName) + '/' + trim(FileName));
end;

function TFtpBrowseThread.GetCurDirName: string;
var
len: DWORD;
Dir: string;
begin
len := 0;
FtpGetCurrentDirectory(FtpHandle, PChar(Dir), len);
SetLength(Dir, len);
FtpGetCurrentDirectory(FtpHandle, PChar(Dir), len);
result := Dir;
end;

procedure TFtpBrowseThread.EndOfBrowse;
begin
//MyTree.Color := 2555;
//FileList.Add('---');
//Form1.ListBox1.Items.Assign(FileList);
Form1.ListBox1.Items.Add('------');
end;

procedure TFtpBrowseThread.Execute;
var
len: DWORD;

//FindData : TWin32FindData;
//FindHandle : HInternet;
Dir: string;
begin

InetHandle := InternetOpen('TFtpBrowse', 0, ProxyName, ProxyPass, 0);

if InetHandle = nil then
begin
synchronize(OpenFailed);
exit;
end;

FtpHandle := InternetConnect(InetHandle, PChar(FtpSvr),
0,
PChar(UsrName),
PChar(PassWord),
INTERNET_SERVICE_FTP,
0,
255
);

if FtpHandle = nil then
begin
synchronize(OpenFailed);
exit;
end;

if FtpHandle <> nil then
begin

len := 0;
FtpGetCurrentDirectory(FtpHandle, PChar(Dir), len);
SetLength(Dir, len);
FtpGetCurrentDirectory(FtpHandle, PChar(Dir), len);

//Caption := Dir;


//-----------------------
{FindHandle := FtpFindFirstFile(FtpHandle, '*.*', FindData, 0, 0);
if FindHandle = nil then
begin
synchronize(OpenFailed);
exit;
end;}

GetFindData(Trim(Dir));

{while InternetFindNextFile(FindHandle,@FindData) do
begin
GetFindData(FindData);
end;}

//InternetCloseHandle(Findhandle);

synchronize(EndOfBrowse);

end;

end;

end.

问题太广了吧。
如果是一点都不懂，那你去看书吧！

看《TCP/IP》如果觉得麻烦，太难懂了就看《WINDOWS网络编程技术》。

[][]