devbox
盐析白兔
这个屌丝很懒，什么也没留下！
关注作者
热门标签
热门文章
当前位置:   article > 正文

二、delphi 开发的基于win socket文件传输系统（支持超4G文件，断点续传，多线程同时能传输100个文件以上，支持文件夹压缩传输）客户端_delphi 开发的基于win socket文件传输系统(支持超4g文... -

作者：盐析白兔 | 2024-02-26 00:45:20

赞

踩

delphi 开发的基于win socket文件传输系统(支持超4g文... -

delphi 自带的TIdFtpServer和TIdFtpClient组件，在实际应用中发现，只能单线程传输较小的文件。有很大局限性。决定自己写一个文件传输系统。该传输系统经测试，可以同时传输100个文件以上，超过4G大小的文件，支持断点续传。同时支持对文件夹的压缩传输。基本满足业务的要求。现在把服务器端和客户端代码粘贴如下：

一、客户端

1、传输单元

 

 

  1. unit uTransFileClient;
  2.  
  3. interface
  4. uses windows,graphics,classes,zip,uSocket,uStr,uConfig;
  5. const
  6.   MAXPATH=260;
  7.   MAXBUF=8192;
  8.   CMD_FILE_LIST=4001;//列举目录；传递绝对路径；
  9.   CMD_FILE_TRANS=4002;//文件传输
  10.   CMD_FILE_DEL=4003;//删除文件
  11.  
  12.   wm_user=$0400;
  13.   wm_TransData=wm_user+100+1;
  14. type
  15.  
  16.   TAPIFlag=(Fstart,Frecv,Fsend,Fend);
  17.   TThreadType=(FListFile,FTransFile);
  18.  
  19.   pTransFilesInfo=^stTransFilesInfo;
  20.   stTransFilesInfo=packed record
  21.     server:stSvrAddr;
  22.     clientFile:array[0..MAX_PATH-1] of ansiChar;
  23.     serverFile:array[0..MAX_PATH-1] of ansiChar;
  24.     bUpLoad:bool;
  25.     bFolder:bool;
  26.     bCompleteDel:bool;
  27.     aAPI:TAPIFlag;
  28.     transed:cardinal;
  29.     FileSize:cardinal;
  30.     threadId:integer;
  31.   end;
  32.   pRequestFileInfo=^stRequestFileInfo;
  33.   stRequestFileInfo=packed record
  34.     fileName:array[0..MAX_PATH-1] of ansiChar;
  35.     bUpLoad:bool;
  36.   end;//
  37.   pRecvData=^stRecvData;
  38.   stRecvData=packed record
  39.     server:stSvrAddr;
  40.     data:pointer;
  41.     dataSize:integer;
  42.   end;
  43.   pListFile=^stListFile;
  44.   stListFile=packed record
  45.     server:stSvrAddr;
  46.     filename:array[0..MAX_PATH-1] of ansiChar;
  47.     data:pointer;
  48.     dataSize:integer;
  49.   end;
  50.  
  51. function TransFilesClientThread(pTransFilesPara:pointer):BOOL;stdcall;
  52. function TransFileClientThread(pTransFilePara:pointer):bool;stdcall;
  53. procedure ProcessTransFile(const LocalFilename,RemoteFilename:ansiString;bUpload:boolean);overload;
  54. procedure ProcessTransFile(const LocalFilename,RemoteFilename:ansiString;bUpload:boolean;threadId:integer);overload;
  55. procedure initAddr();
  56. procedure uploadFile(const LocalFilename,RemoteFilename:ansiString);
  57. procedure downloadFile(const LocalFilename,RemoteFilename:ansiString);overload;
  58. procedure downloadFile(const LocalFilename,RemoteFilename:ansiString;threadId:integer);overload;
  59. function ListFileThread():bool;stdcall;
  60. procedure ProcessListFile();
  61. var
  62.   DataSvrAddr:stSvrAddr;
  63.   gFileList:ansiString;
  64.   hForm:THANDLE;
  65. implementation
  66.  
  67. procedure ProcessListFile();
  68. var
  69.   hd,id:cardinal;
  70. begin
  71.   gFileList:='';
  72.   hd:=createthread(nil,0,@ListFileThread,nil,0,id);
  73.   closehandle(hd);
  74. end;
  75. function ListFileThread():bool;stdcall;
  76. var
  77.   hSocket:integer;
  78.   oh:stOrderHeader;
  79. begin
  80.   result:=false;
  81. try
  82.   if not ConnectServer(hSocket,DataSvrAddr) then exit;
  83.   formatOH(oh);oh.cmd:=CMD_FILE_LIST;
  84.   SendBuf(hSocket,@oh,sizeof(oh));
  85.   //SendBuf(hSocket,@pList^.filename[0],MAX_PATH);
  86.   if not RecvBuf(hSocket,@oh,sizeof(oh)) then exit;
  87.   if(oh.len<=0)then exit;
  88.   setlength(gFileList,oh.len);
  89.   if not RecvBuf(hSocket,@gFileList[1],oh.len) then exit;
  90. finally
  91.   SendMessage(hform,wm_TransData,integer(FListFile),0);
  92.   FreeSocket(hSocket);
  93. end;
  94. end;
  95.  
  96. procedure uploadFile(const LocalFilename,RemoteFilename:ansiString);
  97. begin
  98.   ProcessTransFile(LocalFilename,RemoteFilename,true);
  99. end;
  100. procedure downloadFile(const LocalFilename,RemoteFilename:ansiString);
  101. var
  102.   uploadfile:string;
  103. begin
  104.   uploadfile:='\upload\'+RemoteFilename;
  105.   ProcessTransFile(LocalFilename,uploadfile,false);
  106. end;
  107. procedure downloadFile(const LocalFilename,RemoteFilename:ansiString;threadId:integer);
  108. var
  109.   uploadfile:string;
  110. begin
  111.   uploadfile:='\upload\'+RemoteFilename;
  112.   ProcessTransFile(LocalFilename,uploadfile,false,threadId);
  113. end;
  114. procedure ProcessTransFile(const LocalFilename,RemoteFilename:ansiString;bUpload:boolean;threadId:integer);
  115. var
  116.   pTF:pTransFilesInfo;
  117.   hd,id:cardinal;
  118. begin
  119.   new(pTF);
  120.   zeromemory(pTF,sizeof(stTransFilesInfo));
  121.   strcopy(pTF^.clientFile,pansichar(LocalFilename));
  122.   strcopy(pTF^.serverFile,pansichar(RemoteFilename));
  123.   pTF^.bUpLoad:=bUpload;
  124.   pTF^.bFolder:=false;
  125.   pTF^.bCompleteDel:=false;
  126.   pTF^.server:=DataSvrAddr;
  127.   pTF^.threadId:=threadId;
  128.   hd:=createthread(nil,0,@TransFilesClientThread,pTF,0,id);
  129.   closehandle(hd);
  130. end;
  131. procedure ProcessTransFile(const LocalFilename,RemoteFilename:ansiString;bUpload:boolean);
  132. var
  133.   pTF:pTransFilesInfo;
  134.   hd,id:cardinal;
  135. begin
  136.   new(pTF);
  137.   zeromemory(pTF,sizeof(stTransFilesInfo));
  138.   strcopy(pTF^.clientFile,pansichar(LocalFilename));
  139.   strcopy(pTF^.serverFile,pansichar(RemoteFilename));
  140.   pTF^.bUpLoad:=bUpload;
  141.   pTF^.bFolder:=false;
  142.   pTF^.bCompleteDel:=false;
  143.   pTF^.server:=DataSvrAddr;
  144.  
  145.   hd:=createthread(nil,0,@TransFilesClientThread,pTF,0,id);
  146.   closehandle(hd);
  147. end;
  148. function TransFileClientThread(pTransFilePara:pointer):bool;stdcall;
  149. label 1;
  150. var
  151.   pTransFileInfo:pTransFilesInfo;
  152.   hSocket:integer;
  153.   hFile,FileSize,NumberOfRead,srvFileSize,wLen,fileSizeHigh,srvFileSizeHigh:cardinal;
  154.   err,recvLen:integer;
  155.   buf:array[0..MAXBUF-1] of ansiChar;
  156.   RequestFileInfo:stRequestFileInfo;
  157.   bRet:LongBool;
  158.   bTransType:byte;
  159.   dwAccess,dwCreation,dwAtrr,dwShare:DWORD;
  160.   oh:stOrderHeader;
  161. begin
  162.   result:=false;
  163.   pTransFileInfo:=pTransFilePara;
  164.   if pTransFileInfo^.bUpLoad then
  165.   begin
  166.     dwAccess:=GENERIC_READ;
  167.     dwCreation:=OPEN_EXISTING;
  168.     dwAtrr:=FILE_ATTRIBUTE_NORMAL;
  169.     dwShare:=FILE_SHARE_READ;
  170.   end
  171.   else begin
  172.     dwAccess:=GENERIC_READ or GENERIC_WRITE;
  173.     dwCreation:=OPEN_ALWAYS;
  174.     dwAtrr:=FILE_ATTRIBUTE_NORMAL or FILE_ATTRIBUTE_ARCHIVE;
  175.     dwShare:=FILE_SHARE_DELETE or FILE_SHARE_READ or FILE_SHARE_WRITE;
  176.   end;
  177.   hFile:=CreateFileA(pTransFileInfo^.clientFile,dwAccess,dwShare,nil,dwCreation,dwAtrr,0);
  178.   if (hFile=INVALID_HANDLE_VALUE) then goto 1;
  179.   fileSize:=GetFileSize(hFile,@fileSizeHigh);
  180.   if (fileSize=$FFFFFFFF) and (GetLastError()<>NO_ERROR) then goto 1;
  181.   if pTransFileInfo^.bUpLoad then
  182.   begin
  183.     if (fileSize=0) and (fileSizeHigh=0) then goto 1;
  184.   end;//
  185.   if not ConnectServer(hSocket,pTransFileInfo^.server) then goto 1;
  186.   strcopy(RequestFileInfo.fileName,pTransFileInfo^.serverFile);
  187.   RequestFileInfo.bUpLoad:=pTransFileInfo^.bUpLoad;
  188.   //bTransType:=byte(RTransFile);
  189.   //SendBuf(hSocket,@bTransType,sizeof(bTransType));
  190.   formatOH(oh);oh.cmd:=CMD_FILE_TRANS;oh.len:=sizeof(RequestFileInfo);
  191.   SendBuf(hSocket,@oh,sizeof(oh));
  192.   SendBuf(hSocket,@RequestFileInfo,sizeof(RequestFileInfo));
  193.   if pTransFileInfo^.bUpLoad then
  194.   begin
  195.     pTransFileInfo^.FileSize:=fileSize;//显示信息用；
  196.     SendBuf(hSocket,@fileSize,sizeof(FileSize));
  197.     SendBuf(hSocket,@fileSizeHigh,sizeof(fileSizeHigh));
  198.     if not RecvBuf(hSocket,@srvFileSize,sizeof(srvFileSize)) then goto 1;
  199.     if not RecvBuf(hSocket,@srvFileSizeHigh,sizeof(srvFileSizeHigh)) then goto 1;
  200.     SetFilePointer(hFile,srvFileSize,@srvFileSizeHigh,FILE_BEGIN);
  201.     pTransFileInfo^.transed:=srvFileSize;//显示信息用；
  202.     while true do
  203.     begin
  204.       bRet:=ReadFile(hFile,buf,sizeof(buf),NumberOfRead,nil);
  205.       if bRet=false then goto 1
  206.       else if NumberOfRead=0 then begin result:=true;goto 1;end
  207.       else begin
  208.         if(not SendBuf(hSocket,@buf,NumberOfRead))then goto 1;
  209.         pTransFileInfo^.aAPI:=FSend;//显示信息用；
  210.         pTransFileInfo^.transed:=pTransFileInfo^.transed+NumberOfRead;//显示信息用；
  211.         PostMessage(hform,wm_TransData,integer(FTransFile),integer(pTransFileInfo)); //显示信息用；
  212.       end;//send(socket1,buf,NumberOfRead,0);
  213.     end;//while
  214.   end
  215.   else begin
  216.     err:=SetFilePointer(hFile,0,nil,FILE_END);
  217.     if err=-1 then goto 1;
  218.     SendBuf(hSocket,@fileSize,sizeof(fileSize));
  219.     SendBuf(hSocket,@fileSizeHigh,sizeof(fileSizeHigh));
  220.     pTransFileInfo^.transed:=fileSize;//显示信息用；
  221.     while true do
  222.       begin
  223.         FillChar(buf,SizeOf(buf),0);
  224.         recvLen:=RecvNon(hSocket,@buf,sizeof(buf));
  225.         if recvLen=0 then result:=true;
  226.         if (recvLen=-1) or (recvLen=0) then goto 1;
  227.         //revs:=revs+revLen;
  228.         if not WriteFile(hFile,Buf,recvLen,wLen,nil) then goto 1;
  229.         pTransFileInfo^.aAPI:=FRecv;//显示信息用；
  230.         pTransFileInfo^.transed:=pTransFileInfo^.transed+wLen;//显示信息用；
  231.         PostMessage(hform,wm_TransData,integer(FTransFile),integer(pTransFileInfo)); //显示信息用
  232.       end;//while
  233.   end;//not if pTransFileInfo^.upLoad then
  234. 1:
  235.   CloseHandle(hFile);
  236.   FreeSocket(hSocket);
  237.  
  238. end;
  239. function TransFilesClientThread(pTransFilesPara:pointer):BOOL;stdcall;
  240. var
  241.   pTF:pTransFilesInfo;
  242.   //err:integer;
  243.   //bRet:bool;
  244.   lpFindFileData: TWIN32FindDataA;
  245.   hFind:Thandle;
  246.   //severFile
  247.   clientFile:array[0..MAX_PATH-1] of ansiChar;
  248.   uniqueStr:array[0..64] of ansiChar;
  249. begin
  250.   result:=false;
  251.   pTF:=pTransFilesPara;
  252.   pTF^.aAPI:=Fstart;
  253.   PostMessage(hform,wm_TransData,integer(FTransFile),integer(pTF)); //显示信息用；
  254.   if pTF^.bupLoad then
  255.   begin
  256.     hFind:=findfirstfileA(pTF^.clientFile,lpFindFileData);
  257.     if hFind=INVALID_HANDLE_VALUE then exit;
  258.     findclose(hFind);
  259.   end;
  260.   if pTF^.bFolder then
  261.   begin
  262.     if pTF^.bUpLoad then
  263.     begin
  264.       GettempPathA(MAXPATH,clientFile);
  265.       StrFromTime(UniqueStr);
  266.       strcat(clientFile,uniqueStr);
  267.       strcat(clientFile,'.dir');
  268.       //DirectoryCompression(pTF^.clientFile,clientFile);
  269.       TZipFile.ZipDirectoryContents(clientFile,pTF^.clientFile);
  270.       strcopy(pTF^.clientFile,clientFile);
  271.       strcat(pTF^.serverFile,'.dir');
  272.     end
  273.     else begin
  274.       strcopy(clientFile,pTF^.clientFile);
  275.       strcat(pTF^.clientFile,'.dir');
  276.     end;
  277.     result:=TransFileClientThread(pTF);
  278.     if pTF^.bUpLoad then //这儿可以删除上传后的目录
  279.       DeleteFileA(pTF^.clientFile)
  280.     else begin
  281.       //DirectoryDecompression(clientFile,pTF^.clientFile);
  282.       TZipFile.ExtractZipFile(pTF^.clientFile, clientFile);
  283.       DeleteFileA(pTF^.clientFile);
  284.     end;
  285.   end
  286.   else begin  //是文件
  287.     result:=TransFileClientThread(pTF);
  288.     //如果是上传并且bCompleteDel=true ，删除原文件
  289.     if (pTF^.bUpLoad and pTF^.bCompleteDel and result)=true then
  290.       DeleteFileA(pTF^.clientFile);
  291.   end;
  292.   pTF^.aAPI:=Fend;
  293.   SendMessage(hform,wm_TransData,integer(FTransFile),integer(pTF));
  294.   dispose(pTF);
  295. end;
  296. procedure initAddr();
  297. begin
  298.   DataSvrAddr.port:=uConfig.FTS_PORT;
  299.   strcopy(DataSvrAddr.IP,pansiChar(uConfig.FTS_HOST));
  300.  
  301. end;
  302. initialization
  303.   initAddr();
  304.  
  305. finalization
  306.  
  307. end.

 

 

2、通讯单元

  1. unit uSocket;
  2.  
  3. interface
  4. //************************windows定义**************************************
  5. const
  6.   user32    = 'USER32.dll';
  7.   //-------------------------------------------
  8.   //数据传输协议包头：
  9.   UID:integer=8888;//包头标识;
  10.   VER:integer=1002;
  11.   ENC:integer=7620;
  12.  
  13.   CMD_READY:integer=1001;
  14. type
  15.   BOOL = LongBool;
  16.   DWORD = LongWord;
  17.  
  18. //************************socket 定义****************************
  19. type
  20.   u_int = Integer;
  21.   TSocket = u_int;
  22.   u_short = Word;
  23.   u_char = Char;
  24.   u_long = Longint;
  25. const
  26.   winsocket = 'WSock32.dll';
  27.   SOCKET_ERROR      = -1;
  28.   INVALID_SOCKET    = TSocket(NOT(0));
  29.   WSADESCRIPTION_LEN     =   256;
  30.   WSASYS_STATUS_LEN      =   128;
  31.   AF_INET         = 2;
  32.   SOCK_STREAM     = 1;               { stream socket }
  33.  
  34.   SOL_SOCKET      = $ffff;          {options for socket level }
  35.   SO_LINGER       = $0080;          { linger on close if data present }
  36.   SO_SNDTIMEO     = $1005;          { send timeout }
  37.   SO_RCVTIMEO     = $1006;          { receive timeout }
  38.   WSAECONNRESET   =10054;
  39. type
  40.   SunB = packed record
  41.     s_b1, s_b2, s_b3, s_b4: u_char;
  42.   end;
  43.   SunW = packed record
  44.     s_w1, s_w2: u_short;
  45.   end;
  46.   PInAddr = ^TInAddr;
  47.   in_addr = record
  48.     case integer of
  49.       0: (S_un_b: SunB);
  50.       1: (S_un_w: SunW);
  51.       2: (S_addr: u_long);
  52.   end;
  53.   TInAddr = in_addr;
  54.   PSockAddrIn = ^TSockAddrIn;
  55.   sockaddr_in = record
  56.     case Integer of
  57.       0: (sin_family: u_short;
  58.           sin_port: u_short;
  59.           sin_addr: TInAddr;
  60.           sin_zero: array[0..7] of ansiChar);
  61.       1: (sa_family: u_short;
  62.           sa_data: array[0..13] of ansiChar)
  63.   end;
  64.   TSockAddrIn = sockaddr_in;
  65.   PSOCKADDR = ^TSockAddr;
  66.   TSockAddr = sockaddr_in;
  67.  
  68.   PWSAData = ^TWSAData;
  69.   WSAData = record // !!! also WSDATA
  70.     wVersion: Word;
  71.     wHighVersion: Word;
  72.     szDescription: array[0..WSADESCRIPTION_LEN] of ansiChar;
  73.     szSystemStatus: array[0..WSASYS_STATUS_LEN] of ansiChar;
  74.     iMaxSockets: Word;
  75.     iMaxUdpDg: Word;
  76.     lpVendorInfo: PansiChar;
  77.   end;
  78.   TWSAData = WSAData;
  79.   PHostEnt = ^THostEnt;
  80.   {$EXTERNALSYM hostent}
  81.   hostent = record
  82.     h_name: PansiChar;
  83.     h_aliases: ^PansiChar;
  84.     h_addrtype: Smallint;
  85.     h_length: Smallint;
  86.     case Byte of
  87.       0: (h_addr_list: ^PansiChar);
  88.       1: (h_addr: ^PansiChar)
  89.   end;
  90.   THostEnt = hostent;
  91.   //2006-04-25
  92.   linger = record
  93.     l_onoff: u_short;
  94.     l_linger: u_short;
  95.   end;
  96.   timeval = record
  97.     tv_sec: Longint;
  98.     tv_usec: Longint;
  99.   end;
  100. //************************我的 定义****************************
  101. type
  102.   pSvrAddr=^stSvrAddr;
  103.   stSvrAddr=packed record
  104.     port:Word;
  105.     case flg:byte of
  106.     0:(IP:array[0..15] of ansiChar);
  107.     1:(DN:array[0..30] of ansiChar);
  108.   end;
  109.   POrderHeader=^stOrderHeader;
  110.   stOrderHeader=packed record
  111.     uid:DWORD;
  112.     Ver:DWORD;
  113.     Enc:DWORD;
  114.     id:DWORD;
  115.     pid:DWORD;
  116.     cmd:DWORD;
  117.     len:DWORD;
  118.     dat:pointer;
  119.   end;
  120.  
  121.   //---------------------------------------------------------
  122. //***********************socket api***********************************
  123. function recv(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
  124. function send(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
  125. function connect(s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall;
  126. function closesocket(s: TSocket): Integer; stdcall;
  127. function WSACleanup: Integer; stdcall;
  128. function socket(af, Struct, protocol: Integer): TSocket; stdcall;
  129. function WSAStartup(wVersionRequired: word; var WSData: TWSAData): Integer; stdcall;
  130. function htons(hostshort: u_short): u_short; stdcall;
  131. function inet_addr(cp: PansiChar): u_long; stdcall; {PInAddr;}  { TInAddr }
  132. function gethostbyname(name: PansiChar): PHostEnt; stdcall;
  133.  
  134. function setsockopt(s: TSocket; level, optname: Integer; optval: PansiChar;
  135.   optlen: Integer): Integer; stdcall;
  136. function WSAGetLastError: Integer; stdcall;
  137. //***********************windows api*************************************
  138. procedure ZeroMemory(Destination: Pointer; Length: DWORD);
  139. function wsprintf(Output: PansiChar; Format: PansiChar): Integer; stdcall;
  140.  
  141.  
  142. //***********************字符串函数*************************************
  143. function _wsprintf(lpOut: PansiChar; lpFmt: PansiChar; lpVars: Array of Const):Integer; assembler;
  144. //***********************我的函数*****************************************
  145. function InitAddr(sa:stSvrAddr;var addr:sockaddr_in):bool;stdcall;
  146. function HostToIP(hostName:pansiChar):in_addr;stdcall;
  147. function InitSocket(var hSocket:integer):bool;stdcall;
  148. procedure FreeSocket(var hSocket:integer);stdcall; //out
  149. function ConnectServer(var hSocket:integer;sa:stSvrAddr):bool;stdcall; //out
  150. function RecvBuf(hSocket:integer;p:pointer;len:DWORD):bool;stdcall;
  151. function SendBuf(socket:integer;p:pointer;size:DWORD):bool;stdcall;
  152. function GetLocalIP(IP:pansiChar):bool;stdcall;
  153. function RecvNon(hSocket:integer;p:pointer;len:integer):integer;stdcall;
  154. function VerifyOH(oh:stOrderHeader) :boolean;//校验包头;
  155. function formatOH(var oh:stOrderHeader) :stOrderHeader;//格式化包头;
  156. implementation
  157. //***********************windows api*************************************
  158. procedure ZeroMemory(Destination: Pointer; Length: DWORD);
  159. begin
  160.   FillChar(Destination^, Length, 0);
  161. end;
  162. function wsprintf; external user32 name 'wsprintfA';
  163. //**********************socket api******************************************
  164. function recv;              external    winsocket name 'recv';
  165. function send;              external    winsocket name 'send';
  166. function connect;           external    winsocket name 'connect';
  167. function closesocket;       external    winsocket name 'closesocket';
  168. function WSACleanup;        external     winsocket name 'WSACleanup';
  169. function WSAStartup;        external     winsocket name 'WSAStartup';
  170. function socket;            external    winsocket name 'socket';
  171. function htons;             external    winsocket name 'htons';
  172. function inet_addr;         external    winsocket name 'inet_addr';
  173. function gethostbyname;     external    winsocket name 'gethostbyname';
  174.  
  175. function setsockopt;        external    winsocket name 'setsockopt';
  176. function WSAGetLastError;        external    winsocket name 'WSAGetLastError';
  177. //***********************字符串函数*************************************
  178. function _wsprintf(lpOut:pansiChar;lpFmt:pansiChar;lpVars:array of const):integer;assembler;
  179. var
  180.   count:integer;
  181.   v1,v2:integer;
  182. asm
  183.   mov v1,eax
  184.   mov v2,edx
  185.   mov eax,ecx
  186.   mov ecx,[ebp+$08]
  187.   inc ecx
  188.   mov count,ecx
  189.   dec ecx
  190.   imul ecx,8
  191.   add eax,ecx
  192.   mov ecx,count
  193. @@1:
  194.   mov edx,[eax]
  195.   push edx
  196.   sub eax,8
  197.   loop @@1
  198.  
  199.   push v2
  200.   push v1
  201.  
  202.   call wsprintf
  203.  
  204.   mov ecx,count
  205.   imul ecx,4
  206.   add ecx,8
  207.   add esp,ecx
  208. end;
  209. //*********************我的函数****************************************
  210. function RecvNon(hSocket:integer;p:pointer;len:integer):integer;stdcall;
  211. begin
  212.   result:=recv(hSocket,p^,len,0);
  213. end;
  214. function SendBuf(socket:integer;p:pointer;size:DWORD):bool;stdcall;
  215. var
  216.   i,len:integer;
  217.   pp:pointer;
  218. begin
  219.   result:=false;
  220.   len:=size;
  221.   pp:=p;
  222.   while len>0 do
  223.   begin
  224.     i:=send(socket,pp^,len,0);
  225.     //if i=SOCKET_ERROR then exit;   2015-9-5
  226.     if (i=SOCKET_ERROR) and (WSAGetLastError = WSAECONNRESET) then exit;
  227.     len:=len-i;
  228.     pp:=pointer(DWORD(pp)+DWORD(i));
  229.   end;//while
  230.   result:=true;
  231. end;
  232. function RecvBuf(hSocket:integer;p:pointer;len:DWORD):bool;stdcall;
  233. var
  234.   err,k:integer;
  235.   pp:pointer;
  236. begin
  237.   result:=false;
  238.   k:=len;
  239.   pp:=p;
  240.   while k>0 do
  241.   begin
  242.     err:=recv(hSocket,pp^,k,0);
  243.     if (err=SOCKET_ERROR) or (err=0) then exit;  //2015
  244.     //if (err=SOCKET_ERROR) or (err=0) then exit;
  245.     k:=k-err;
  246.     pp:=pointer(dword(pp)+dword(err));
  247.   end;
  248.   result:=true;
  249. end;
  250. function ConnectServer(var hSocket:integer;sa:stSvrAddr):bool;stdcall;
  251. var
  252.   err:integer;
  253.   addr:sockaddr_in;
  254. begin
  255.   result:=false;
  256.   if not InitSocket(hSocket) then exit;
  257.   InitAddr(sa,addr);
  258.   err:=connect(hSocket,addr,sizeof(addr));//连接
  259.   if err<>0 then FreeSocket(hSocket);
  260.   result:=err=0;
  261. end;
  262. procedure FreeSocket(var hSocket:integer);stdcall;
  263. begin
  264.   if hSocket<>0 then  closesocket(hSocket);
  265.   //WSACleanup();//终止WS2_32.DLL的使用
  266.   hSocket:=0;
  267. end;
  268. {
  269. 功能描述:初始化Socket
  270. 入口参数:hSocket:Socket句柄
  271. 出口参数:返回值:成功创建返回True,否则返回False
  272. 创建日期:
  273. 修改记录:增加超时时间6分钟
  274. 2006-04-25
  275. Author:byc
  276. }
  277. function InitSocket(var hSocket:integer):bool;stdcall;
  278. var
  279.   wsadata: TWSAData;
  280.   err:integer;
  281.   //t:linger;
  282.   //timeout: timeval;
  283.   tv:longint;
  284. begin
  285.   result:=false;
  286.   err:=WSAStartup($0202,wsadata);
  287.   if  err<>0 then
  288.   begin //初始化WS2_32.DLL
  289.     //showmessage('初始化ws_32.dll失败!');
  290.     WSACleanup();//终止WS2_32.DLL的使用
  291.     exit;
  292.   end;//if
  293.   hSocket:=socket(AF_INET, SOCK_STREAM, 0);
  294.   //创建socket
  295.   if hSocket=INVALID_SOCKET then
  296.   begin
  297.     //ShowMessage('创建SOCKET失败!');
  298.     hSocket:=0;
  299.     WSACleanup();
  300.     exit;
  301.   end;//if socket1=SOCKET_ERROR then
  302.   {
  303.   t.l_onoff:=1;
  304.   t.l_linger:=0;
  305.   //关闭socket后立刻释放资源
  306.   err:=setsockopt(hSocket,SOL_SOCKET,SO_LINGER,@t,sizeof(t));
  307.   if err=SOCKET_ERROR then
  308.   begin
  309.     FreeSocket(hSocket);
  310.     exit;
  311.   end;
  312.   }
  313.   //set recv and send timeout
  314.   tv:=6*60*1000;
  315.   //tv:=60000;//测试
  316.   err:=setsockopt(hSocket,SOL_SOCKET,SO_SNDTIMEO,@tv,sizeof(timeval));
  317.   if err=SOCKET_ERROR then
  318.   begin
  319.     FreeSocket(hSocket);
  320.     exit;
  321.   end;
  322.   err:=setsockopt(hSocket,SOL_SOCKET,SO_RCVTIMEO,@tv,sizeof(timeval));
  323.   if err=SOCKET_ERROR then
  324.   begin
  325.     FreeSocket(hSocket);
  326.     exit;
  327.   end;
  328.   result:=true;
  329. end;
  330. function InitAddr(sa:stSvrAddr;var addr:sockaddr_in):bool;stdcall;
  331. begin
  332.   result:=false;
  333.   zeromemory(@addr,sizeof(addr));
  334.   addr.sin_family:=AF_INET;
  335.   addr.sin_port:=htons(sa.port);
  336.   case sa.flg of
  337.   0:begin
  338.       addr.sin_addr.S_addr:=inet_addr(sa.IP);
  339.     end;//0
  340.   1:begin
  341.       addr.sin_addr:=HostToIP(sa.DN);
  342.     end;//1
  343.   end;//case
  344.   if addr.sin_addr.S_addr>0 then
  345.     result:=true;
  346. end;
  347. function HostToIP(hostName:pansiChar):in_addr;stdcall;
  348. var
  349.   hostEnt : PHostEnt;
  350.   addr:pansiChar;
  351.   err:integer;
  352.   wd:wsadata;
  353. begin
  354.   err:=WSAStartup($0202,WD);
  355.   if err<>0 then exit;
  356.   ZeroMemory(@result,sizeof(in_addr));
  357.   hostEnt:=gethostbyname (hostName);
  358.   if Assigned (hostEnt) then
  359.   if Assigned (hostEnt^.h_addr_list) then
  360.   begin
  361.     addr := hostEnt^.h_addr_list^;
  362.     if Assigned (addr) then
  363.     begin
  364.       result:=PInAddr(addr)^;
  365.     end;// if Assigned (addr) then
  366.   end;//if Assigned (hostEnt) then
  367.   wsacleanup();
  368. end;
  369. function GetLocalIP(IP:pansiChar):bool;stdcall;
  370. var
  371.   wd:WSAdata;
  372.   err:integer;
  373.   phe:PhostEnt;
  374.   addr:pansiChar;
  375.   b0,b1,b2,b3:byte;
  376. begin
  377.   result:=false;
  378.   err:=WSAStartup($101,wd);
  379.   if err<>0 then begin wsaCleanup;exit;end;
  380.   phe:=GetHostByName(nil);
  381.   if phe=nil then begin wsaCleanup;exit;end;
  382.   addr:=(phe^.h_addr)^;
  383.   if addr=nil then begin wsaCleanup;exit;end;
  384.   b0:=byte((addr+0)^);b1:=byte((addr+1)^);
  385.   b2:=byte((addr+2)^);b3:=byte((addr+3)^);
  386.   _wsprintf(IP,'%d.%d.%d.%d',[b0,b1,b2,b3]);
  387.   wsaCleanup;
  388.   result:=true;
  389. end;
  390. //-------------------------------------------------------------------------
  391. function VerifyOH(oh:stOrderHeader) :boolean;//校验包头;
  392. begin
  393.   result:=true;
  394.   if(oh.uid<>UID)then result:=false;
  395.   if(oh.Ver<>VER)then result:=false;
  396.   if(oh.ENC<>ENC)then result:=false;
  397. end;
  398. function formatOH(var oh:stOrderHeader) :stOrderHeader;//格式化包头;
  399. begin
  400.   oh.uid:=UID;
  401.   oh.Ver:=VER;
  402.   oh.Enc:=ENC;
  403.   oh.id:=0;
  404.   oh.pid:=0;
  405.   oh.cmd:=CMD_READY;
  406.   oh.len:=0;
  407.   oh.dat:=nil;
  408.   result:=oh;
  409. end;
  410. //------------------------------------------------------------------
  411. end.

 

3、客户端主线程

  1. unit uMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls,
  8.   Vcl.FileCtrl, Vcl.ExtCtrls,strutils,system.zip,IdGlobalProtocols,
  9.   uConfig,uLog,uTransFileClient,uDes2010,uFuncs, Vcl.Menus,shellapi;
  10.  
  11. type
  12.   TfMain = class(TForm)
  13.     Panel4: TPanel;
  14.     Label2: TLabel;
  15.     Label1: TLabel;
  16.     edtAddr: TEdit;
  17.     edtPort: TEdit;
  18.     btnUpload: TButton;
  19.     btnDownload: TButton;
  20.     btnClose: TButton;
  21.     Bar1: TStatusBar;
  22.     Panel2: TPanel;
  23.     Drive1: TDriveComboBox;
  24.     Dir1: TDirectoryListBox;
  25.     Splitter1: TSplitter;
  26.     Panel3: TPanel;
  27.     File1: TFileListBox;
  28.     edtFile: TEdit;
  29.     Splitter2: TSplitter;
  30.     Panel1: TPanel;
  31.     Splitter3: TSplitter;
  32.     ListFileInfo: TListView;
  33.     memoInfo: TMemo;
  34.     btnList: TButton;
  35.     btnSelAll: TButton;
  36.     btnDecryptFile: TButton;
  37.     lbDir: TLabel;
  38.     popDir: TPopupMenu;
  39.     N1: TMenuItem;
  40.     N2: TMenuItem;
  41.     popFile: TPopupMenu;
  42.     MenuItem1: TMenuItem;
  43.     MenuItem2: TMenuItem;
  44.     N3: TMenuItem;
  45.     N4: TMenuItem;
  46.     procedure btnUploadClick(Sender: TObject);
  47.     procedure FormShow(Sender: TObject);
  48.     procedure btnCloseClick(Sender: TObject);
  49.     procedure btnDownloadClick(Sender: TObject);
  50.     procedure btnListClick(Sender: TObject);
  51.     procedure FormCreate(Sender: TObject);
  52.     procedure btnSelAllClick(Sender: TObject);
  53.     procedure ListFileInfoColumnClick(Sender: TObject; Column: TListColumn);
  54.     procedure btnDecryptFileClick(Sender: TObject);
  55.     procedure N1Click(Sender: TObject);
  56.     procedure MenuItem1Click(Sender: TObject);
  57.     procedure MenuItem2Click(Sender: TObject);
  58.     procedure N3Click(Sender: TObject);
  59.     procedure N4Click(Sender: TObject);
  60.     procedure N2Click(Sender: TObject);
  61.  
  62.   private
  63.     { Private declarations }
  64.     procedure TransDataMsg(var msg:TMessage);message wm_TransData;
  65.     procedure TryExcepts(Sender: TObject; E: Exception);
  66.     procedure parseFileList();
  67.     procedure AddList(filesign,filesize:string);
  68.     function decryptFilename(filename:string):string;
  69.     procedure decryptfile(ss:tstrings);
  70.   public
  71.     { Public declarations }
  72.   end;
  73.  
  74. var
  75.   fMain: TfMain;
  76.   function CustomSortProc(Item1, Item2: TListItem; ColumnIndex: integer): integer; stdcall;
  77. function cryptfile(filedir:string):ansiString;
  78. //联系QQ：39848872微信：byc6352
  79. implementation
  80.  
  81. {$R *.dfm}
  82. procedure TfMain.decryptfile(ss:tstrings);
  83. const
  84.   FILE_NAME_ID='x';
  85. var
  86.   i:integer;
  87.   filename,newfilename,newdir:string;
  88. begin
  89.   for I := 0 to ss.Count-1 do
  90.   begin
  91.     filename:=ss[i];
  92.     if(filename[length(filename)]<>FILE_NAME_ID)then continue;
  93.     if(FileSizeByName(filename)=0)then
  94.     begin
  95.       deletefile(filename);
  96.       continue;
  97.     end;
  98.     uFuncs.cryptfile(filename);
  99.     newfilename:=leftstr(filename,length(filename)-1);
  100.     newfilename:=extractfilepath(newfilename)+uDes2010.DecryStrHex(extractfilename(newfilename),uConfig.key);
  101.     movefile(pchar(filename),pchar(newfilename));
  102.     newdir:=leftstr(newfilename,length(newfilename)-4);
  103.     if(TZipFile.IsValid(newfilename))then
  104.     begin
  105.       TZipFile.ExtractZipFile(newfilename, newdir);
  106.       deletefile(newfilename);
  107.     end else begin
  108.       memoInfo.Lines.Add('解压失败：'+newfilename);
  109.       //showmessage('解压失败：'+newfilename);
  110.     end;
  111.     //uzip.DirectoryDecompression(newdir,newfilename);
  112.   end;
  113. end;
  114. //'c:\temp\0310\2'
  115. function cryptfile(filedir:string):ansiString;
  116. var
  117.   filename:array[0..MAX_PATH-1] of ansiChar;
  118.   filesize:array[0..31] of ansiChar;
  119.   wfd:WIN32_FIND_DATAA;
  120.   hFindFile:THANDLE;
  121.   newfilename,newdir:ansistring;
  122. begin
  123.   result:='';
  124.   strcopy(filename,pansichar(ansiString(filedir)));
  125.   strcat(filename,pansichar('\*'));
  126.   hFindFile:=FindFirstFileA(filename,wfd);
  127.   if hFindFile=INVALID_HANDLE_VALUE then exit;
  128.   while(FindNextFileA(hFindFile,wfd))do
  129.   begin
  130.     if(wfd.cFileName[0]='.')then continue;
  131.     if(wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)<>0 then continue;
  132.     //uFuncs.cryptfile(filedir+'\'+wfd.cFileName);
  133.     newfilename:=filedir+'\'+wfd.cFileName;
  134.     newdir:=leftstr(newfilename,length(newfilename)-4);
  135.     if(TZipFile.IsValid(newfilename))then
  136.     begin
  137.       try
  138.       TZipFile.ExtractZipFile(newfilename, newdir);
  139.       except
  140.         fmain.memoInfo.Lines.Add('解压失败1：'+newfilename);
  141.       end;
  142.       deletefile(newfilename);
  143.     end else begin
  144.       fmain.memoInfo.Lines.Add('解压失败：'+newfilename);
  145.       //showmessage('解压失败：'+newfilename);
  146.     end;
  147.   end;
  148.   Winapi.Windows.FindClose(hFindFile);
  149. end;
  150. function TfMain.decryptFilename(filename:string):string;
  151. const
  152.   FILE_NAME_ID='x';
  153. var
  154.   i:integer;
  155.   newfilename,newdir:string;
  156. begin
  157.   result:=filename;
  158. try
  159.   if(filename[length(filename)]<>FILE_NAME_ID)then exit;
  160.   newfilename:=leftstr(filename,length(filename)-1);
  161.   newfilename:=uDes2010.DecryStrHex(newfilename,uConfig.key);
  162.   result:=newfilename;
  163. finally
  164.  
  165. end;
  166. end;
  167. procedure TfMain.AddList(filesign,filesize:string);
  168. var
  169.   item:tListitem;
  170. begin
  171.   item:=ListFileInfo.Items.Add;
  172.   item.Caption:=filesign;
  173.   item.SubItems.Add(decryptFilename(filesign));
  174.   item.SubItems.Add(filesize);
  175.   item.SubItems.Add('');
  176.   item.ImageIndex:=8;
  177. end;
  178. procedure TfMain.parseFileList();
  179. var
  180.   filelist,fileinfo:tstrings;
  181.   i:integer;
  182.   filename,info:string;
  183. begin
  184.   if gFileList='' then exit;
  185.   ListFileInfo.Clear;
  186. try
  187.   filelist:=tstringlist.Create;
  188.   fileinfo:=tstringlist.Create;
  189.   if gFileList[length(gFileList)]=';' then delete(gFileList,length(gFileList),1);
  190.   if(rightstr(gFileList,2)=#13#10) then leftstr(gFileList,length(gFileList)-2);
  191.   fileList.Text:=gFileList;
  192.   if(fileList.Count=0)then exit;
  193.   for I := 0 to fileList.Count-1 do
  194.   begin
  195.     info:=fileList[i];
  196.     fileinfo.Delimiter:=';';
  197.     fileinfo.DelimitedText:=info;
  198.     AddList(fileinfo[0],fileinfo[1]);
  199.   end;
  200.   bar1.Panels[0].Text:='共有文件：'+inttostr(filelist.Count);
  201. finally
  202.   filelist.Free;
  203.   fileinfo.Free;
  204.  
  205. end;
  206. end;
  207. procedure tFMain.TransDataMsg(var msg:TMessage);
  208. var
  209.   threadType:TThreadType;
  210.   pTF:pTransFilesInfo;
  211.   localfilename,newfilename,localpath:ansiString;
  212.   i:integer;
  213. begin
  214.   threadType:=TThreadType(msg.WParam);
  215.   case threadType of
  216.     FListFile:
  217.     begin
  218.       //memoSms.Lines.Add(gFileList);
  219.       parseFileList();
  220.       ListFileInfo.CustomSort(@CustomSortProc,0);
  221.     end;
  222.     FTransFile:
  223.     begin
  224.       pTF:=pTransFilesInfo(msg.LParam);
  225.       if(pTF<>nil)then
  226.       begin
  227.         localfilename:=pTF^.clientFile;
  228.         //memoInfo.lines.add(localfilename);
  229.         if(pTF^.aAPI=Fstart)then
  230.         begin
  231.           memoInfo.lines.add('开始传输：'+localfilename);
  232.           bar1.Panels[0].Text:='开始传输：'+localfilename;
  233.         end;
  234.         if(pTF^.bUpLoad)then
  235.         begin
  236.           if pTF^.aAPI=Fsend then
  237.             bar1.Panels[0].Text:='正在上传：'+inttostr(pTF^.transed)+'/'+inttostr(pTF^.FileSize);
  238.           if pTF^.aAPI=Fend then
  239.           begin
  240.             btnList.Click();
  241.             memoInfo.lines.add('上传完成：'+localfilename);
  242.             bar1.Panels[0].Text:='上传完成：'+inttostr(pTF^.transed)+'/'+inttostr(pTF^.FileSize);
  243.           end;
  244.         end else begin
  245.           i:=ptF^.threadId;
  246.           if pTF^.aAPI=FRecv then
  247.           begin
  248.             listFileInfo.Items[i].SubItems.Strings[2]:=inttostr(pTF^.transed);
  249.             bar1.Panels[0].Text:='正在下载：'+inttostr(pTF^.transed);
  250.           end;
  251.           if pTF^.aAPI=Fend then
  252.           begin
  253.             localpath:=extractfilepath(localfilename);
  254.             {
  255.             newfilename:=localpath+decryptFilename(extractfilename(localfilename));
  256.             if(newfilename<>localfilename)then
  257.             begin
  258.               renamefile(localfilename,newfilename);
  259.               uFuncs.cryptfile(newfilename);
  260.             end;
  261.             }
  262.             memoInfo.lines.add('下载完成：'+localfilename);
  263.             bar1.Panels[0].Text:='下载完成：'+inttostr(pTF^.transed);
  264.             listFileInfo.Items[i].SubItems.Strings[2]:='下载完成'+inttostr(pTF^.transed);
  265.             file1.Update;
  266.           end;
  267.         end;
  268.         //loadfile(localfilename);
  269.       end;
  270.     end;
  271.   end;
  272. end;
  273. procedure TfMain.TryExcepts(Sender: TObject; E: Exception);
  274. begin
  275.   Log(E.Message);
  276.   //memoINfo.Lines.Add(Log(E.Message));
  277.   //Log(
  278. end;
  279. procedure TfMain.btnCloseClick(Sender: TObject);
  280. begin
  281.   close;
  282. end;
  283.  
  284. procedure TfMain.btnDownloadClick(Sender: TObject);
  285. var
  286.   localFilename,remoteFilename:string;
  287.   i:integer;
  288. begin
  289.   if(ListFileInfo.SelCount=0)then
  290.   begin
  291.     showmessage('请选择要下载的文件！');
  292.     exit;
  293.   end;
  294.   for I := 0 to ListFileInfo.Items.Count-1 do
  295.   begin
  296.     if(ListFileInfo.Items[i].Selected)then
  297.     begin
  298.       remoteFilename:=ListFileInfo.Items[i].Caption;
  299.       localFilename:=file1.Directory+'\'+remoteFilename;
  300.       uTransFileClient.downloadFile(localFilename,remoteFilename,i);
  301.     end;
  302.   end;
  303.  
  304.  
  305.  
  306.  
  307.  
  308. end;
  309.  
  310. procedure TfMain.btnListClick(Sender: TObject);
  311. begin
  312.   uTransFileClient.ProcessListFile();
  313. end;
  314.  
  315. procedure TfMain.btnSelAllClick(Sender: TObject);
  316. begin
  317.   ListFileInfo.SelectAll;
  318. end;
  319.  
  320. procedure TfMain.btnDecryptFileClick(Sender: TObject);
  321. begin
  322.   //cryptfile('c:\temp\0310\2');
  323.   decryptfile(file1.Items);
  324.   dir1.Update;
  325.   file1.Update;
  326.  
  327.   bar1.Panels[1].Text:=''+inttostr(file1.Items.Count)+'个文件';
  328. end;
  329.  
  330. procedure TfMain.btnUploadClick(Sender: TObject);
  331. var
  332.   localFilename,remoteFilename:string;
  333.   i:integer;
  334. begin
  335.   if(file1.SelCount=0)then
  336.   begin
  337.     showmessage('请选择要上传的文件！');
  338.     exit;
  339.   end;
  340.   for i := 0 to file1.Count-1 do
  341.   begin
  342.     if(file1.Selected[i])then
  343.     begin
  344.       localFilename:=file1.Items[i];
  345.       remoteFilename:=extractfilename(localFilename);
  346.       uTransFileClient.uploadFile(localFilename,remoteFilename);
  347.     end;
  348.   end;
  349.  
  350.   //localFilename:=file1.FileName;
  351.   //remoteFilename:=extractfilename(localFilename);
  352.   //uTransFileClient.uploadFile(localFilename,remoteFilename);
  353. end;
  354.  
  355. procedure TfMain.FormCreate(Sender: TObject);
  356. begin
  357.   application.OnException:=TryExcepts;
  358. end;
  359.  
  360. procedure TfMain.FormShow(Sender: TObject);
  361. begin
  362.   //fmain.Caption:=uConfig.APP_NAME+uConfig.APP_VERSION+uConfig.APP_CONTACT;
  363.   fmain.Caption:=uConfig.APP_NAME+uConfig.APP_VERSION;
  364.   edtAddr.Text:=uConfig.FTS_HOST_FORGED;
  365.   edtPort.Text:=inttostr(uConfig.FTS_PORT);
  366.   uTransFileClient.hForm:=fmain.Handle;
  367.   btnList.Click();
  368.   dir1.Drive:='c';
  369.   dir1.Directory:='c:\temp';
  370. end;
  371.  
  372.  
  373.  
  374. procedure TfMain.ListFileInfoColumnClick(Sender: TObject; Column: TListColumn);
  375. begin
  376.   ListFileInfo.CustomSort(@CustomSortProc,Column.Index);
  377. end;
  378.  
  379. procedure TfMain.MenuItem1Click(Sender: TObject);
  380. var
  381.   filename:string;
  382. begin
  383.   if File1.Count=0 then exit;
  384.   if File1.ItemIndex=-1 then  exit;
  385.   filename:=File1.Items[File1.ItemIndex];
  386.   ShellExecute(Handle,pchar('open'), pchar('explorer.exe'), pchar('/select,'+filename), nil, SW_SHOW);
  387.  
  388. end;
  389.  
  390. procedure TfMain.MenuItem2Click(Sender: TObject);
  391. var
  392.   filename:string;
  393. begin
  394.   if File1.Count=0 then exit;
  395.   if File1.ItemIndex=-1 then  exit;
  396.   filename:=File1.Items[File1.ItemIndex];
  397.   ShellExecute(Handle,pchar('open'), pchar('explorer.exe'), pchar(filename), nil, SW_SHOW);
  398.  
  399. end;
  400.  
  401. procedure TfMain.N1Click(Sender: TObject);
  402. var
  403.   dir,dirname:string;
  404. begin
  405.   dir:=dir1.Directory;
  406.   dirname:= InputBox('请输入目录名：','目录名：','');//参数分别为标题，提示，默认值
  407.   if dirname<>'' then
  408.   begin
  409.     ForceDirectories(dir+'\'+dirname);
  410.     dir1.Update;
  411.   end;
  412. end;
  413.  
  414. procedure TfMain.N2Click(Sender: TObject);
  415. var
  416.   dir:string;
  417. begin
  418.   if dir1.Count=0 then exit;
  419.   if dir1.ItemIndex=-1 then  exit;
  420.   dir:=dir1.Items[File1.ItemIndex];
  421.   uFuncs.deldir(dir) ;
  422.   dir1.Update;
  423. end;
  424.  
  425. procedure TfMain.N3Click(Sender: TObject);
  426. var
  427.   filename,newfilename:string;
  428. begin
  429.   if File1.Count=0 then exit;
  430.   if File1.ItemIndex=-1 then  exit;
  431.   filename:=File1.Items[File1.ItemIndex];
  432.   newfilename:= InputBox('请输入文件名：','文件名：','');//参数分别为标题，提示，默认值
  433.   if newfilename<>'' then
  434.   begin
  435.     movefile(pchar(filename),pchar(newfilename));
  436.     File1.Update;
  437.   end;
  438.  
  439. end;
  440.  
  441. procedure TfMain.N4Click(Sender: TObject);
  442. var
  443.   filename:string;
  444. begin
  445.   if File1.Count=0 then exit;
  446.   if File1.ItemIndex=-1 then  exit;
  447.   filename:=File1.Items[File1.ItemIndex];
  448.   deletefile(filename);
  449.   file1.Update;
  450. end;
  451.  
  452. function CustomSortProc(Item1, Item2: TListItem; ColumnIndex: integer): integer; stdcall;
  453. begin
  454. if ColumnIndex = 0 then
  455.   Result := CompareText(Item1.Caption,Item2.Caption)
  456. else
  457.   Result := CompareText(Item1.SubItems[ColumnIndex-1],Item2.SubItems[ColumnIndex-1])
  458. end;
  459. end.

 

声明：本文内容由网友自发贡献，不代表【wpsshop博客】立场，版权归原作者所有，本站不承担相应法律责任。如您发现有侵权的内容，请联系我们。转载请注明出处：https://www.wpsshop.cn/w/盐析白兔/article/detail/142706
推荐阅读
相关标签

Copyright © 2003-2013 www.wpsshop.cn 版权所有，并保留所有权利。

  

闽ICP备14008679号