Delphi实现木马文件传输代码实例

unit ServerFrm;

interface

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

type
 TfrmMain = class(TForm)
  Panel1: TPanel;
  Label1: TLabel;
  edtPort: TEdit;
  Panel2: TPanel;
  stabar: TStatusBar;
  SaveDialog: TSaveDialog;
  btnListen: TButton;
  btnReceive: TButton;
  btnStop: TButton;
  btnExit: TButton;
  procedure FormCreate(Sender: TObject);
  procedure btnExitClick(Sender: TObject);
  procedure FormClose(Sender: TObject; var Action: TCloseAction);
  procedure btnListenClick(Sender: TObject);
  procedure btnReceiveClick(Sender: TObject);
  procedure btnStopClick(Sender: TObject);
 private
  { Private declarations }
 public
  { Public declarations }
  StopTrans:Boolean; //是否停止传送开关
  InTrans:Boolean; //表示正在接收文件
  Server:TSocket; //定义服务器端的socket句柄
  //自定义过程接收文件
  procedure RecvFile(FileName:String);
 end;

var
 frmMain: TfrmMain;

const
 BlockLen=1024*4;

implementation

{$R *.dfm}

procedure tfrmmain.RecvFile(FileName:String);
var
 Ftrans:file of Byte;
 Recelen:Integer;
 Blockbuf:array[0..BlockLen-1] of Byte;
 RecvSocket:TSocket;
 ra:Sockaddr_in;
 ra_len:integer;
begin
 ra_len:=sizeof(ra);
 Recvsocket:=accept(server,@ra,@ra_len);
 assignFile(Ftrans,filename);
 rewrite(ftrans);
 stoptrans:=false;
 intrans:=true;
 recelen:=recv(recvsocket,Blockbuf,BlockLen,0);
 while (recelen>0) and (not StopTrans) do
 begin
  BlockWrite(Ftrans,Blockbuf[0],BlockLen);
  application.ProcessMessages;
  recelen:=recv(recvsocket,Blockbuf,Blocklen,0);
  if stoptrans then
  begin
   CloseFile(Ftrans);
   CloseSocket(RecvSocket);
   InTrans:=False;
   MessageBox(Handle,'停止传输!','提示',MB_OK);
   EXIT;
  END;
 END;
 //关闭文件,接收的SOCKET
 CloseFile(Ftrans);
 Closesocket(recvsocket);
 InTrans:=False;
 if (Recelen=SOCKET_ERROR) then
  messagebox(handle,'传输异常终止!','提示',MB_OK)
 ELSE
  MESSAGEBOX(HANDLE,'客户端已经关闭连接1,文件可能已经传送完毕了!','提示',MB_OK);

end; 

procedure TfrmMain.FormCreate(Sender: TObject);
var
 aWSAData:TWSAData;
begin
 if WSAStartup($0101,aWSAData)<>0 then
  raise Exception.Create('不能启动WinSock动态链接库');
 messageBox(Handle,aWSAdata.szDescription ,'WinSock动态链接库版本',mb_ok);

end;

procedure TfrmMain.btnExitClick(Sender: TObject);
begin
 Close;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 if InTrans then
  if MessageBox(handle,'正在接收文件,停止吗？','提示',MB_YESNO)=IDNO then
   abort;

 IF SERVER<>INVALID_SOCKET THEN
   CLOSESOCKET(SERVER);
  //释放winsock动态链接库所创建的资源
 if WSACleanup<>0 then
  messagebox(handle,'清除Winsock动态链接库错误！','提示',MB_OK)
 ELSE
  messagebox(handle,'清除Winsock动态链接库成功！','提示',MB_OK);

end;

procedure TfrmMain.btnListenClick(Sender: TObject);
var
 ca:SOCKADDR_IN;
begin
 //创建服务器端SOCKET
 Server:=Socket(PF_INET,SOCK_STREAM,IPPROTO_IP);
 IF server=invalid_socket then
 begin
  stabar.SimpleText :='创建接收SOCKET错误1';
  exit;
 end;
 //绑定服务器端SOCKET
 ca.sin_family :=PF_INET;
 CA.sin_port :=htons(strtoint(trim(edtPort.Text )));
 ca.sin_addr.S_addr :=INADDR_ANY;
 if bind(server,ca,sizeof(ca))=socket_error then
 begin
  stabar.SimpleText :='绑定socket错误,请更改接收端口';
  closeSocket(server);
  exit;
 end
 else
  stabar.SimpleText :='绑定接收端socket成功!';

 //开始监听
 listen(server,5);
 btnlisten.Enabled :=False;
 btnstop.Enabled :=true;

end;

procedure TfrmMain.btnReceiveClick(Sender: TObject);
begin
 if (server=INVALID_SOCKET) THEN
 BEGIN
  MESSAGEBOX(HANDLE,'还没有进行监听,请先进行监听!','提示',MB_OK);
  EXIT;
 END;
 IF SaveDialog.Execute THEN
  RECVFILE(SaveDialog.FileName );
  
end;

procedure TfrmMain.btnStopClick(Sender: TObject);
begin
 STOPTRANS:=TRUE;
 IF SERVER<>INVALID_SOCKET THEN cLOSESOCKET(SERVER);
 //此处需要说明
 server:=INVALID_SOCKET;
 bTNSTOP.Enabled :=fALSE;
 BTNlISTEN.Enabled :=TRUE;
end;

end.

unit ClientFrm;

interface

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

