Delphi笔记-Indy10.5.5 IdTcpServer 与 IdTcpClient Demo

//客户端

unit
 UntClt;




interface





uses


  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ComCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,

  StdCtrls, UntGlb, IdGlobal, ExtCtrls, ImgList, jpeg, WinSock, IdIPWatch;




type


  TForm1 
=
 
class
(TForm)

    stat1: TStatusBar;

    img1: TImage;

    lbl1: TLabel;

    btn1: TButton;

    chk1: TCheckBox;

    edt1: TEdit;

    btn2: TButton;

    btn3: TButton;

    btn4: TButton;

    btn5: TButton;

    grp1: TGroupBox;

    lst1: TListBox;

    idtcpclnt1: TIdTCPClient;

    BalloonHint1: TBalloonHint;

    il1: TImageList;

    dlgOpen1: TOpenDialog;

    ProgressBar1: TProgressBar;

    btnCancle: TButton;

    IdIPWatch1: TIdIPWatch;

    
procedure
 btn1Click(Sender: TObject);

    
procedure
 chk1Click(Sender: TObject);

    
procedure
 idtcpclnt1Disconnected(Sender: TObject);

    
procedure
 btn2Click(Sender: TObject);

    
procedure
 idtcpclnt1Connected(Sender: TObject);

    
procedure
 FormCreate(Sender: TObject);

    
procedure
 btn5Click(Sender: TObject);

    
procedure
 btn3Click(Sender: TObject);

    
procedure
 btn4Click(Sender: TObject);

    
procedure
 WMMOVE(
var
 msg: TMessage); 
message
 WM_MOVE;

    
procedure
 WMUSERMSG(
var
 msg: TMessage); 
message
 WM_USERMSG;

    
procedure
 ShowProgressBar(Visible: Boolean);

    
procedure
 btnCancleClick(Sender: TObject);

  
private


    
{
 Private declarations 
}


    ComputerName: 
string
;



  
public


    
{
 Public declarations 
}


    UserBreakAll: Boolean;



  
end
;



  TFileThread 
=
 
class
(TThread)

  
private


    
//
 CB: TDataPack;

  
protected


    
procedure
 Execute; 
override
;

  
end
;



  TMonitorThread 
=
 
class
(TThread)

  
protected


    
procedure
 Execute; 
override
;

  
end
;




var


  Form1: TForm1;

  FileThread: TFileThread;

  MonitorThread: TMonitorThread;

  AllowDisconnectedEvent: Boolean 
=
 False;


function
 SendARP(Destip, scrip: DWORD; pmacaddr: PDWORD;

  VAR phyAddrlen: DWORD): DWORD; 
stdcall
; 
external
 
'
iphlpapi.dll
'
;




implementation





{
$R *.dfm
}





function
 GetMacFromIP(IP: AnsiString): AnsiString;


type


  Tinfo 
=
 
array
 [
0
 .. 
7
] 
of
 Byte;


var


  dwTargetIP: DWORD;

  dwMacAddress: 
array
 [
0
 .. 
1
] 
of
 DWORD;

  dwMacLen: DWORD;

  dwResult: DWORD;

  X: Tinfo;

  stemp: AnsiString;

  iloop: integer;


begin


  dwTargetIP :
=
 Inet_Addr(PAnsiChar(IP));

  dwMacLen :
=
 
6
;

  dwResult :
=
 SendARP(dwTargetIP, 
0
, @dwMacAddress[
0
], dwMacLen);

  
case
 dwResult 
of


    NO_ERROR:

      
begin


        
//
 ShowMessage(
'
查到
'
);

        X :
=
 Tinfo(dwMacAddress);

        
for
 iloop :
=
 
0
 
to
 
5
 
do


        
begin


          stemp :
=
 stemp 
+
 inttohex(X[iloop], 
2
);

        
end
;

        Result :
=
 stemp;

      
