Delphi implementation Trojan File transfer code example _delphi

This paper describes the implementation process of the file transfer method of the Trojan Horse under Delphi, and the concrete steps are as follows:

Server-side code:

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; Whether to stop the transfer switch Intrans:boolean; Indicates that a file server:tsocket is being received;
 Define the server-side socket handle//Custom procedure receive file 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 (don't 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, ' Stop transmission! ', ' hint ', MB_OK);
  EXIT;
 End;
 End;
 Closes the file, receives the socket CloseFile (Ftrans);
 Closesocket (Recvsocket);
 Intrans:=false; if (Recelen=socket_error) then MessageBox (handle, ' transmit abnormally terminated! ', ' Prompt ', MB_OK) ELSE MessageBox (handle, ' client has closed connection 1,

The file may have been delivered! ', ' hint ', MB_OK; 

End
Procedure Tfrmmain.formcreate (Sender:tobject); var Awsadata:twsadAta
 Begin if WSAStartup ($0101,awsadata) <>0 then raise Exception.create (' cannot start Winsock dynamic link library ');

MessageBox (handle,awsadata.szdescription, ' Winsock dynamic link library version ', 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, ' receiving files, stopping?

 ', ' hint ', Mb_yesno) =idno then abort;
  IF server<>invalid_socket THEN closesocket (SERVER); Release the resource created by the Winsock dynamic link Library If wsacleanup<>0 then MessageBox (handle, ' Purge Winsock DLL error! ', ' hint ', MB_OK ELSE MessageBox (handle, ' clear Winsock dynamic link library success!

', ' hint ', MB_OK);

End
Procedure Tfrmmain.btnlistenclick (Sender:tobject);
var ca:sockaddr_in;
 Begin//Create server-side Socket server:=socket (PF_INET,SOCK_STREAM,IPPROTO_IP); IF Server=invalid_socket THEN BEGIN Stabar.
  SimpleText: = ' Create receive socket error 1 ';
 Exit
 End
 Binding server-side 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: = ' bind socket error, please change receive Port ';
  Closesocket (server);
 Exit End Else Stabar.

 SimpleText: = ' bind receive socket successfully! ';
 Start monitoring Listen (server,5); Btnlisten.
 Enabled: =false; Btnstop.

Enabled: =true;

End
Procedure Tfrmmain.btnreceiveclick (Sender:tobject);
  Begin if (server=invalid_socket) THEN begin MESSAGEBOX (HANDLE, ' No listening, please listen! ', ' hint ', 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);
 Here need to explain server:=invalid_socket;
 btnstop.enabled: =false;
btnlisten.enabled: =true;

End
 End.

client code:

Unit clientfrm; Interface uses Windows, Messages, sysutils, variants, Classes, Graphics, Controls, Forms, Dialogs, Stdctrls, comctrls,w

Insock;
  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;  Whether to stop sending the development intrans:boolean; Indicates whether the file is being routed procedure Transfile (filename:string);

 The process end of passing the file; Const BLOCKLEN=1024*4;

The maximum amount of data per send Var Frmmain:tfrmmain; implementation{$R *.DFM} procedUre tfrmmain.transfile (filename:string);
 The process of passing a file 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 does 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, ' Stop transmission! ', ' hint ', MB_OK); ProgressBar.
  Position: = 0;
 Exit
 End
  if (sendlen<=0) THEN begin CloseFile (Ftrans);
  Intrans:=false;
  Statusbar.simpletext: = ';
  MessageBox (handle, ' outgoing abnormal termination! ', ' hint ', 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, ' transmission abnormally terminated! ', ' hint ', MB_OK);
   Progressbar.position: = 0;
  Exit
 End
 End
 Progressbar.position: =progressbar.max;
 CloseFile (Ftrans);
 Intrans:=false;
 Statusbar.simpletext: = ';
 MessageBox (handle, ' transmit complete! ', ' hint ', MB_OK); ProgressBar.

Position: = 0;

End
Procedure Tfrmmain.formcreate (Sender:tobject);
var awsadata:twsadata;
 Begin if WSAStartup ($0101,awsadata) <>0 then raise Exception.create (' cannot start Winsock dynamic link library ');

MessageBox (handle,awsadata.szdescription, ' Winsock dynamic link library version ', 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, ' transferring files, stopping?
  ', ' hint ', Mb_yesno) =idno then abort; Release WinsockThe resource created by the dynamic link library if wsacleanup<>0 then MessageBox (handle, ' clears Winsock dynamic link library error! ', ' hint ', MB_OK ELSE MessageBox (handle, ' clear Winsock dynamic link library success!
  ', ' hint ', 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: = ' Create Cosket error for connection to remote server! ';
 Exit
 End
 Ca.sin_family: =pf_inet;
 Ca.sin_port: =htons (Strtoint (TRIM (Edtport.text))); Hostaddr:=inet_addr (Pchar TRIM (Edtip).
 Text)); Determine if IP is legitimate if (hostaddr=-1) THEN BEGIN statusbar.simpletext: = ' host IP address: ' +trim (Edtip.
  Text) + ' ERROR ';
 Exit End Else Ca.sin_addr.
 S_ADDR: =hostaddr;
  Connect server if Connect (client,ca,sizeof (CA)) <>0 then begin statusbar.simpletext: = ' Connect server socket error! ';
 Exit

End else Statusbar.simpletext: = ' Connect remote socket successfully! '

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.