type
 TfrmMain = class(TForm)
  opendfile: TOpenDialog;
  Label1: TLabel;
  edtIP: TEdit;
  Label2: TLabel;
  edtPort: TEdit;
  StatusBar: TStatusBar;
  btnConnect: TButton;
  btnSend: TButton;
  btnStop: TButton;
  btnExit: TButton;
  ProgressBar: TProgressBar;
  procedure FormCreate(Sender: TObject);
  procedure btnExitClick(Sender: TObject);
  procedure FormClose(Sender: TObject; var Action: TCloseAction);
  procedure btnConnectClick(Sender: TObject);
  procedure btnSendClick(Sender: TObject);
  procedure btnStopClick(Sender: TObject);
 private
  { Private declarations }
   Client:TSocket;
 public
  { Public declarations }
  StopTrans:Boolean; //是否停止发送的开发
  InTrans:Boolean;  //表示是否正在传送文件
  procedure TransFile(FileName:String); //传递文件的过程
 end;

 const BlockLen=1024*4; //每次发送的最大数据量

var frmMain: TfrmMain;

implementation{$R *.dfm}

procedure TfrmMain.TransFile(FileName:String); //传递文件的过程
var
 Ftrans:file of Byte;
 Flen:integer;
 BlockNum,RemainLen:integer;
 BlockBuf:array[0..BlockLen-1] of Byte;
 i:integer;
 SendLen:Integer;
begin
 assignFile(Ftrans,filename);
 reset(Ftrans);
 Flen:=FileSize(Ftrans);
 BlockNum:=Flen div BlockLen;
 progressBar.Max :=1+BlockNum;
 RemainLen:=Flen mod BlockLen;
 StopTrans:=False;
 InTrans:=True;
 SendLen:=1;
 for i:=0 to BlockNum-1 do
 begin
  if (StopTrans) or (SendLen<=0) then Break;
  BlockRead(Ftrans,Blockbuf[0],BlockLen);
  SendLen:=Send(Client,Blockbuf,BlockLen,0);
  ProgressBar.Position :=i;
  Application.processMessages;
 end;
 if StopTrans then
 begin
  CloseFile(Ftrans);
  InTrans:=False;
  StatusBar.SimpleText :='';
  MessageBox(Handle,'停止传输!','提示',mb_ok);
  progressbar.Position :=0;
  exit;
 end;
 if (SendLen<=0) then
 begin
  CloseFile(Ftrans);
  InTrans:=False;
  StatusBar.SimpleText :='';
  messagebox(handle,'传出异常终止!','提示',MB_OK);
  progressBar.Position :=0;
  exit;
 end;
 if remainLen>0 then
 begin
  BlockRead(Ftrans,BlockBuf[0],RemainLen);
  SendLen:=send(client,BlockBuf,Remainlen,0);
  if (sendLen<=0) then
  begin
   closeFile(Ftrans);
   InTrans:=False;
   StatusBar.SimpleText :='';
   messagebox(handle,'传输异常终止!','提示',mb_ok);
   progressBar.Position :=0;
   exit;
  end;
 end;
 progressBar.Position :=ProgressBar.Max ;
 CloseFile(Ftrans);
 InTrans:=False;
 StatusBar.SimpleText :='';
 messagebox(handle,'传输完成!','提示',mb_ok);
 progressbar.Position :=0;

end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
 aWSAData:TWSAData;
begin
 if WSAStartup($0101,aWSAData)<>0 then
  raise Exception.Create('不能启动WinSock动态链接库');
 messageBox(Handle,aWSAdata.szDescription ,'WinSock动态链接库版本',mb_ok);

end;

procedure TfrmMain.btnExitClick(Sender: TObject);
begin
 Close;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 if InTrans then
  if MessageBox(handle,'正在传输文件,停止吗？','提示',MB_YESNO)=IDNO then
   abort;
  //释放winsock动态链接库所创建的资源
  if WSACleanup<>0 then
   messagebox(handle,'清除Winsock动态链接库错误！','提示',MB_OK)
  ELSE
   messagebox(handle,'清除Winsock动态链接库成功！','提示',MB_OK);
  CloseSocket(Client);
end;

procedure TfrmMain.btnConnectClick(Sender: TObject);
var
 ca:SOCKADDR_IN;
 hostaddr:u_long;
begin
 Client:=Socket(PF_INET,SOCK_STREAM,IPPROTO_IP);
 IF CLIENT=INVALID_SOCKET THEN
 BEGIN
  StatusBar.SimpleText :='为连接远程服务器端创建COSKET错误!';
  exit;
 end;
 ca.sin_family :=PF_INET;
 CA.sin_port :=HTONS(STRTOINT(TRIM(EDTpORT.Text )));
 HOSTADDR:=INET_ADDR(PCHAR(TRIM(EDTIP.Text )));
 //判断IP是否合法
 if (hostaddr= -1) then
 begin
  StatusBar.SimpleText :='主机IP地址：'+trim(edtip.Text )+'错误';
  exit;
 end
 else
  ca.sin_addr.S_addr :=hostaddr;
 //连接服务器
 if connect(Client,ca,sizeof(ca))<>0 then
 begin
  StatusBar.SimpleText :='连接服务器端SOCKET错误!';
  exit;
 end
 else
  StatusBar.SimpleText :='连接远程SOCKET成功!';

end;

procedure TfrmMain.btnSendClick(Sender: TObject);
begin
 if (opendfile.Execute ) and (FileExists(opendfile.FileName )) then
  transFile(opendfile.FileName );
end;

procedure TfrmMain.btnStopClick(Sender: TObject);
begin
 Stoptrans:=True;
end;

end.