end
;

    ERROR_BAD_NET_NAME:

      Result :
=
 
'
目标IPv4地址无法送达(Windows Vista 及以后版本错误)
'
;

    ERROR_BUFFER_OVERFLOW:

      Result :
=
 
'
PhyAddrLen参数小于6(Windows Vista 及以后版本错误)
'
;

    ERROR_GEN_FAILURE:

      Result :
=
 
'
目标IPv4地址无法送达(Windows Server 2003及之前版本错误)
'
;

    ERROR_INVALID_PARAMETER:

      Result :
=
 
'
pMacAddr或PhyAddrLen参数是一个NULL指针(Windows Server 2003及之前版本错误)
'
;

    ERROR_INVALID_USER_BUFFER:

      Result :
=
 
'
PhyAddrLen参数为零(Windows Server 2003及之前版本错误)
'
;

    
//
 ERROR_NOT_FOUND:Result :
=
'
非INADDR_ANY的IP地址(IPv4地址为0.0.0.0)(Windows Vista 错误)
'
;

    ERROR_NOT_SUPPORTED:

      Result :
=
 
'
本机操作系统不支持该函数
'
;

  
else


    Result :
=
 
'
未知
'
;

  
end
;


end
;




function
 GetWindowsVersionString: AnsiString;


var


  VI: TOSVersionInfoA;


begin


  VI.dwOSVersionInfoSize :
=
 SizeOf(TOSVersionInfoA);

  
if
 GetVersionExA(VI) 
then


    
with
 VI 
do


      Result :
=
 Trim(Format(
'
%d.%d build %d %s
'
, [dwMajorVersion,

          dwMinorVersion, dwBuildNumber, szCSDVersion]))

    
else


      Result :
=
 
''
;


end
;




function
 GetWindowsVersion: String; 
//
 读取操作系统版本


var


  AWin32Version: Extended;

  os: 
string
;


begin


  os :
=
 
'
Windows 
'
;

  AWin32Version :
=
 StrtoFloat(Format(
'
%d.%d
'
, [Win32MajorVersion,

      Win32MinorVersion]));

  
if
 Win32Platform 
=
 VER_PLATFORM_WIN32s 
then


    Result :
=
 os 
+
 
'
32
'


  
else
 
if
 Win32Platform 
=
 VER_PLATFORM_WIN32_WINDOWS 
then


  
begin


    
if
 AWin32Version 
=
 
4.0
 
then


      Result :
=
 os 
+
 
'
95
'


    
else
 
if
 AWin32Version 
=
 
4.1
 
then


      Result :
=
 os 
+
 
'
98
'


    
else
 
if
 AWin32Version 
=
 
4.9
 
then


      Result :
=
 os 
+
 
'
Me
'


    
else


      Result :
=
 os 
+
 
'
9x
'


  
end


  
else
 
if
 Win32Platform 
=
 VER_PLATFORM_WIN32_NT 
then


  
begin


    
if
 AWin32Version 
=
 
3.51
 
then


      Result :
=
 os 
+
 
'
NT 3.51
'


    
else
 
if
 AWin32Version 
=
 
4.0
 
then


      Result :
=
 os 
+
 
'
NT 4.0
'


    
else
 
if
 AWin32Version 
=
 
5.0
 
then


      Result :
=
 os 
+
 
'
2000
'


    
else
 
if
 AWin32Version 
=
 
5.1
 
then


      Result :
=
 os 
+
 
'
XP
'


    
else
 
if
 AWin32Version 
=
 
5.2
 
then


      Result :
=
 os 
+
 
'
2003
'


    
else
 
if
 AWin32Version 
=
 
6.0
 
then


      Result :
=
 os 
+
 
'
Vista
'


    
else
 
if
 AWin32Version 
=
 
6.1
 
then


      Result :
=
 os 
+
 
'
7
'


    
else


      Result :
=
 os;

  
end


  
else


    Result :
=
 os 
