Delphi笔记-Indy10.5.5IdTcpServer与IdTcpClientDemo

原作者: [db:作者] 来自: [db:来源] 收藏邀请

//客户端

代码


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 
                       
                    
                     
                      



鲜花




握手




雷人




路过




鸡蛋

该文章已有0人参与评论

请发表评论

全部评论

专题导读

More+

10-27 六六分期app的软件客服如何联系？(六六分期

11-06 可心卡盟:win10系统火狐flash插件崩溃怎么

11-06 亲亲特价:怎么删除回收站图标

11-06 济南大学虚拟社区:鲁大师节能降温的具体办

11-06 xlueops.exe:无线网络安装向导

11-06 女斗合众国:win7系统cf与主机连接不稳定怎

11-06 0xc000022-[cf烟雾头]cf怎么调烟雾头

11-06 qizideyouhuo:应用程序无法正常启动0xc0000

11-06 ipz-185:win7系统vcf文件怎么打开

11-06 傻哥蹦迪:win10系统s4怎么打开usb调试

11-06 八神浩树gtaste:回收站清空了怎么恢复

11-06 妖尾之黑色守护:win10系统电脑没有1440x900

11-06 校园至尊魔王小说:win7系统浏览网页时字体

11-06 女斗合众国:win10系统访问共享文件夹提示请

11-06 tokyo hot n0654:恢复win7系统默认字体一招

11-06 雨酷仙境:设置win7系统转移临时文件夹腾出

11-06 阿穆纳伊之杖:win7系统开始菜单在右边还原

11-06 tunespotting:win10系统火狐flash插件总是

11-06 甘尔葛分析师：计谋网站seo关键词暴涨有什

11-06 蔡贵霖: 计谋网站seo关键词暴涨有什么秘密

11-06 博益网首页:ao3网页版进入不了解决方法

11-06 漏斗子专栏: 网站数据分析小白易懂精华篇

11-06 见证双虹怎么做:win7系统开启telnet命令的

11-06 颾狐蝶蜋:系统资源不足无法完成请求的服务

11-06 国光中学校歌:提交网站到alexa查询详细步骤

11-06 西安有情天:静态网页和动态网页的区别

11-06 红木雅尚斋:外部链接构造对网站的好处

11-06 前官礼遇：防止域名劫持–增强域安全性的10

11-06 密传二转答案: 中文分词算法有哪些

11-06 金泉家园邮编:百度快照劫持的表现及应对方

matlab 对数坐标发布时间：2022-07-18

图像滤波—高斯滤波——MATLAB实现发布时间：2022-07-18

剪的笔顺,诠释剪的笔画,认识剪的部首

六六分期app的软件客服如何联系？(六六分期

2023-10-27

florent37/ViewAnimator: A fluent Android

2022-08-15

florent37/Shrine-MaterialDesign2: implem

2022-08-17

CVE-2020-36276

2022-09-23

SimpleSoftwareIO/simple-sms: Send and re

2022-08-13

阅读排行榜

1 六六分期app的软件客服如何联系？(六六分期

六六分期app的软件客服如何联系？不知道吗？加qq群【895510560】即可！标题：六六分期

阅读：17972|2023-10-27

2 可心卡盟:win10系统火狐flash插件崩溃怎么

今天小编告诉大家如何处理win10系统火狐flash插件总是崩溃的问题，可能很多用户都不知

阅读：9569|2022-11-06

3 亲亲特价:怎么删除回收站图标

今天小编告诉大家如何对win10系统删除桌面回收站图标进行设置，可能很多用户都不知道

阅读：8129|2022-11-06

4 济南大学虚拟社区:鲁大师节能降温的具体办

今天小编告诉大家如何对win10系统电脑设置节能降温的设置方法，想必大家都遇到过需要

阅读：8511|2022-11-06

5 xlueops.exe:无线网络安装向导

我们在使用xp系统的过程中,经常需要对xp系统无线网络安装向导设置进行设置，可能很多

阅读：8414|2022-11-06

6 女斗合众国:win7系统cf与主机连接不稳定怎

今天小编告诉大家如何处理win7系统玩cf老是与主机连接不稳定的问题，可能很多用户都不

阅读：9309|2022-11-06

7 0xc000022-[cf烟雾头]cf怎么调烟雾头

电脑对日常生活的重要性小编就不多说了，可是一旦碰到win7系统设置cf烟雾头的问题，很

阅读：8378|2022-11-06

8 qizideyouhuo:应用程序无法正常启动0xc0000

我们在日常使用电脑的时候，有的小伙伴们可能在打开应用的时候会遇见提示应用程序无法

阅读：7810|2022-11-06

9 ipz-185:win7系统vcf文件怎么打开

今天小编告诉大家如何对win7系统打开vcf文件进行设置，可能很多用户都不知道怎么对win

阅读：8364|2022-11-06

10 傻哥蹦迪:win10系统s4怎么打开usb调试

今天小编告诉大家如何对win10系统s4开启USB调试模式进行设置，可能很多用户都不知道怎

阅读：7362|2022-11-06

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服（服务时间 9:00～18:00）

在线QQ客服

地址：深圳市南山区西丽大学城创智工业园

电邮：jeky_zhao#qq.com

移动电话：139-2527-9053

客服电话

电子邮件

Delphi笔记-Indy10.5.5IdTcpServer与IdTcpClientDemo

请发表评论

全部评论

上一篇：

下一篇：

kojino/Harvard-Robust-Machine-Learning:

数据预测之BP神经网络具体应用以及matlab代

cescoffier/puppet-nexus: A Puppet Module

文的笔顺,诠释文的笔画,解读文的部首

CVE-2015-0256