delphi 自带的TIdFtpServer和TIdFtpClient组件，在实际应用中发现，只能单线程传输较小的文件。有很大局限性。决定自己写一个文件传输系统。该传输系统经测试，可以同时传输100个文件以上，超过4G大小的文件，支持断点续传。同时支持对文件夹的压缩传输。基本满足业务的要求。现在把服务器端和客户端代码粘贴如下：
一、客户端
1、传输单元
unit uTransFileClient;
interface
uses windows,graphics,classes,zip,uSocket,uStr,uConfig;
const
MAXPATH=260;
MAXBUF=8192;
CMD_FILE_LIST=4001;//列举目录；传递绝对路径；
CMD_FILE_TRANS=4002;//文件传输
CMD_FILE_DEL=4003;//删除文件
wm_user=$0400;
wm_TransData=wm_user+100+1;
type
TAPIFlag=(Fstart,Frecv,Fsend,Fend);
TThreadType=(FListFile,FTransFile);
pTransFilesInfo=^stTransFilesInfo;
stTransFilesInfo=packed record
server:stSvrAddr;
clientFile:array[0..MAX_PATH-1] of ansiChar;
serverFile:array[0..MAX_PATH-1] of ansiChar;
bUpLoad:bool;
bFolder:bool;
bCompleteDel:bool;
aAPI:TAPIFlag;
transed:cardinal;
FileSize:cardinal;
threadId:integer;
end;
pRequestFileInfo=^stRequestFileInfo;
stRequestFileInfo=packed record
fileName:array[0..MAX_PATH-1] of ansiChar;
bUpLoad:bool;
end;//
pRecvData=^stRecvData;
stRecvData=packed record
server:stSvrAddr;
data:pointer;
dataSize:integer;
end;
pListFile=^stListFile;
stListFile=packed record
server:stSvrAddr;
filename:array[0..MAX_PATH-1] of ansiChar;
data:pointer;
dataSize:integer;
end;
function TransFilesClientThread(pTransFilesPara:pointer):BOOL;stdcall;
function TransFileClientThread(pTransFilePara:pointer):bool;stdcall;
procedure ProcessTransFile(const LocalFilename,RemoteFilename:ansiString;bUpload:boolean);overload;
procedure ProcessTransFile(const LocalFilename,RemoteFilename:ansiString;bUpload:boolean;threadId:integer);overload;
procedure initAddr();
procedure uploadFile(const LocalFilename,RemoteFilename:ansiString);
procedure downloadFile(const LocalFilename,RemoteFilename:ansiString);overload;
procedure downloadFile(const LocalFilename,RemoteFilename:ansiString;threadId:integer);overload;
function ListFileThread():bool;stdcall;
procedure ProcessListFile();
var
DataSvrAddr:stSvrAddr;
gFileList:ansiString;
hForm:THANDLE;
implementation
procedure ProcessListFile();
var
hd,id:cardinal;
begin
gFileList:='';
hd:=createthread(nil,0,@ListFileThread,nil,0,id);
closehandle(hd);
end;
function ListFileThread():bool;stdcall;
var
hSocket:integer;
oh:stOrderHeader;
begin
result:=false;
try
if not ConnectServer(hSocket,DataSvrAddr) then exit;
formatOH(oh);oh.cmd:=CMD_FILE_LIST;
SendBuf(hSocket,@oh,sizeof(oh));
//SendBuf(hSocket,@pList^.filename[0],MAX_PATH);
if not RecvBuf(hSocket,@oh,sizeof(oh)) then exit;
if(oh.len<=0)then exit;
setlength(gFileList,oh.len);
if not RecvBuf(hSocket,@gFileList[1],oh.len) then exit;
finally
SendMessage(hform,wm_TransData,integer(FListFile),0);
FreeSocket(hSocket);
end;
end;
procedure uploadFile(const LocalFilename,RemoteFilename:ansiString);
begin
ProcessTransFile(LocalFilename,RemoteFilename,true);
end;
procedure downloadFile(const LocalFilename,RemoteFilename:ansiString);
var
uploadfile:string;
begin
uploadfile:='\upload\'+RemoteFilename;
ProcessTransFile(LocalFilename,uploadfile,false);
end;
procedure downloadFile(const LocalFilename,RemoteFilename:ansiString;threadId:integer);
var
uploadfile:string;
begin
uploadfile:='\upload\'+RemoteFilename;
ProcessTransFile(LocalFilename,uploadfile,false,threadId);
end;
procedure ProcessTransFile(const LocalFilename,RemoteFilename:ansiString;bUpload:boolean;threadId:integer);
var
pTF:pTransFilesInfo;
hd,id:cardinal;
begin
new(pTF);
zeromemory(pTF,sizeof(stTransFilesInfo));
strcopy(pTF^.clientFile,pansichar(LocalFilename));
strcopy(pTF^.serverFile,pansichar(RemoteFilename));
pTF^.bUpLoad:=bUpload;
pTF^.bFolder:=false;
pTF^.bCompleteDel:=false;
pTF^.server:=DataSvrAddr;
pTF^.threadId:=threadId;
hd:=createthread(nil,0,@TransFilesClientThread,pTF,0,id);
closehandle(hd);
end;
procedure ProcessTransFile(const LocalFilename,RemoteFilename:ansiString;bUpload:boolean);
var
pTF:pTransFilesInfo;
hd,id:cardinal;
begin
new(pTF);
zeromemory(pTF,sizeof(stTransFilesInfo));
strcopy(pTF^.clientFile,pansichar(LocalFilename));
strcopy(pTF^.serverFile,pansichar(RemoteFilename));
pTF^.bUpLoad:=bUpload;
pTF^.bFolder:=false;
pTF^.bCompleteDel:=false;
pTF^.server:=DataSvrAddr;
hd:=createthread(nil,0,@TransFilesClientThread,pTF,0,id);
closehandle(hd);
end;
function TransFileClientThread(pTransFilePara:pointer):bool;stdcall;
label 1;
var
pTransFileInfo:pTransFilesInfo;
hSocket:integer;
hFile,FileSize,NumberOfRead,srvFileSize,wLen,fileSizeHigh,srvFileSizeHigh:cardinal;
err,recvLen:integer;
buf:array[0..MAXBUF-1] of ansiChar;
RequestFileInfo:stRequestFileInfo;
bRet:LongBool;
bTransType:byte;
dwAccess,dwCreation,dwAtrr,dwShare:DWORD;
oh:stOrderHeader;
begin
result:=false;
pTransFileInfo:=pTransFilePara;
if pTransFileInfo^.bUpLoad then
begin
dwAccess:=GENERIC_READ;
dwCreation:=OPEN_EXISTING;
dwAtrr:=FILE_ATTRIBUTE_NORMAL;
dwShare:=FILE_SHARE_READ;
end
else begin
dwAccess:=GENERIC_READ or GENERIC_WRITE;
dwCreation:=OPEN_ALWAYS;
dwAtrr:=FILE_ATTRIBUTE_NORMAL or FILE_ATTRIBUTE_ARCHIVE;
dwShare:=FILE_SHARE_DELETE or FILE_SHARE_READ or FILE_SHARE_WRITE;
end;
hFile:=CreateFileA(pTransFileInfo^.clientFile,dwAccess,dwShare,nil,dwCreation,dwAtrr,0);
if (hFile=INVALID_HANDLE_VALUE) then goto 1;
fileSize:=GetFileSize(hFile,@fileSizeHigh);
if (fileSize=$FFFFFFFF) and (GetLastError()<>NO_ERROR) then goto 1;
if pTransFileInfo^.bUpLoad then
begin
if (fileSize=0) and (fileSizeHigh=0) then goto 1;
end;//
if not ConnectServer(hSocket,pTransFileInfo^.server) then goto 1;
strcopy(RequestFileInfo.fileName,pTransFileInfo^.serverFile);
RequestFileInfo.bUpLoad:=pTransFileInfo^.bUpLoad;
//bTransType:=byte(RTransFile);
//SendBuf(hSocket,@bTransType,sizeof(bTransType));
formatOH(oh);oh.cmd:=CMD_FILE_TRANS;oh.len:=sizeof(RequestFileInfo);
SendBuf(hSocket,@oh,sizeof(oh));
SendBuf(hSocket,@RequestFileInfo,sizeof(RequestFileInfo));
if pTransFileInfo^.bUpLoad then
begin
pTransFileInfo^.FileSize:=fileSize;//显示信息用；
SendBuf(hSocket,@fileSize,sizeof(FileSize));
SendBuf(hSocket,@fileSizeHigh,sizeof(fileSizeHigh));
if not RecvBuf(hSocket,@srvFileSize,sizeof(srvFileSize)) then goto 1;
if not RecvBuf(hSocket,@srvFileSizeHigh,sizeof(srvFileSizeHigh)) then goto 1;
SetFilePointer(hFile,srvFileSize,@srvFileSizeHigh,FILE_BEGIN);
pTransFileInfo^.transed:=srvFileSize;//显示信息用；
while true do
begin
bRet:=ReadFile(hFile,buf,sizeof(buf),NumberOfRead,nil);
if bRet=false then goto 1
else if NumberOfRead=0 then begin result:=true;goto 1;end
else begin
if(not SendBuf(hSocket,@buf,NumberOfRead))then goto 1;
pTransFileInfo^.aAPI:=FSend;//显示信息用；
pTransFileInfo^.transed:=pTransFileInfo^.transed+NumberOfRead;//显示信息用；
PostMessage(hform,wm_TransData,integer(FTransFile),integer(pTransFileInfo)); //显示信息用；
end;//send(socket1,buf,NumberOfRead,0);
end;//while
end
else begin
err:=SetFilePointer(hFile,0,nil,FILE_END);
if err=-1 then goto 1;
SendBuf(hSocket,@fileSize,sizeof(fileSize));
SendBuf(hSocket,@fileSizeHigh,sizeof(fileSizeHigh));
pTransFileInfo^.transed:=fileSize;//显示信息用；
while true do
begin
FillChar(buf,SizeOf(buf),0);
recvLen:=RecvNon(hSocket,@buf,sizeof(buf));
if recvLen=0 then result:=true;
if (recvLen=-1) or (recvLen=0) then goto 1;
//revs:=revs+revLen;
if not WriteFile(hFile,Buf,recvLen,wLen,nil) then goto 1;
pTransFileInfo^.aAPI:=FRecv;//显示信息用；
pTransFileInfo^.transed:=pTransFileInfo^.transed+wLen;//显示信息用；
PostMessage(hform,wm_TransData,integer(FTransFile),integer(pTransFileInfo)); //显示信息用
end;//while
end;//not if pTransFileInfo^.upLoad then
1:
CloseHandle(hFile);
FreeSocket(hSocket);
end;
function TransFilesClientThread(pTransFilesPara:pointer):BOOL;stdcall;
var
pTF:pTransFilesInfo;
//err:integer;
//bRet:bool;
lpFindFileData: TWIN32FindDataA;
hFind:Thandle;
//severFile
clientFile:array[0..MAX_PATH-1] of ansiChar;
uniqueStr:array[0..64] of ansiChar;
begin
result:=false;
pTF:=pTransFilesPara;
pTF^.aAPI:=Fstart;
PostMessage(hform,wm_TransData,integer(FTransFile),integer(pTF)); //显示信息用；
if pTF^.bupLoad then
begin
hFind:=findfirstfileA(pTF^.clientFile,lpFindFileData);
if hFind=INVALID_HANDLE_VALUE then exit;
findclose(hFind);
end;
if pTF^.bFolder then
begin
if pTF^.bUpLoad then
begin
GettempPathA(MAXPATH,clientFile);
StrFromTime(UniqueStr);
strcat(clientFile,uniqueStr);
strcat(clientFile,'.dir');
//DirectoryCompression(pTF^.clientFile,clientFile);
TZipFile.ZipDirectoryContents(clientFile,pTF^.clientFile);
strcopy(pTF^.clientFile,clientFile);
strcat(pTF^.serverFile,'.dir');
end
else begin
strcopy(clientFile,pTF^.clientFile);
strcat(pTF^.clientFile,'.dir');
end;
result:=TransFileClientThread(pTF);
if pTF^.bUpLoad then //这儿可以删除上传后的目录
DeleteFileA(pTF^.clientFile)
else begin
//DirectoryDecompression(clientFile,pTF^.clientFile);
TZipFile.ExtractZipFile(pTF^.clientFile, clientFile);
DeleteFileA(pTF^.clientFile);
end;
end
else begin //是文件
result:=TransFileClientThread(pTF);
//如果是上传并且bCompleteDel=true ，删除原文件
if (pTF^.bUpLoad and pTF^.bCompleteDel and result)=true then
DeleteFileA(pTF^.clientFile);
end;
pTF^.aAPI:=Fend;
SendMessage(hform,wm_TransData,integer(FTransFile),integer(pTF));
dispose(pTF);
end;
procedure initAddr();
begin
DataSvrAddr.port:=uConfig.FTS_PORT;
strcopy(DataSvrAddr.IP,pansiChar(uConfig.FTS_HOST));
end;
initialization
initAddr();
finalization
end.2、通讯单元
unit uSocket;
interface
//************************windows定义**************************************
const
user32 = 'USER32.dll';
//-------------------------------------------
//数据传输协议包头：
UID:integer=8888;//包头标识;
VER:integer=1002;
ENC:integer=7620;
CMD_READY:integer=1001;
type
BOOL = LongBool;
DWORD = LongWord;
//************************socket 定义****************************
type
u_int = Integer;
TSocket = u_int;
u_short = Word;
u_char = Char;
u_long = Longint;
const
winsocket = 'WSock32.dll';
SOCKET_ERROR = -1;
INVALID_SOCKET = TSocket(NOT(0));
WSADESCRIPTION_LEN = 256;
WSASYS_STATUS_LEN = 128;
AF_INET = 2;
SOCK_STREAM = 1; { stream socket }
SOL_SOCKET = $ffff; {options for socket level }
SO_LINGER = $0080; { linger on close if data present }
SO_SNDTIMEO = $1005; { send timeout }
SO_RCVTIMEO = $1006; { receive timeout }
WSAECONNRESET =10054;
type
SunB = packed record
s_b1, s_b2, s_b3, s_b4: u_char;
end;
SunW = packed record
s_w1, s_w2: u_short;
end;
PInAddr = ^TInAddr;
in_addr = record
case integer of
0: (S_un_b: SunB);
1: (S_un_w: SunW);
2: (S_addr: u_long);
end;
TInAddr = in_addr;
PSockAddrIn = ^TSockAddrIn;
sockaddr_in = record
case Integer of
0: (sin_family: u_short;
sin_port: u_short;
sin_addr: TInAddr;
sin_zero: array[0..7] of ansiChar);
1: (sa_family: u_short;
sa_data: array[0..13] of ansiChar)
end;
TSockAddrIn = sockaddr_in;
PSOCKADDR = ^TSockAddr;
TSockAddr = sockaddr_in;
PWSAData = ^TWSAData;
WSAData = record // !!! also WSDATA
wVersion: Word;
wHighVersion: Word;
szDescription: array[0..WSADESCRIPTION_LEN] of ansiChar;
szSystemStatus: array[0..WSASYS_STATUS_LEN] of ansiChar;
iMaxSockets: Word;
iMaxUdpDg: Word;
lpVendorInfo: PansiChar;
end;
TWSAData = WSAData;
PHostEnt = ^THostEnt;
{$EXTERNALSYM hostent}
hostent = record
h_name: PansiChar;
h_aliases: ^PansiChar;
h_addrtype: Smallint;
h_length: Smallint;
case Byte of
0: (h_addr_list: ^PansiChar);
1: (h_addr: ^PansiChar)
end;
THostEnt = hostent;
//2006-04-25
linger = record
l_onoff: u_short;
l_linger: u_short;
end;
timeval = record
tv_sec: Longint;
tv_usec: Longint;
end;
//************************我的 定义****************************
type
pSvrAddr=^stSvrAddr;
stSvrAddr=packed record
port:Word;
case flg:byte of
0:(IP:array[0..15] of ansiChar);
1:(DN:array[0..30] of ansiChar);
end;
POrderHeader=^stOrderHeader;
stOrderHeader=packed record
uid:DWORD;
Ver:DWORD;
Enc:DWORD;
id:DWORD;
pid:DWORD;
cmd:DWORD;
len:DWORD;
dat:pointer;
end;
//---------------------------------------------------------
//***********************socket api***********************************
function recv(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
function send(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
function connect(s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall;
function closesocket(s: TSocket): Integer; stdcall;
function WSACleanup: Integer; stdcall;
function socket(af, Struct, protocol: Integer): TSocket; stdcall;
function WSAStartup(wVersionRequired: word; var WSData: TWSAData): Integer; stdcall;
function htons(hostshort: u_short): u_short; stdcall;
function inet_addr(cp: PansiChar): u_long; stdcall; {PInAddr;} { TInAddr }
function gethostbyname(name: PansiChar): PHostEnt; stdcall;
function setsockopt(s: TSocket; level, optname: Integer; optval: PansiChar;
optlen: Integer): Integer; stdcall;
function WSAGetLastError: Integer; stdcall;
//***********************windows api*************************************
procedure ZeroMemory(Destination: Pointer; Length: DWORD);
function wsprintf(Output: PansiChar; Format: PansiChar): Integer; stdcall;
//***********************字符串函数*************************************
function _wsprintf(lpOut: PansiChar; lpFmt: PansiChar; lpVars: Array of Const):Integer; assembler;
//***********************我的函数*****************************************
function InitAddr(sa:stSvrAddr;var addr:sockaddr_in):bool;stdcall;
function HostToIP(hostName:pansiChar):in_addr;stdcall;
function InitSocket(var hSocket:integer):bool;stdcall;
procedure FreeSocket(var hSocket:integer);stdcall; //out
function ConnectServer(var hSocket:integer;sa:stSvrAddr):bool;stdcall; //out
function RecvBuf(hSocket:integer;p:pointer;len:DWORD):bool;stdcall;
function SendBuf(socket:integer;p:pointer;size:DWORD):bool;stdcall;
function GetLocalIP(IP:pansiChar):bool;stdcall;
function RecvNon(hSocket:integer;p:pointer;len:integer):integer;stdcall;
function VerifyOH(oh:stOrderHeader) :boolean;//校验包头;
function formatOH(var oh:stOrderHeader) :stOrderHeader;//格式化包头;
implementation
//***********************windows api*************************************
procedure ZeroMemory(Destination: Pointer; Length: DWORD);
begin
FillChar(Destination^, Length, 0);
end;
function wsprintf; external user32 name 'wsprintfA';
//**********************socket api******************************************
function recv; external winsocket name 'recv';
function send; external winsocket name 'send';
function connect; external winsocket name 'connect';
function closesocket; external winsocket name 'closesocket';
function WSACleanup; external winsocket name 'WSACleanup';
function WSAStartup; external winsocket name 'WSAStartup';
function socket; external winsocket name 'socket';
function htons; external winsocket name 'htons';
function inet_addr; external winsocket name 'inet_addr';
function gethostbyname; external winsocket name 'gethostbyname';
function setsockopt; external winsocket name 'setsockopt';
function WSAGetLastError; external winsocket name 'WSAGetLastError';
//***********************字符串函数*************************************
function _wsprintf(lpOut:pansiChar;lpFmt:pansiChar;lpVars:array of const):integer;assembler;
var
count:integer;
v1,v2:integer;
asm
mov v1,eax
mov v2,edx
mov eax,ecx
mov ecx,[ebp+$08]
inc ecx
mov count,ecx
dec ecx
imul ecx,8
add eax,ecx
mov ecx,count
@@1:
mov edx,[eax]
push edx
sub eax,8
loop @@1
push v2
push v1
call wsprintf
mov ecx,count
imul ecx,4
add ecx,8
add esp,ecx
end;
//*********************我的函数****************************************
function RecvNon(hSocket:integer;p:pointer;len:integer):integer;stdcall;
begin
result:=recv(hSocket,p^,len,0);
end;
function SendBuf(socket:integer;p:pointer;size:DWORD):bool;stdcall;
var
i,len:integer;
pp:pointer;
begin
result:=false;
len:=size;
pp:=p;
while len>0 do
begin
i:=send(socket,pp^,len,0);
//if i=SOCKET_ERROR then exit; 2015-9-5
if (i=SOCKET_ERROR) and (WSAGetLastError = WSAECONNRESET) then exit;
len:=len-i;
pp:=pointer(DWORD(pp)+DWORD(i));
end;//while
result:=true;
end;
function RecvBuf(hSocket:integer;p:pointer;len:DWORD):bool;stdcall;
var
err,k:integer;
pp:pointer;
begin
result:=false;
k:=len;
pp:=p;
while k>0 do
begin
err:=recv(hSocket,pp^,k,0);
if (err=SOCKET_ERROR) or (err=0) then exit; //2015
//if (err=SOCKET_ERROR) or (err=0) then exit;
k:=k-err;
pp:=pointer(dword(pp)+dword(err));
end;
result:=true;
end;
function ConnectServer(var hSocket:integer;sa:stSvrAddr):bool;stdcall;
var
err:integer;
addr:sockaddr_in;
begin
result:=false;
if not InitSocket(hSocket) then exit;
InitAddr(sa,addr);
err:=connect(hSocket,addr,sizeof(addr));//连接
if err<>0 then FreeSocket(hSocket);
result:=err=0;
end;
procedure FreeSocket(var hSocket:integer);stdcall;
begin
if hSocket<>0 then closesocket(hSocket);
//WSACleanup();//终止WS2_32.DLL的使用
hSocket:=0;
end;
{
功能描述:初始化Socket
入口参数:hSocket:Socket句柄
出口参数:返回值:成功创建返回True,否则返回False
创建日期:
修改记录:增加超时时间6分钟
2006-04-25
Author:byc
}
function InitSocket(var hSocket:integer):bool;stdcall;
var
wsadata: TWSAData;
err:integer;
//t:linger;
//timeout: timeval;
tv:longint;
begin
result:=false;
err:=WSAStartup($0202,wsadata);
if err<>0 then
begin //初始化WS2_32.DLL
//showmessage('初始化ws_32.dll失败!');
WSACleanup();//终止WS2_32.DLL的使用
exit;
end;//if
hSocket:=socket(AF_INET, SOCK_STREAM, 0);
//创建socket
if hSocket=INVALID_SOCKET then
begin
//ShowMessage('创建SOCKET失败!');
hSocket:=0;
WSACleanup();
exit;
end;//if socket1=SOCKET_ERROR then
{
t.l_onoff:=1;
t.l_linger:=0;
//关闭socket后立刻释放资源
err:=setsockopt(hSocket,SOL_SOCKET,SO_LINGER,@t,sizeof(t));
if err=SOCKET_ERROR then
begin
FreeSocket(hSocket);
exit;
end;
}
//set recv and send timeout
tv:=6*60*1000;
//tv:=60000;//测试
err:=setsockopt(hSocket,SOL_SOCKET,SO_SNDTIMEO,@tv,sizeof(timeval));
if err=SOCKET_ERROR then
begin
FreeSocket(hSocket);
exit;
end;
err:=setsockopt(hSocket,SOL_SOCKET,SO_RCVTIMEO,@tv,sizeof(timeval));
if err=SOCKET_ERROR then
begin
FreeSocket(hSocket);
exit;
end;
result:=true;
end;
function InitAddr(sa:stSvrAddr;var addr:sockaddr_in):bool;stdcall;
begin
result:=false;
zeromemory(@addr,sizeof(addr));
addr.sin_family:=AF_INET;
addr.sin_port:=htons(sa.port);
case sa.flg of
0:begin
addr.sin_addr.S_addr:=inet_addr(sa.IP);
end;//0
1:begin
addr.sin_addr:=HostToIP(sa.DN);
end;//1
end;//case
if addr.sin_addr.S_addr>0 then
result:=true;
end;
function HostToIP(hostName:pansiChar):in_addr;stdcall;
var
hostEnt : PHostEnt;
addr:pansiChar;
err:integer;
wd:wsadata;
begin
err:=WSAStartup($0202,WD);
if err<>0 then exit;
ZeroMemory(@result,sizeof(in_addr));
hostEnt:=gethostbyname (hostName);
if Assigned (hostEnt) then
if Assigned (hostEnt^.h_addr_list) then
begin
addr := hostEnt^.h_addr_list^;
if Assigned (addr) then
begin
result:=PInAddr(addr)^;
end;// if Assigned (addr) then
end;//if Assigned (hostEnt) then
wsacleanup();
end;
function GetLocalIP(IP:pansiChar):bool;stdcall;
var
wd:WSAdata;
err:integer;
phe:PhostEnt;
addr:pansiChar;
b0,b1,b2,b3:byte;
begin
result:=false;
err:=WSAStartup($101,wd);
if err<>0 then begin wsaCleanup;exit;end;
phe:=GetHostByName(nil);
if phe=nil then begin wsaCleanup;exit;end;
addr:=(phe^.h_addr)^;
if addr=nil then begin wsaCleanup;exit;end;
b0:=byte((addr+0)^);b1:=byte((addr+1)^);
b2:=byte((addr+2)^);b3:=byte((addr+3)^);
_wsprintf(IP,'%d.%d.%d.%d',[b0,b1,b2,b3]);
wsaCleanup;
result:=true;
end;
//-------------------------------------------------------------------------
function VerifyOH(oh:stOrderHeader) :boolean;//校验包头;
begin
result:=true;
if(oh.uid<>UID)then result:=false;
if(oh.Ver<>VER)then result:=false;
if(oh.ENC<>ENC)then result:=false;
end;
function formatOH(var oh:stOrderHeader) :stOrderHeader;//格式化包头;
begin
oh.uid:=UID;
oh.Ver:=VER;
oh.Enc:=ENC;
oh.id:=0;
oh.pid:=0;
oh.cmd:=CMD_READY;
oh.len:=0;
oh.dat:=nil;
result:=oh;
end;
//------------------------------------------------------------------
end.3、客户端主线程
unit uMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls,
Vcl.FileCtrl, Vcl.ExtCtrls,strutils,system.zip,IdGlobalProtocols,
uConfig,uLog,uTransFileClient,uDes2010,uFuncs, Vcl.Menus,shellapi;
type
TfMain = class(TForm)
Panel4: TPanel;
Label2: TLabel;
Label1: TLabel;
edtAddr: TEdit;
edtPort: TEdit;
btnUpload: TButton;
btnDownload: TButton;
btnClose: TButton;
Bar1: TStatusBar;
Panel2: TPanel;
Drive1: TDriveComboBox;
Dir1: TDirectoryListBox;
Splitter1: TSplitter;
Panel3: TPanel;
File1: TFileListBox;
edtFile: TEdit;
Splitter2: TSplitter;
Panel1: TPanel;
Splitter3: TSplitter;
ListFileInfo: TListView;
memoInfo: TMemo;
btnList: TButton;
btnSelAll: TButton;
btnDecryptFile: TButton;
lbDir: TLabel;
popDir: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
popFile: TPopupMenu;
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
procedure btnUploadClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure btnDownloadClick(Sender: TObject);
procedure btnListClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnSelAllClick(Sender: TObject);
procedure ListFileInfoColumnClick(Sender: TObject; Column: TListColumn);
procedure btnDecryptFileClick(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure MenuItem1Click(Sender: TObject);
procedure MenuItem2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N2Click(Sender: TObject);
private
{ Private declarations }
procedure TransDataMsg(var msg:TMessage);message wm_TransData;
procedure TryExcepts(Sender: TObject; E: Exception);
procedure parseFileList();
procedure AddList(filesign,filesize:string);
function decryptFilename(filename:string):string;
procedure decryptfile(ss:tstrings);
public
{ Public declarations }
end;
var
fMain: TfMain;
function CustomSortProc(Item1, Item2: TListItem; ColumnIndex: integer): integer; stdcall;
function cryptfile(filedir:string):ansiString;
//联系QQ：39848872微信：byc6352
implementation
{$R *.dfm}
procedure TfMain.decryptfile(ss:tstrings);
const
FILE_NAME_ID='x';
var
i:integer;
filename,newfilename,newdir:string;
begin
for I := 0 to ss.Count-1 do
begin
filename:=ss[i];
if(filename[length(filename)]<>FILE_NAME_ID)then continue;
if(FileSizeByName(filename)=0)then
begin
deletefile(filename);
continue;
end;
uFuncs.cryptfile(filename);
newfilename:=leftstr(filename,length(filename)-1);
newfilename:=extractfilepath(newfilename)+uDes2010.DecryStrHex(extractfilename(newfilename),uConfig.key);
movefile(pchar(filename),pchar(newfilename));
newdir:=leftstr(newfilename,length(newfilename)-4);
if(TZipFile.IsValid(newfilename))then
begin
TZipFile.ExtractZipFile(newfilename, newdir);
deletefile(newfilename);
end else begin
memoInfo.Lines.Add('解压失败：'+newfilename);
//showmessage('解压失败：'+newfilename);
end;
//uzip.DirectoryDecompression(newdir,newfilename);
end;
end;
//'c:\temp\0310\2'
function cryptfile(filedir:string):ansiString;
var
filename:array[0..MAX_PATH-1] of ansiChar;
filesize:array[0..31] of ansiChar;
wfd:WIN32_FIND_DATAA;
hFindFile:THANDLE;
newfilename,newdir:ansistring;
begin
result:='';
strcopy(filename,pansichar(ansiString(filedir)));
strcat(filename,pansichar('\*'));
hFindFile:=FindFirstFileA(filename,wfd);
if hFindFile=INVALID_HANDLE_VALUE then exit;
while(FindNextFileA(hFindFile,wfd))do
begin
if(wfd.cFileName[0]='.')then continue;
if(wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)<>0 then continue;
//uFuncs.cryptfile(filedir+'\'+wfd.cFileName);
newfilename:=filedir+'\'+wfd.cFileName;
newdir:=leftstr(newfilename,length(newfilename)-4);
if(TZipFile.IsValid(newfilename))then
begin
try
TZipFile.ExtractZipFile(newfilename, newdir);
except
fmain.memoInfo.Lines.Add('解压失败1：'+newfilename);
end;
deletefile(newfilename);
end else begin
fmain.memoInfo.Lines.Add('解压失败：'+newfilename);
//showmessage('解压失败：'+newfilename);
end;
end;
Winapi.Windows.FindClose(hFindFile);
end;
function TfMain.decryptFilename(filename:string):string;
const
FILE_NAME_ID='x';
var
i:integer;
newfilename,newdir:string;
begin
result:=filename;
try
if(filename[length(filename)]<>FILE_NAME_ID)then exit;
newfilename:=leftstr(filename,length(filename)-1);
newfilename:=uDes2010.DecryStrHex(newfilename,uConfig.key);
result:=newfilename;
finally
end;
end;
procedure TfMain.AddList(filesign,filesize:string);
var
item:tListitem;
begin
item:=ListFileInfo.Items.Add;
item.Caption:=filesign;
item.SubItems.Add(decryptFilename(filesign));
item.SubItems.Add(filesize);
item.SubItems.Add('');
item.ImageIndex:=8;
end;
procedure TfMain.parseFileList();
var
filelist,fileinfo:tstrings;
i:integer;
filename,info:string;
begin
if gFileList='' then exit;
ListFileInfo.Clear;
try
filelist:=tstringlist.Create;
fileinfo:=tstringlist.Create;
if gFileList[length(gFileList)]=';' then delete(gFileList,length(gFileList),1);
if(rightstr(gFileList,2)=#13#10) then leftstr(gFileList,length(gFileList)-2);
fileList.Text:=gFileList;
if(fileList.Count=0)then exit;
for I := 0 to fileList.Count-1 do
begin
info:=fileList[i];
fileinfo.Delimiter:=';';
fileinfo.DelimitedText:=info;
AddList(fileinfo[0],fileinfo[1]);
end;
bar1.Panels[0].Text:='共有文件：'+inttostr(filelist.Count);
finally
filelist.Free;
fileinfo.Free;
end;
end;
procedure tFMain.TransDataMsg(var msg:TMessage);
var
threadType:TThreadType;
pTF:pTransFilesInfo;
localfilename,newfilename,localpath:ansiString;
i:integer;
begin
threadType:=TThreadType(msg.WParam);
case threadType of
FListFile:
begin
//memoSms.Lines.Add(gFileList);
parseFileList();
ListFileInfo.CustomSort(@CustomSortProc,0);
end;
FTransFile:
begin
pTF:=pTransFilesInfo(msg.LParam);
if(pTF<>nil)then
begin
localfilename:=pTF^.clientFile;
//memoInfo.lines.add(localfilename);
if(pTF^.aAPI=Fstart)then
begin
memoInfo.lines.add('开始传输：'+localfilename);
bar1.Panels[0].Text:='开始传输：'+localfilename;
end;
if(pTF^.bUpLoad)then
begin
if pTF^.aAPI=Fsend then
bar1.Panels[0].Text:='正在上传：'+inttostr(pTF^.transed)+'/'+inttostr(pTF^.FileSize);
if pTF^.aAPI=Fend then
begin
btnList.Click();
memoInfo.lines.add('上传完成：'+localfilename);
bar1.Panels[0].Text:='上传完成：'+inttostr(pTF^.transed)+'/'+inttostr(pTF^.FileSize);
end;
end else begin
i:=ptF^.threadId;
if pTF^.aAPI=FRecv then
begin
listFileInfo.Items[i].SubItems.Strings[2]:=inttostr(pTF^.transed);
bar1.Panels[0].Text:='正在下载：'+inttostr(pTF^.transed);
end;
if pTF^.aAPI=Fend then
begin
localpath:=extractfilepath(localfilename);
{
newfilename:=localpath+decryptFilename(extractfilename(localfilename));
if(newfilename<>localfilename)then
begin
renamefile(localfilename,newfilename);
uFuncs.cryptfile(newfilename);
end;
}
memoInfo.lines.add('下载完成：'+localfilename);
bar1.Panels[0].Text:='下载完成：'+inttostr(pTF^.transed);
listFileInfo.Items[i].SubItems.Strings[2]:='下载完成'+inttostr(pTF^.transed);
file1.Update;
end;
end;
//loadfile(localfilename);
end;
end;
end;
end;
procedure TfMain.TryExcepts(Sender: TObject; E: Exception);
begin
Log(E.Message);
//memoINfo.Lines.Add(Log(E.Message));
//Log(
end;
procedure TfMain.btnCloseClick(Sender: TObject);
begin
close;
end;
procedure TfMain.btnDownloadClick(Sender: TObject);
var
localFilename,remoteFilename:string;
i:integer;
begin
if(ListFileInfo.SelCount=0)then
begin
showmessage('请选择要下载的文件！');
exit;
end;
for I := 0 to ListFileInfo.Items.Count-1 do
begin
if(ListFileInfo.Items[i].Selected)then
begin
remoteFilename:=ListFileInfo.Items[i].Caption;
localFilename:=file1.Directory+'\'+remoteFilename;
uTransFileClient.downloadFile(localFilename,remoteFilename,i);
end;
end;
end;
procedure TfMain.btnListClick(Sender: TObject);
begin
uTransFileClient.ProcessListFile();
end;
procedure TfMain.btnSelAllClick(Sender: TObject);
begin
ListFileInfo.SelectAll;
end;
procedure TfMain.btnDecryptFileClick(Sender: TObject);
begin
//cryptfile('c:\temp\0310\2');
decryptfile(file1.Items);
dir1.Update;
file1.Update;
bar1.Panels[1].Text:=''+inttostr(file1.Items.Count)+'个文件';
end;
procedure TfMain.btnUploadClick(Sender: TObject);
var
localFilename,remoteFilename:string;
i:integer;
begin
if(file1.SelCount=0)then
begin
showmessage('请选择要上传的文件！');
exit;
end;
for i := 0 to file1.Count-1 do
begin
if(file1.Selected[i])then
begin
localFilename:=file1.Items[i];
remoteFilename:=extractfilename(localFilename);
uTransFileClient.uploadFile(localFilename,remoteFilename);
end;
end;
//localFilename:=file1.FileName;
//remoteFilename:=extractfilename(localFilename);
//uTransFileClient.uploadFile(localFilename,remoteFilename);
end;
procedure TfMain.FormCreate(Sender: TObject);
begin
application.OnException:=TryExcepts;
end;
procedure TfMain.FormShow(Sender: TObject);
begin
//fmain.Caption:=uConfig.APP_NAME+uConfig.APP_VERSION+uConfig.APP_CONTACT;
fmain.Caption:=uConfig.APP_NAME+uConfig.APP_VERSION;
edtAddr.Text:=uConfig.FTS_HOST_FORGED;
edtPort.Text:=inttostr(uConfig.FTS_PORT);
uTransFileClient.hForm:=fmain.Handle;
btnList.Click();
dir1.Drive:='c';
dir1.Directory:='c:\temp';
end;
procedure TfMain.ListFileInfoColumnClick(Sender: TObject; Column: TListColumn);
begin
ListFileInfo.CustomSort(@CustomSortProc,Column.Index);
end;
procedure TfMain.MenuItem1Click(Sender: TObject);
var
filename:string;
begin
if File1.Count=0 then exit;
if File1.ItemIndex=-1 then exit;
filename:=File1.Items[File1.ItemIndex];
ShellExecute(Handle,pchar('open'), pchar('explorer.exe'), pchar('/select,'+filename), nil, SW_SHOW);
end;
procedure TfMain.MenuItem2Click(Sender: TObject);
var
filename:string;
begin
if File1.Count=0 then exit;
if File1.ItemIndex=-1 then exit;
filename:=File1.Items[File1.ItemIndex];
ShellExecute(Handle,pchar('open'), pchar('explorer.exe'), pchar(filename), nil, SW_SHOW);
end;
procedure TfMain.N1Click(Sender: TObject);
var
dir,dirname:string;
begin
dir:=dir1.Directory;
dirname:= InputBox('请输入目录名：','目录名：','');//参数分别为标题，提示，默认值
if dirname<>'' then
begin
ForceDirectories(dir+'\'+dirname);
dir1.Update;
end;
end;
procedure TfMain.N2Click(Sender: TObject);
var
dir:string;
begin
if dir1.Count=0 then exit;
if dir1.ItemIndex=-1 then exit;
dir:=dir1.Items[File1.ItemIndex];
uFuncs.deldir(dir) ;
dir1.Update;
end;
procedure TfMain.N3Click(Sender: TObject);
var
filename,newfilename:string;
begin
if File1.Count=0 then exit;
if File1.ItemIndex=-1 then exit;
filename:=File1.Items[File1.ItemIndex];
newfilename:= InputBox('请输入文件名：','文件名：','');//参数分别为标题，提示，默认值
if newfilename<>'' then
begin
movefile(pchar(filename),pchar(newfilename));
File1.Update;
end;
end;
procedure TfMain.N4Click(Sender: TObject);
var
filename:string;
begin
if File1.Count=0 then exit;
if File1.ItemIndex=-1 then exit;
filename:=File1.Items[File1.ItemIndex];
deletefile(filename);
file1.Update;
end;
function CustomSortProc(Item1, Item2: TListItem; ColumnIndex: integer): integer; stdcall;
begin
if ColumnIndex = 0 then
Result := CompareText(Item1.Caption,Item2.Caption)
else
Result := CompareText(Item1.SubItems[ColumnIndex-1],Item2.SubItems[ColumnIndex-1])
end;
end.