+
 
'
??
'
;

  Result :
=
 Result 
+
 
'
  
'
 
+
 GetWindowsVersionString;


end
;




procedure
 TForm1.btn1Click(Sender: TObject);


begin


  close;


end
;




procedure
 TForm1.btn2Click(Sender: TObject);


var


  i: integer;


begin


  
if
 dlgOpen1.Execute(Handle) 
then


  
begin


    
for
 i :
=
 
0
 
to
 dlgOpen1.Files.Count 
-
 
1
 
do


      lst1.Items.add(dlgOpen1.Files[i]);

  
end
;

  grp1.Caption :
=
 GroupText 
+
 Format(FileListString, [lst1.Count]);


end
;




procedure
 TForm1.btn3Click(Sender: TObject);


begin


  lst1.Clear;

  grp1.Caption :
=
 GroupText 
+
 Format(FileListString, [
0
]);


end
;




procedure
 TForm1.btn4Click(Sender: TObject);


begin


  lst1.DeleteSelected;

  grp1.Caption :
=
 GroupText 
+
 Format(FileListString, [lst1.Count]);


end
;




procedure
 TForm1.btn5Click(Sender: TObject);


var


  DlgText: 
string
;


begin




  
if
 idtcpclnt1.Connected 
then


  
begin


    
if
 lst1.Count 
>
 
0
 
then


    
begin


      DlgText :
=
 Format(DlgSendFileText, [lst1.Count]);

      
if
 Application.MessageBox(PChar(DlgText), 
'
发送提示
'
,

        MB_OKCANCEL 
+
 MB_ICONQUESTION) 
=
 IDOK 
then


      
begin


        ShowProgressBar(True);

        FileThread :
=
 TFileThread.Create(True);

        FileThread.FreeOnTerminate :
=
 True;

        FileThread.Start;

      
end
;

    
end


    
else


      ShowMessage(DlgSelectFile);

  
end


  
else


    ShowMessage(DlgNoConnected);


end
;




procedure
 TForm1.btnCancleClick(Sender: TObject);


begin


  UserBreakAll :
=
 True;


end
;




procedure
 TForm1.chk1Click(Sender: TObject);


begin


  idtcpclnt1.Host :
=
 edt1.Text;

  
if
 chk1.Checked 
then


  
begin


    
try


      Application.ProcessMessages;

      idtcpclnt1.Connect;

      AllowDisconnectedEvent :
=
 True;

      stat1.Panels[
1
].Text :
=
 StaConnected;

    
except


      ShowMessage(DlgConnectFailed);

    
end
;



  
end


  
else


  
begin


    AllowDisconnectedEvent :
=
 False;

    idtcpclnt1.Disconnect;

  
end
;



  chk1.Checked :
=
 idtcpclnt1.Connected;


end
;




procedure
 TForm1.FormCreate(Sender: TObject);


var


  n: Cardinal;

  Name: 
array
 [
0
 .. MAX_COMPUTERNAME_LENGTH] 
of
 Char;


begin


  n :
=
 MAX_COMPUTERNAME_LENGTH 
+
 
1
;

  GetComputerName(name, n);

  ComputerName :
=
 
string
(Name);

  MonitorThread :
=
 TMonitorThread.Create(True);

  MonitorThread.FreeOnTerminate :
=
 True;

  MonitorThread.Start;


end
;




procedure
 TForm1.idtcpclnt1Connected(Sender: TObject);


var


  bbuf: TIdBytes;

  buf: TDataPack;


begin


  bbuf :
=
 
nil
;

  FillChar(buf, SizeOf(buf), 
''
);

  buf.Command :
=
 cmdSetName;

  StrPCopy(buf.ClientInfo.ClientName ,ComputerName);

  StrPCopy(buf.ClientInfo.ClientOS,GetWindowsVersion);

  StrPCopy(buf.ClientInfo.ClientACTIP ,GetMacFromIP(IdIPWatch1.LocalIP));

  bbuf :
