在Delphi 7开发下有强大的Indy控件,版本为9,要实现一个FTP服务器,参考自带的例子,发现还要写很多函数,而且不支持中文显示文件列表等等。

于是,自己改进封装了下,形成一个TFTPServer类。

源码如下:

 {*******************************************************}
{ }
{ 系统名称 FTP服务器类 }
{ 版权所有 (C) http://blog.csdn.net/akof1314 }
{ 单元名称 FTPServer.pas }
{ 单元功能 在Delphi 7下TIdFTPServer实现FTP服务器 }
{ }
{*******************************************************}
unit FTPServer; interface uses
Classes, Windows, Sysutils, IdFTPList, IdFTPServer, Idtcpserver, IdSocketHandle, Idglobal, IdHashCRC, IdStack;
{-------------------------------------------------------------------------------
功能: 自定义消息,方便与窗体进行消息传递
-------------------------------------------------------------------------------}
type
TFtpNotifyEvent = procedure (ADatetime: TDateTime;AUserIP, AEventMessage: string) of object;
{-------------------------------------------------------------------------------
功能: FTP服务器类
-------------------------------------------------------------------------------}
type
TFTPServer = class
private
FUserName,FUserPassword,FBorrowDirectory: string;
FBorrowPort: Integer;
IdFTPServer: TIdFTPServer;
FOnFtpNotifyEvent: TFtpNotifyEvent;
procedure IdFTPServer1UserLogin( ASender: TIdFTPServerThread; const AUsername, APassword: string; var AAuthenticated: Boolean ) ;
procedure IdFTPServer1ListDirectory( ASender: TIdFTPServerThread; const APath: string; ADirectoryListing: TIdFTPListItems ) ;
procedure IdFTPServer1RenameFile( ASender: TIdFTPServerThread; const ARenameFromFile, ARenameToFile: string ) ;
procedure IdFTPServer1RetrieveFile( ASender: TIdFTPServerThread; const AFilename: string; var VStream: TStream ) ;
procedure IdFTPServer1StoreFile( ASender: TIdFTPServerThread; const AFilename: string; AAppend: Boolean; var VStream: TStream ) ;
procedure IdFTPServer1RemoveDirectory( ASender: TIdFTPServerThread; var VDirectory: string ) ;
procedure IdFTPServer1MakeDirectory( ASender: TIdFTPServerThread; var VDirectory: string ) ;
procedure IdFTPServer1GetFileSize( ASender: TIdFTPServerThread; const AFilename: string; var VFileSize: Int64 ) ;
procedure IdFTPServer1DeleteFile( ASender: TIdFTPServerThread; const APathname: string ) ;
procedure IdFTPServer1ChangeDirectory( ASender: TIdFTPServerThread; var VDirectory: string ) ;
procedure IdFTPServer1CommandXCRC( ASender: TIdCommand ) ;
procedure IdFTPServer1DisConnect( AThread: TIdPeerThread ) ;
protected
function TransLatePath( const APathname, homeDir: string ) : string;
public
constructor Create; reintroduce;
destructor Destroy; override;
procedure Run;
procedure Stop;
function GetBindingIP():string;
property UserName: string read FUserName write FUserName;
property UserPassword: string read FUserPassword write FUserPassword;
property BorrowDirectory: string read FBorrowDirectory write FBorrowDirectory;
property BorrowPort: Integer read FBorrowPort write FBorrowPort;
property OnFtpNotifyEvent: TFtpNotifyEvent read FOnFtpNotifyEvent write FOnFtpNotifyEvent;
end; implementation {-------------------------------------------------------------------------------
过程名: TFTPServer.Create
功能: 创建函数
参数: 无
返回值: 无
-------------------------------------------------------------------------------}
constructor TFTPServer.Create;
begin
IdFTPServer := tIdFTPServer.create( nil ) ;
IdFTPServer.DefaultPort := ; //默认端口号
IdFTPServer.AllowAnonymousLogin := False; //是否允许匿名登录
IdFTPServer.EmulateSystem := ftpsUNIX;
IdFTPServer.HelpReply.text := '帮助还未实现!';
IdFTPServer.OnChangeDirectory := IdFTPServer1ChangeDirectory;
IdFTPServer.OnGetFileSize := IdFTPServer1GetFileSize;
IdFTPServer.OnListDirectory := IdFTPServer1ListDirectory;
IdFTPServer.OnUserLogin := IdFTPServer1UserLogin;
IdFTPServer.OnRenameFile := IdFTPServer1RenameFile;
IdFTPServer.OnDeleteFile := IdFTPServer1DeleteFile;
IdFTPServer.OnRetrieveFile := IdFTPServer1RetrieveFile;
IdFTPServer.OnStoreFile := IdFTPServer1StoreFile;
IdFTPServer.OnMakeDirectory := IdFTPServer1MakeDirectory;
IdFTPServer.OnRemoveDirectory := IdFTPServer1RemoveDirectory;
IdFTPServer.Greeting.Text.Text := '欢迎进入FTP服务器';
IdFTPServer.Greeting.NumericCode := ;
IdFTPServer.OnDisconnect := IdFTPServer1DisConnect;
with IdFTPServer.CommandHandlers.add do
begin
Command := 'XCRC'; //可以迅速验证所下载的文档是否和源文档一样
OnCommand := IdFTPServer1CommandXCRC;
end;
end;
{-------------------------------------------------------------------------------
过程名: CalculateCRC
功能: 计算CRC
参数: const path: string
返回值: string
-------------------------------------------------------------------------------}
function CalculateCRC( const path: string ) : string;
var
f: tfilestream;
value: dword;
IdHashCRC32: TIdHashCRC32;
begin
IdHashCRC32 := nil;
f := nil;
try
IdHashCRC32 := TIdHashCRC32.create;
f := TFileStream.create( path, fmOpenRead or fmShareDenyWrite ) ;
value := IdHashCRC32.HashValue( f ) ;
result := inttohex( value, ) ;
finally
f.free;
IdHashCRC32.free;
end;
end; {-------------------------------------------------------------------------------
过程名: TFTPServer.IdFTPServer1CommandXCRC
功能: XCRC命令
参数: ASender: TIdCommand
返回值: 无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1CommandXCRC( ASender: TIdCommand ) ;
// note, this is made up, and not defined in any rfc.
var
s: string;
begin
with TIdFTPServerThread( ASender.Thread ) do
begin
if Authenticated then
begin
try
s := ProcessPath( CurrentDir, ASender.UnparsedParams ) ;
s := TransLatePath( s, TIdFTPServerThread( ASender.Thread ) .HomeDir ) ;
ASender.Reply.SetReply( , CalculateCRC( s ) ) ;
except
ASender.Reply.SetReply( , 'file error' ) ;
end;
end;
end;
end; {-------------------------------------------------------------------------------
过程名: TFTPServer.Destroy
功能: 析构函数
参数: 无
返回值: 无
-------------------------------------------------------------------------------}
destructor TFTPServer.Destroy;
begin
IdFTPServer.free;
inherited destroy;
end; function StartsWith( const str, substr: string ) : boolean;
begin
result := copy( str, , length( substr ) ) = substr;
end; {-------------------------------------------------------------------------------
过程名: TFTPServer.Run
功能: 开启服务
参数: 无
返回值: 无
-------------------------------------------------------------------------------}
procedure TFTPServer.Run;
begin
IdFTPServer.DefaultPort := BorrowPort;
IdFTPServer.Active := True;
end; {-------------------------------------------------------------------------------
过程名: TFTPServer.Stop
功能: 关闭服务
参数: 无
返回值: 无
-------------------------------------------------------------------------------}
procedure TFTPServer.Stop;
begin
IdFTPServer.Active := False;
end; {-------------------------------------------------------------------------------
过程名: TFTPServer.GetBindingIP
功能: 获取绑定的IP地址
参数:
返回值: string
-------------------------------------------------------------------------------}
function TFTPServer.GetBindingIP():string ;
begin
Result := GStack.LocalAddress;
end;
{-------------------------------------------------------------------------------
过程名: BackSlashToSlash
功能: 反斜杠到斜杠
参数: const str: string
返回值: string
-------------------------------------------------------------------------------}
function BackSlashToSlash( const str: string ) : string;
var
a: dword;
begin
result := str;
for a := to length( result ) do
if result[a] = '/' then
result[a] := '/';
end; {-------------------------------------------------------------------------------
过程名: SlashToBackSlash
功能: 斜杠到反斜杠
参数: const str: string
返回值: string
-------------------------------------------------------------------------------}
function SlashToBackSlash( const str: string ) : string;
var
a: dword;
begin
result := str;
for a := to length( result ) do
if result[a] = '/' then
result[a] := '/';
end; {-------------------------------------------------------------------------------
过程名: TFTPServer.TransLatePath
功能: 路径名称翻译
参数: const APathname, homeDir: string
返回值: string
-------------------------------------------------------------------------------}
function TFTPServer.TransLatePath( const APathname, homeDir: string ) : string;
var
tmppath: string;
begin
result := SlashToBackSlash(Utf8ToAnsi(homeDir) ) ;
tmppath := SlashToBackSlash( Utf8ToAnsi(APathname) ) ;
if homedir = '/' then
begin
result := tmppath;
exit;
end; if length( APathname ) = then
exit;
if result[length( result ) ] = '/' then
result := copy( result, , length( result ) - ) ;
if tmppath[] <> '/' then
result := result + '/';
result := result + tmppath;
end; {-------------------------------------------------------------------------------
过程名: GetNewDirectory
功能: 得到新目录
参数: old, action: string
返回值: string
-------------------------------------------------------------------------------}
function GetNewDirectory( old, action: string ) : string;
var
a: integer;
begin
if action = '../' then
begin
if old = '/' then
begin
result := old;
exit;
end;
a := length( old ) - ;
while ( old[a] <> '/' ) and ( old[a] <> '/' ) do
dec( a ) ;
result := copy( old, , a ) ;
exit;
end;
if ( action[] = '/' ) or ( action[] = '/' ) then
result := action
else
result := old + action;
end; {-------------------------------------------------------------------------------
过程名: TFTPServer.IdFTPServer1UserLogin
功能: 允许服务器执行一个客户端连接的用户帐户身份验证
参数: ASender: TIdFTPServerThread; const AUsername, APassword: string; var AAuthenticated: Boolean
返回值: 无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1UserLogin( ASender: TIdFTPServerThread;
const AUsername, APassword: string; var AAuthenticated: Boolean ) ;
begin
AAuthenticated := ( AUsername = UserName ) and ( APassword = UserPassword ) ;
if not AAuthenticated then
exit;
ASender.HomeDir := AnsiToUtf8(BorrowDirectory);
asender.currentdir := '/';
if Assigned(FOnFtpNotifyEvent) then
OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'用户登录服务器');
end; {-------------------------------------------------------------------------------
过程名: TFTPServer.IdFTPServer1ListDirectory
功能: 允许服务器生成格式化的目录列表
参数: ASender: TIdFTPServerThread; const APath: string; ADirectoryListing: TIdFTPListItems
返回值: 无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1ListDirectory( ASender: TIdFTPServerThread; const APath: string; ADirectoryListing: TIdFTPListItems ) ; procedure AddlistItem( aDirectoryListing: TIdFTPListItems; Filename: string; ItemType: TIdDirItemType; size: int64; date: tdatetime ) ;
var
listitem: TIdFTPListItem;
begin
listitem := aDirectoryListing.Add;
listitem.ItemType := ItemType; //表示一个文件系统的属性集
listitem.FileName := AnsiToUtf8(Filename); //名称分配给目录中的列表项,这里防止了中文乱码
listitem.OwnerName := 'anonymous';//代表了用户拥有的文件或目录项的名称
listitem.GroupName := 'all'; //指定组名拥有的文件名称或目录条目
listitem.OwnerPermissions := 'rwx'; //拥有者权限,R读W写X执行
listitem.GroupPermissions := 'rwx'; //组拥有者权限
listitem.UserPermissions := 'rwx'; //用户权限,基于用户和组权限
listitem.Size := size;
listitem.ModifiedDate := date;
end; var
f: tsearchrec;
a: integer;
begin
ADirectoryListing.DirectoryName := apath;
a := FindFirst( TransLatePath( apath, ASender.HomeDir ) + '*.*', faAnyFile, f ) ;
while ( a = ) do
begin
if ( f.Attr and faDirectory > ) then
AddlistItem( ADirectoryListing, f.Name, ditDirectory, f.size, FileDateToDateTime( f.Time ) )
else
AddlistItem( ADirectoryListing, f.Name, ditFile, f.size, FileDateToDateTime( f.Time ) ) ;
a := FindNext( f ) ;
end; FindClose( f ) ;
end; {-------------------------------------------------------------------------------
过程名: TFTPServer.IdFTPServer1RenameFile
功能: 允许服务器重命名服务器文件系统中的文件
参数: ASender: TIdFTPServerThread; const ARenameFromFile, ARenameToFile: string
返回值: 无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1RenameFile( ASender: TIdFTPServerThread;
const ARenameFromFile, ARenameToFile: string ) ;
begin
try
if not MoveFile( pchar( TransLatePath( ARenameFromFile, ASender.HomeDir ) ) , pchar( TransLatePath( ARenameToFile, ASender.HomeDir ) ) ) then
RaiseLastOSError;
except
on e:Exception do
begin
if Assigned(FOnFtpNotifyEvent) then
OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'重命名文件[' + Utf8ToAnsi(ARenameFromFile) + ']失败,原因是' + e.Message);
Exit;
end;
end;
if Assigned(FOnFtpNotifyEvent) then
OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'重命名文件[' + Utf8ToAnsi(ARenameFromFile) + ']为[' + Utf8ToAnsi(ARenameToFile) + ']');
end; {-------------------------------------------------------------------------------
过程名: TFTPServer.IdFTPServer1RetrieveFile
功能: 允许从服务器下载文件系统中的文件
参数: ASender: TIdFTPServerThread; const AFilename: string; var VStream: TStream
返回值: 无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1RetrieveFile( ASender: TIdFTPServerThread;
const AFilename: string; var VStream: TStream ) ;
begin
VStream := TFileStream.Create( translatepath( AFilename, ASender.HomeDir ) , fmopenread or fmShareDenyWrite ) ;
if Assigned(FOnFtpNotifyEvent) then
OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'下载文件[' + Utf8ToAnsi(AFilename) + ']');
end; {-------------------------------------------------------------------------------
过程名: TFTPServer.IdFTPServer1StoreFile
功能: 允许在服务器上传文件系统中的文件
参数: ASender: TIdFTPServerThread; const AFilename: string; AAppend: Boolean; var VStream: TStream
返回值: 无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1StoreFile( ASender: TIdFTPServerThread;
const AFilename: string; AAppend: Boolean; var VStream: TStream ) ;
begin
if FileExists( translatepath( AFilename, ASender.HomeDir ) ) and AAppend then
begin
VStream := TFileStream.create( translatepath( AFilename, ASender.HomeDir ) , fmOpenWrite or fmShareExclusive ) ;
VStream.Seek( , soFromEnd ) ;
end
else
VStream := TFileStream.create( translatepath( AFilename, ASender.HomeDir ) , fmCreate or fmShareExclusive ) ;
if Assigned(FOnFtpNotifyEvent) then
OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'上传文件[' + Utf8ToAnsi(AFilename) + ']');
end; {-------------------------------------------------------------------------------
过程名: TFTPServer.IdFTPServer1RemoveDirectory
功能: 允许服务器在服务器删除文件系统的目录
参数: ASender: TIdFTPServerThread; var VDirectory: string
返回值: 无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1RemoveDirectory( ASender: TIdFTPServerThread;
var VDirectory: string ) ;
begin
try
RmDir( TransLatePath( VDirectory, ASender.HomeDir ) ) ;
except
on e:Exception do
begin
if Assigned(FOnFtpNotifyEvent) then
OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'删除目录[' + Utf8ToAnsi(VDirectory) + ']失败,原因是' + e.Message);
Exit;
end;
end;
if Assigned(FOnFtpNotifyEvent) then
OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'删除目录[' + Utf8ToAnsi(VDirectory) + ']');
end; {-------------------------------------------------------------------------------
过程名: TFTPServer.IdFTPServer1MakeDirectory
功能: 允许服务器从服务器中创建一个新的子目录
参数: ASender: TIdFTPServerThread; var VDirectory: string
返回值: 无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1MakeDirectory( ASender: TIdFTPServerThread;
var VDirectory: string ) ;
begin
try
MkDir( TransLatePath( VDirectory, ASender.HomeDir ) ) ;
except
on e:Exception do
begin
if Assigned(FOnFtpNotifyEvent) then
OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'创建目录[' + Utf8ToAnsi(VDirectory) + ']失败,原因是' + e.Message);
Exit;
end;
end;
if Assigned(FOnFtpNotifyEvent) then
OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'创建目录[' + Utf8ToAnsi(VDirectory) + ']');
end; {-------------------------------------------------------------------------------
过程名: TFTPServer.IdFTPServer1GetFileSize
功能: 允许服务器检索在服务器文件系统的文件的大小
参数: ASender: TIdFTPServerThread; const AFilename: string; var VFileSize: Int64
返回值: 无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1GetFileSize( ASender: TIdFTPServerThread;
const AFilename: string; var VFileSize: Int64 ) ;
begin
VFileSize := FileSizeByName( TransLatePath( AFilename, ASender.HomeDir ) ) ;
if Assigned(FOnFtpNotifyEvent) then
OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'获取文件大小');
end; {-------------------------------------------------------------------------------
过程名: TFTPServer.IdFTPServer1DeleteFile
功能: 允许从服务器中删除的文件系统中的文件
参数: ASender: TIdFTPServerThread; const APathname: string
返回值: 无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1DeleteFile( ASender: TIdFTPServerThread;
const APathname: string ) ;
begin
try
DeleteFile( pchar( TransLatePath( ASender.CurrentDir + '/' + APathname, ASender.HomeDir ) ) ) ;
except
on e:Exception do
begin
if Assigned(FOnFtpNotifyEvent) then
OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'删除文件[' + Utf8ToAnsi(APathname) + ']失败,原因是' + e.Message);
Exit;
end;
end;
if Assigned(FOnFtpNotifyEvent) then
OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'删除文件[' + Utf8ToAnsi(APathname) + ']');
end; {-------------------------------------------------------------------------------
过程名: TFTPServer.IdFTPServer1ChangeDirectory
功能: 允许服务器选择一个文件系统路径
参数: ASender: TIdFTPServerThread; var VDirectory: string
返回值: 无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1ChangeDirectory( ASender: TIdFTPServerThread;
var VDirectory: string ) ;
begin
VDirectory := GetNewDirectory( ASender.CurrentDir, VDirectory ) ;
if Assigned(FOnFtpNotifyEvent) then
OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'进入目录[' + Utf8ToAnsi(VDirectory) + ']');
end; {-------------------------------------------------------------------------------
过程名: TFTPServer.IdFTPServer1DisConnect
功能: 失去网络连接
参数: AThread: TIdPeerThread
返回值: 无
-------------------------------------------------------------------------------}
procedure TFTPServer.IdFTPServer1DisConnect( AThread: TIdPeerThread ) ;
begin
// nothing much here
end;
end.