=
 RawToBytes(buf, SizeOf(buf));

  idtcpclnt1.IOHandler.Write(bbuf);


end
;




procedure
 TForm1.idtcpclnt1Disconnected(Sender: TObject);


begin


  stat1.Panels[
1
].Text :
=
 StaDisconnected;

  chk1.Checked :
=
 False;




end
;




procedure
 TForm1.ShowProgressBar(Visible: Boolean);


begin


  ProgressBar1.Visible :
=
 Visible;

  btnCancle.Visible :
=
 Visible;


end
;




procedure
 TForm1.WMMOVE(
var
 msg: TMessage);


begin


  
//
 
inherited
;

  
//
 
if
 Assigned(frmProgress) 
then


  
//
 frmProgress.Position :
=
 poMainFormCenter;


end
;




procedure
 TForm1.WMUSERMSG(
var
 msg: TMessage);


begin


  
case
 msg.WParam 
of


    
1
:

      ShowMessage(Format(DlgFileSendOk, [msg.LParam]));

    
2
:

      stat1.Panels[
1
].Text :
=
 
string
(PChar(msg.LParam));

    
3
:

      ProgressBar1.Position :
=
 msg.LParam;

    
4
:

      ProgressBar1.Max :
=
 msg.LParam;

    
5
:

      idtcpclnt1.OnDisconnected(Self);

    
6
:

      ShowMessage(DlgExcept);

    
7
:

      ShowProgressBar(False);

  
end
;




end
;




{
 TFileThread 
}





procedure
 TFileThread.Execute;


var


  FileName: 
string
;

  buf: TDataPack;

  bbuf: TIdBytes;

  i, j, SendTimes, RemainLen, h, FileLen, SentFilesNum,

    ClientReadedBytes: integer;


begin


  
try


    Form1.UserBreakAll :
=
 False;

    SentFilesNum :
=
 
0
;

    
for
 i :
=
 
0
 
to
 Form1.lst1.Count 
-
 
1
 
do


    
begin


      
if
 Form1.UserBreakAll 
then


        Break;

      FileName :
=
 Form1.lst1.Items[i];

      
//
 frmProgress.lbl1.Caption :
=
 FileName;

      
//
 frmProgress.pb1.Position :
=
 
0
;

      PostMessage(Form1.Handle, WM_USERMSG, 
2
, integer(PChar(FileName)));

      PostMessage(Form1.Handle, WM_USERMSG, 
3
, 
0
);

      h :
=
 FileOpen(FileName, fmOpenRead);

      
if
 h 
>
 
0
 
then


      
begin


        
try


          FileLen :
=
 GetFileSize(h, 
nil
);

          SendTimes :
=
 FileLen 
div
 SEND_BUF;

          RemainLen :
=
 FileLen 
mod
 SEND_BUF;

          
//
 frmProgress.pb1.Max :
=
 FileLen;

          PostMessage(Form1.Handle, WM_USERMSG, 
4
, FileLen);

          FillChar(buf.ClientInfo, SizeOf(buf.ClientInfo), 
''
);

          buf.Command :
=
 cmdSendFile;

          StrPCopy(buf.FileName,ExtractFileName(FileName));

          buf.FileSize :
=
 FileLen;

          buf.Flags :
=
 
0
; 
//
 新建



          
for
 j :
=
 
1
 
to
 SendTimes 
do


          
begin


            
if
 Form1.UserBreakAll 
then


              Break;

            
if
 
not
 Form1.idtcpclnt1.Connected 
then


              Break;

            ClientReadedBytes :
=
 FileRead(h, buf.FileData, SEND_BUF);

            buf.ReadBytes :
=
 ClientReadedBytes;

            bbuf :
=
 
nil
;

            bbuf :
=
 RawToBytes(buf, SizeOf(buf));

            Form1.idtcpclnt1.IOHandler.Write(bbuf);

            buf.Flags :
=
 
1
; 
//
 续传

            
//
 frmProgress.pb1.Position :
=
 j 
*
 SEND_BUF;

            PostMessage(Form1.Handle, WM_USERMSG, 
3
, j 
*
 SEND_BUF);

          
end
;

          
if
 RemainLen 
>
 
0
 
then


          
begin


            
if
 
not
 Form1.idtcpclnt1.Connected 
then


              Break;

            ClientReadedBytes :
=
 FileRead(h, buf.FileData, RemainLen);

            buf.ReadBytes :
=
 ClientReadedBytes;

            bbuf :
=
 
nil
;

            bbuf :
=
 RawToBytes(buf, SizeOf(buf));

            Form1.idtcpclnt1.IOHandler.Write(bbuf);



            PostMessage(Form1.Handle, WM_USERMSG, 
3
, FileLen);

          
end
;

        
finally


          FileClose(h);

        
end
;

        
if
 (
not
 Form1.UserBreakAll) 
then


          inc(SentFilesNum);

      
end
;

    
end
;

    PostMessage(Form1.Handle, WM_USERMSG, 
7
, 
0
);

    PostMessage(Form1.Handle, WM_USERMSG, 
1
, SentFilesNum);

    
if
 Form1.idtcpclnt1.Connected 
and
 Form1.UserBreakAll 
then


    
begin


      bbuf :
=
 
nil
;

      buf.Command :
=
 cmdUserbreak;

      bbuf :
=
 RawToBytes(buf, SizeOf(buf));

      Form1.idtcpclnt1.IOHandler.Write(bbuf);

    
end
;

  
except


    PostMessage(Form1.Handle, WM_USERMSG, 
7
, 
0
);

    PostMessage(Form1.Handle, WM_USERMSG, 
6
, 
0
);

    AllowDisconnectedEvent :
=
 False;

    Form1.idtcpclnt1.Disconnect;

    Terminate;

  
end
;


end
;




{
 TMonitorThread 
}





procedure
 TMonitorThread.Execute;


begin


  
while
 
not
 Terminated 
do


  
begin


    
if
 
not
 Form1.idtcpclnt1.Connected 
then


      
if
 AllowDisconnectedEvent 
then


      
begin


        AllowDisconnectedEvent :
=
 False;

        PostMessage(Form1.Handle, WM_USERMSG, 
5
, 
0
);

      
end
;

    Sleep(
100
);

  
end
;


end
;




end
.






















//公共单元

unit
 UntGlb;




interface



uses


  Messages,Windows, SysUtils,Classes ;




const


  WM_USERMSG 
=
 WM_USER 
+
1002
;

  WM_USERFILE
=
 WM_USER 
+
1003
;

  ADD_LIST 
=
 
0
;

  DEL_LIST 
=
1
;

  UPD_STA  
=
2
;

  SHOW_R   
=
3
;

  SEND_BUF 
=
 
1024
*
20
;

  REV 
=
  
'
REV
'
;

  IniFileName 
=
 
'
Server.ini
'
;




type


  TCommand 
=
 (cmdSetName,cmdSendFile,cmdUserbreak,cmdGetClientInfo);



  TClientInfo 
=
 
packed
 
record


    ClientName        : 
array
[
0
..
49
] 
of
 Char;

    ClientIP          : 
array
[
0
..
14
] 
of
 Char;

    ClientID          : 
array
[
0
..
9
] 
of
 Char;

    ClientACTIP       : 
array
[
0
..
17
] 
of
 Char;

    ClientOS          : 
array
[
0
..
49
] 
of
 Char;

    ClientStatus      : 
array
[
0
..
9
] 
of
 Char;

    ReceivedFileName  : 
array
[
0
..
255
] 
of
 Char;

    ReceivedPersent,

    ReceivedFileSize  : Cardinal;

    Flags             : Integer;

    IdleTime          : TTime;

    Isbusy            : Boolean;

  