使用工程示例:

 unit Unit1; 

 interface 

 uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, FTPServer; type
TForm1 = class(TForm)
btn1: TButton;
btn2: TButton;
edt_BorrowDirectory: TEdit;
lbl1: TLabel;
mmo1: TMemo;
lbl2: TLabel;
edt_BorrowPort: TEdit;
lbl3: TLabel;
edt_UserName: TEdit;
lbl4: TLabel;
edt_UserPassword: TEdit;
procedure btn1Click(Sender: TObject);
procedure btn2Click(Sender: TObject);
procedure TFTPServer1FtpNotifyEvent(ADatetime: TDateTime;AUserIP, AEventMessage: string);
private
FFtpServer: TFTPServer;
public
{ Public declarations }
end; var
Form1: TForm1; implementation {$R *.dfm} procedure TForm1.btn1Click(Sender: TObject);
begin
if not Assigned(FFtpServer) then
begin
FFtpServer := TFTPServer.Create;
FFtpServer.UserName := Trim(edt_UserName.Text);
FFtpServer.UserPassword := Trim(edt_UserPassword.Text);
FFtpServer.BorrowDirectory := Trim(edt_BorrowDirectory.Text);
FFtpServer.BorrowPort := StrToInt(Trim(edt_BorrowPort.Text));
FFtpServer.OnFtpNotifyEvent := TFTPServer1FtpNotifyEvent;
FFtpServer.Run;
mmo1.Lines.Add(DateTimeToStr(Now) + # +'FTP服务器已开启,本机IP地址:' + FFtpServer.GetBindingIP);
end;
end; procedure TForm1.btn2Click(Sender: TObject);
begin
if Assigned(FFtpServer) then
begin
FFtpServer.Stop;
FreeAndNil(FFtpServer);
mmo1.Lines.Add(DateTimeToStr(Now) + # +'FTP服务器已关闭');
end;
end; procedure TForm1.TFTPServer1FtpNotifyEvent(ADatetime: TDateTime;AUserIP, AEventMessage: string);
begin
mmo1.Lines.Add(DateTimeToStr(ADatetime) + # + AUserIP + # + AEventMessage);
SendMessage(mmo1.Handle,WM_VSCROLL,SB_PAGEDOWN,);
end;
end.

结果如下图所示:

示例工程源码下载:

http://download.csdn.net/source/3236325

原博客地址:

http://blog.csdn.net/akof1314/article/details/6371984#comments

https://www.cnblogs.com/findumars/p/6360865.html

Delphi - Indy TIdFTPServer封装类的更多相关文章

  1. [delphi]indy idhttp post方法

    网易 博客 LOFTCam-用心创造滤镜 LOFTER-最美图片社交APP 送20张免费照片冲印 > 注册登录  加关注 techiepc的博客 万事如意 首页 日志 LOFTER 相册 音乐 ...

  2. Delphi Indy IDHttp 403 forbidden

    http://hbk777.blog.163.com/blog/static/6058086200681594333361/ Delphi Indy IDHttp 403 forbidden 2006 ...

  3. Indy9的TIdFTPServer封装类

    在Delphi 7开发下有强大的Indy控件,版本为9,要实现一个FTP服务器,参考自带的例子,发现还要写很多函数,而且不支持中文显示文件列表等等.于是,自己改进封装了下,形成一个TFTPServer ...

  4. delphi indy Idhttp error:1409442E:SSL routines:SSL3_READ_BYTES:tlsv1 alert protocol version

    在使用 indy 中的 idhttp 组件访问 https 网站时,出现如下错误: error:1409442E:SSL routines:SSL3_READ_BYTES:tlsv1 alert pr ...

  5. Delphi indy线程控件TIdThreadComponent的使用

    当程序需要做耗时操作,例如访问数据库获取较多的数据.获取大文件MD5.网络访问数据量比较大.界面需要频繁刷新等等,都可以用线程来解决界面卡顿的问题,从而优化用户体验. 在知道TIdThreadComp ...

  6. Delphi - Indy TIdHTTP方式创建程序外壳 - 实现可执行程序的自动升级

    Delphi 实现可执行程序的自动升级 准备工作: 1:Delphi调用TIdHTTP方式开发程序,生成程序打包外壳 说明:程序工程命名为ERP_Update 界面布局如下: 代码实现如下: unit ...

  7. Delphi - Indy TIdThreadComponent 线程研究

    Indy IdThreadComponent 线程研究 前几天在开发数据实时解析功能模块的时候,发现解析数据量巨大,特别耗时,程序一跑起来界面假死. 为了优化用户体验,采用了Indy 自带的IdThr ...

  8. Delphi - Indy 创建邮件自动发送服务

    服务器自动邮件线程 功能:此程序主要实现对Oracle数据库表tableName(存放需要发送邮件的相关信息)里面相关信息的邮件发送. 优点:开发人员可以直接再数据库后台对tableName表进行插入 ...

  9. Delphi - Indy TIdMessage和TIdSMTP实现邮件的发送

    idMessage / idSMTP 首先对idMessage类的各种属性进行赋值(邮件的基本信息,如收件人.邮件主题.邮件正文等),其次通过idSMTP连接邮箱服务器,最后通过idSMTP的Send ...

随机推荐

  1. stack函数怎么用嘞?↓↓↓

    c++ stl栈stack的头文件书写格式为: #include 实例化形式如下: stack StackName; 其中成员函数如下: 1.检验堆栈是否为空 empty() 堆栈为空则返回真 形式如 ...

  2. [系列] Go gRPC Hello World

    目录 概述 四类服务方法 安装 写个 Hello World 服务 推荐阅读 概述 开始 gRPC 了,这篇文章学习使用 gRPC,输出一个 Hello World. 用 Go 实现 gRPC 的服务 ...

  3. python-crud

    Python Fast CRUD https://github.com/aleimu/python-crud 目的 本项目采用了一系列Python中比较流行的组件,可以以本项目为基础快速搭建Restf ...

  4. 深入理解HashMap(jdk7)

    HashMap的结构图示 ​ jdk1.7的HashMap采用数组+单链表实现,尽管定义了hash函数来避免冲突,但因为数组长度有限,还是会出现两个不同的Key经过计算后在数组中的位置一样,1.7版本 ...

  5. 【pycharm】Pycharm对 axios语法的支持问题

    问题: 解决办法: 1,找到pychar的settings 2,ECMAScript6

  6. jboss6.1安装配置

     Jboss6.1的用途,配置,使用详解 一..简介: JBoss是全世界开发者共同努力的成果,一个基于J2EE的开放源代码的应用服务器因为JBoss代码遵循LGPL许可,你可以在任何商业应用中免费使 ...

  7. Oracle_InstantClient 及PL/SQL Developer工具的安装

    一.下载 InstantClient 地址: http://www.oracle.com/technology/software/tech/oci/instantclient/index.html i ...

  8. PIP键盘设置实时时钟--智能模块

    大家好,许久没来发帖,今天带来点干货.希望大家多多讨论,相互学习. 使用 TOPWAY Smart LCD (HMT050CC-C) PIP键盘设置实时时钟   第一步  建立工程  第二步  建立2 ...

  9. 「求助」关于MacOS 适配不了SOIL的问题 以及我自己愚蠢的解决办法

    我的环境 macOS High Sierra 10.13.6 (2018) 我的SOIL源是通过 终端 git clone https://github.com/DeVaukz/SOIL 直接从gay ...

  10. 腾讯物联TencentOS tiny上云初探

    2017年中旬曾写过一篇关于物联网平台的文章<微软最完善,百度最“小气” 看微软阿里百度三大物联网云平台对比>.现在已经过去两年了,物联网的格局又发生了不少的变化.不过针对腾讯来说,其物联 ...