end
;



  TDataPack  
=
 
packed
 
record


    Flags       :   Integer;

    FileSize,

    ReadBytes   :   Cardinal;

    Command     :   TCommand;

    ClientInfo  :   TClientInfo;

    FileName    :   
array
[
0
..
255
] 
of
 Char;

    FileData    :   
array
[
0
..SEND_BUF 
-
1
] 
of
 Byte;

  
end
;




resourcestring


  MainFormCaption         
=
 
'
Indy10.5.5 IdTcpServer Demo
'
;

  StringsObjectName       
=
 
'
object
'
;

  GroupText               
=
 
'
发送文件列表
'
;

  FileListString          
=
 
'
(%d个文件)
'
;

  DlgCreateIniFailed      
=
 
'
创建配置文件失败,请检查磁盘空间
'
;

  DlgIniFileBreak         
=
 
'
配置文件损坏，重新创建失败
'
;

  DlgIniNotExists         
=
 
'
配置文件不存在
'
;

  DlgIniBusy              
=
 
'
配置文件被占用
'
;

  DlgSendFileText         
=
 
'
您确定要发送列表中的%d个文件吗？
'
;

  DlgSendFileCaption      
=
 
'
发送提示
'
;

  DlgFileSendOk           
=
 
'
%d个文件发送成功
'
;

  DlgSelectFile           
=
 
'
请选择待发送的文件
'
;

  DlgNoConnected          
=
 
'
未连接服务器
'
;

  DlgFileExists           
=
 
'
文件%s已存在，要替换吗?
'
;

  DlgLogOk                
=
 
'
日志保持成功
'
;

  DlgLogFailed            
=
 
'
日志保存失败
'
;

  DlgConnectFailed        
=
 
'
连接被拒绝，可能服务器没有开启
'
;

  DlgExcept               
=
 
'
服务器端异常断开，文件传输中止!
'
;

  StaInitText             
=
 
'
服务器未开启
'
;

  StaText                 
=
 
'
客户端连接数:%d个
'
;

  StaConnected            
=
 
'
已链接到服务器
'
;

  StaDisconnected         
=
 
'
已从服务器断开
'
;

  StaServerStart          
=
 
'
服务器开启
'
;

  StaServerClose          
=
 
'
服务器关闭
'
;

  StaReceivedPersent      
=
 
'
接收文件：%s--(%u%%)
'
;

  LogTxt                  
=
 
'
------服务器操作日志------
'
+
#
13
+
#
10
;

  LogServerStart          
=
 
'
【服务器开启--%s】
'
;

  LogServerClose          
=
 
'
【服务器关闭--%s】
'
;

  LogClientdisConnected   
=
 
'
【客户端：%s,%s】从服务器断开--%s
'
;

  LogClientConnected      
=
 
'
【客户端：%s,%s】连接到服务器--%s
'
;

  LogReceiveFile          
=
 
'
【客户端：%s】正在发送文件： %s(大小：%u字节)--%s
'
;

  LogReceiveFileOk        
=
 
'
【客户端：%s】发送的文件： %s  接收完毕，保存在REV子目录下--%s
'
;

  LogUerBreakSend         
=
 
'
【客户端：%s】用户终止文件： %s  传送--%s
'
;

  LogClientStateSleep     
=
 
'
空闲
'
;

  LogClientStateBusy      
=
 
'
数据传输中
'
;

  LogClientTimeOut        
=
 
'
客户端空闲超时，断开连接...
'
  ;

  bhBalloonHint           
=
 
'
欢迎使用,双击显示界面
'
;

  bhBalloonTitle          
=
 
'
Indy10.5.5Demo
'
;

  dlgInputBoxCpt          
=
 
'
客户端连接数设置
'
;

  dlgInputBox             
=
 
'
最大连接数
'
;




implementation





end
.