Ah More's blog: 2017

Saturday, 18 November 2017

Sunday, 12 November 2017

Complete TFTP Server example, using Indy components

There are not many good TFTP server examples out there, so I wrote this example of a multi-thredded TFTP Server, using Indy components.
Answer:
There are few good examples of TFTP servers, so I wrote this complete server as an example.
If works like a Secure TFTP server, since it only allows uploads/downloads from a specific directory.
The example assumes that you open a new project with a new form (Form1), and drop one TFTP Server and TFTP
Client on the form, and two buttons.
The source below can be copied as such. Enjoy.
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer,
  IdTrivialFTPServer, StdCtrls, IdUDPClient, IdTrivialFTP;
type
  TForm1 = class(TForm)
    IdTrivialFTPServer1: TIdTrivialFTPServer;
    IdTrivialFTP1: TIdTrivialFTP;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure IdTrivialFTPServer1ReadFile(Sender: TObject;
      var FileName: string; const PeerInfo: TPeerInfo;
      var GrantAccess: Boolean; var AStream: TStream;
      var FreeStreamOnComplete: Boolean);
    procedure IdTrivialFTPServer1TransferComplete(Sender: TObject;
      const Success: Boolean; const PeerInfo: TPeerInfo; AStream: TStream;
      const WriteOperation: Boolean);
    procedure IdTrivialFTPServer1WriteFile(Sender: TObject;
      var FileName: string; const PeerInfo: TPeerInfo;
      var GrantAccess: Boolean; var AStream: TStream;
      var FreeStreamOnComplete: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    TFTPPath: string;
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
  IdTrivialFTPServer1.ThreadedEvent := True;
  IdTrivialFTPServer1.Active := True;
  { Set the path to where the files will be stored/retreived }
  TFTPPath := IncludeTrailingPathDelimiter('C:\Temp');
end;
procedure TForm1.IdTrivialFTPServer1ReadFile(Sender: TObject;
  var FileName: string; const PeerInfo: TPeerInfo;
  var GrantAccess: Boolean; var AStream: TStream;
  var FreeStreamOnComplete: Boolean);
var
  FS: TFileStream;
begin
  FreeStreamOnComplete := True;
  try
    { Convert UNIX style filenames to WINDOWS style }
    while Pos('/', Filename) <> 0 do
      Filename[Pos('/', Filename)] := '\';
    { Assure that the filename DOES NOT CONTAIN any path information }
    Filename := ExtractFileName(Filename);
    { Check if file exists }
    if FileExists(TFTPPath + Filename) then
    begin
      { Open file in READ ONLY mode }
      FS := TFileStream.Create(TFTPPath + Filename,
        fmOpenRead or fmShareDenyWrite);
      { Assign stream to variable }
      AStream := FS;
      { Set parameters }
      GrantAccess := True;
    end
    else
    begin
      GrantAccess := False;
    end;
  except
    { On errors, deny access }
    GrantAccess := False;
    if Assigned(FS) then
      FreeAndNil(FS);
  end;
end;
procedure TForm1.IdTrivialFTPServer1WriteFile(Sender: TObject;
  var FileName: string; const PeerInfo: TPeerInfo;
  var GrantAccess: Boolean; var AStream: TStream;
  var FreeStreamOnComplete: Boolean);
var
  FS: TFileStream;
begin
  try
    { Convert UNIX style filenames to WINDOWS style }
    while Pos('/', Filename) <> 0 do
      Filename[Pos('/', Filename)] := '\';
    { Assure that the filename DOES NOT CONTAIN any path information }
    Filename := ExtractFileName(Filename);
    { Open file in WRITE ONLY mode }
    FS := TFileStream.Create(TFTPPath + Filename,
      fmCreate or fmShareExclusive);
    { Copy all the data }
    AStream := FS;
    { Set parameters }
    FreeStreamOnComplete := True;
    GrantAccess := True;
  except
    { On errors, deny access }
    GrantAccess := False;
    if Assigned(FS) then
      FreeAndNil(FS);
  end;
end;
procedure TForm1.IdTrivialFTPServer1TransferComplete(Sender: TObject;
  const Success: Boolean; const PeerInfo: TPeerInfo; AStream: TStream;
  const WriteOperation: Boolean);
begin
  // Success = TRUE if the read/write operation was successfull
  // WriteOperation = TRUE if the client SENT a file to the server
  try
    { Close the FileStream }
    if Assigned(AStream) then
      FreeAndNil(AStream);
  except
  end;
end;
// Example of how to DOWNLOAD a file from the server
procedure TForm1.Button1Click(Sender: TObject);
var
  ST: TMemoryStream;
begin
  ST := TMemoryStream.Create;
  IdTrivialFTP1.Get('testfile.dat', ST);
  if Assigned(ST) then
  begin
    ShowMessage('Filesize=' + IntToStr(ST.Size));
    FreeAndNil(ST);
  end;
end;
// Example of how to UPLOAD a file to the server
procedure TForm1.Button2Click(Sender: TObject);
var
  ST: TMemoryStream;
  I: Integer;
  S: string;
begin
  { Create stream }
  ST := TMemoryStream.Create;
  { Initialize data }
  S := 'This is a test file. It whould appear in the ' +
    'TFTP Server''s upload directory.' + #13#10;
  { Store in stream }
  ST.Write(S[1], Length(S));
  ST.Position := 0;
  { Send Stream to TFTP Server }
  IdTrivialFTP1.Put(ST, 'textfile.txt');
  { Free Stream }
  if Assigned(ST) then
    FreeAndNil(ST);
  { Show a dialog }
  ShowMessage('Done!');
end;
end.

http://code1.okbase.net/codefile/IdTrivialFTPServer.pas_201211268418_275.htm

https://stackoverflow.com/questions/20614431/can-tidtrivialftp-be-used-for-general-file-transfer-in-delphi

http://www.delphigroups.info/2/11/212422.html

https://stackoverflow.com/questions/20614431/can-tidtrivialftp-be-used-for-general-file-transfer-in-delphi

http://delphi-kb.blogspot.my/2011/03/complete-tftp-server-example-using-indy.html

Friday, 10 November 2017

一.区别
二者都是有用的和常用的，如果纯粹从概念上区分二者就比较费解了，我们直接从功能上进行区分，简单明了：
这两种传输协议也就是合于适配不同的业务和不同的硬件终端。
在使用中，类似于图像、声音等对可靠性要求没有那么高的业务可以用UDP，他们不需要准确存储对准确性无要求但要求速度快。
类似于文本、程序、文件等要求可靠的数据最好就用TCP，但会牺牲一些速度。
对系统资源的要求：CP较多，UDP少。
程序结构：UDP程序结构较简单，TCP复杂。
流模式与数据报模式:TCP保证数据正确性，UDP可能丢包; TCP保证数据顺序，UDP不保证

二.用途
TCP是面向连接的，有比较高的可靠性，一些要求比较高的服务一般使用这个协议，如FTP、Telnet、SMTP、HTTP、POP3等，而UDP是面向无连接的，使用这个协议的常见服务有DNS、SNMP、QQ等。对于QQ必须另外说明一下，QQ2003以前是只使用UDP协议的，其服务器使用8000端口，侦听是否有信息传来，客户端使用4000端口，向外发送信息（这也就不难理解在一般的显IP的QQ版本中显示好友的IP地址信息中端口常为4000或其后续端口的原因了），即QQ程序既接受服务又提供服务，在以后的QQ版本中也支持使用TCP协议了。
Udp是一种面向无连接的通信协议，该协议使得数据传输的速度得到大幅度的提高。视频聊天语音聊天基本都是用UPD协议。

三.例子
TCP: ServerSocket ss = new ServerSocket(2000);
UDP: 创建DatagramSocket对象，DatagramSocket区别于Tcp方式下的socket对象。
DatagramSocket   ds=new   DatagramSocket();
下面是具体的程序代码，已经编译通过，另外附件也是源码可以直接下载。

。。。。

更多TCP和UPD的资料：
TCP---传输控制协议,提供的是面向连接、可靠的字节流服务。当客户和服务器彼此交换数据前，必须先在双方之间建立一个TCP连接，之后才能传输数据。TCP提供超时重发，丢弃重复数据，检验数据，流量控制等功能，保证数据能从一端传到另一端。

    UDP---用户数据报协议，是一个简单的面向数据报的运输层协议。UDP不提供可靠性，它只是把应用程序传给IP层的数据报发送出去，但是并不能保证它们能到达目的地。由于UDP在传输数据报前不用在客户和服务器之间建立一个连接，且没有超时重发等机制，故而传输速度很快。

    UDP 与 TCP 的主要区别在于 UDP 不一定提供可靠的数据传输。事实上，该协议不能保证数据准确无误地到达目的地。UDP 在许多方面非常有效。当某个程序的目标是尽快地传输尽可能多的信息时（其中任意给定数据的重要性相对较低），可使用 UDP。ICQ 短消息使用 UDP 协议发送消息。
许多程序将使用单独的TCP连接和单独的UDP连接。重要的状态信息随可靠的TCP连接发送，而主数据流通过UDP发送。

    TCP的目的是提供可靠的数据传输，并在相互进行通信的设备或服务之间保持一个虚拟连接。TCP在数据包接收无序、丢失或在交付期间被破坏时，负责数据恢复。它通过为其发送的每个数据包提供一个序号来完成此恢复。记住，较低的网络层会将每个数据包视为一个独立的单元，因此，数据包可以沿完全不同的路径发送，即使它们都是同一消息的组成部分。这种路由与网络层处理分段和重新组装数据包的方式非常相似，只是级别更高而已。
为确保正确地接收数据，TCP要求在目标计算机成功收到数据时发回一个确认（即 ACK）。如果在某个时限内未收到相应的 ACK，将重新传送数据包。如果网络拥塞，这种重新传送将导致发送的数据包重复。但是，接收计算机可使用数据包的序号来确定它是否为重复数据包，并在必要时丢弃它。

TCP与UDP的选择
    如果比较UDP包和TCP包的结构，很明显UDP包不具备TCP包复杂的可靠性与控制机制。与TCP协议相同，UDP的源端口数和目的端口数也都支持一台主机上的多个应用。一个16位的UDP包包含了一个字节长的头部和数据的长度，校验码域使其可以进行整体校验。（许多应用只支持UDP，如：多媒体数据流，不产生任何额外的数据，即使知道有破坏的包也不进行重发。）
    很明显，当数据传输的性能必须让位于数据传输的完整性、可控制性和可靠性时，TCP协议是当然的选择。当强调传输性能而不是传输的完整性时，如：音频和多媒体应用，UDP是最好的选择。在数据传输时间很短，以至于此前的连接过程成为整个流量主体的情况下，UDP也是一个好的选择，如：DNS交换。把 SNMP建立在UDP上的部分原因是设计者认为当发生网络阻塞时，UDP较低的开销使其有更好的机会去传送管理数据。TCP丰富的功能有时会导致不可预料的性能低下，但是我们相信在不远的将来，TCP可靠的点对点连接将会用于绝大多数的网络应用。
    FTP协议即文件传输协议,它是一个标准协议,FTP协议也是应用TCP/IP协议的应用协议标准,它是在计算机和网络之间交换文件的最简单的方法。

Thursday, 9 November 2017

http://gomsun2.tistory.com/entry/Indy10-UDP-Sample

http://gomsun2.tistory.com/entry/Indy10-UDP-Sample

http://lifengxi.blog.163.com/blog/static/10348848200823011843243/

http://www.voidcn.com/article/p-zhvdhrvw-bcd.html

https://stackoverflow.com/questions/19763125/udp-file-transfer-using-delphi-indy-10

Wednesday, 8 November 2017

TIdUDPServer控件中文指南

TIdUDPServer控件中文指南

2007-03-15 22:46:28| 分类： delphi程序备忘 |字号订阅
IdUDPServer
属性
property Bindings: TIdSocketHandles;
用来收集f TIdSocketHandle实例。包含ID_SOCK_DGRAM类型的socket。

property DefaultPort: integer;
监听新连接的端口。

property ThreadedEvent: boolean;
指示UDP读事件的执行方式。是否以线程的形式执行

property Active: Boolean;
是否开始监听。

property Binding: TIdSocketHandle;
只读属性。指示读写传送的socket句柄。

property BroadcastEnabled: Boolean;
是否广播传送数据。

property BufferSize: Integer;
UDP包的尺寸。

property ReceiveTimeout: Integer;
从一个服务中读取数据的超时时间。

property LocalName: string;
本地计算机名称。

property Version: string;
只读属性，用来获取Indy部件的版本号码。

方法
procedure Broadcast(const AData: string; const APort: integer);
在网络上发送数据到所有的计算机。

unction ReceiveBuffer(var ABuffer; const ABufferSize: Integer; const AMSec: Integer =

IdTimeoutDefault): integer; overload;
function ReceiveBuffer(var ABuffer; const ABufferSize: Integer; var VPeerIP: string; var

VPeerPort: integer; AMSec: Integer = IdTimeoutDefault): integer; overload;
从远程连接中读取数据

function ReceiveString(const AMSec: Integer = IdTimeoutDefault): string; overload;
function ReceiveString(var VPeerIP: string; var VPeerPort: integer; const AMSec: Integer =

IdTimeoutDefault): string; overload;
从远程连接中读取数据

procedure Send(AHost: string; const APort: Integer; const AData: string);
向远程计算机系统发送数据。
procedure SendBuffer(AHost: string; const APort: Integer; var ABuffer; const AByteCount:

integer);
向远程计算机系统发送数据

事件
property OnUDPRead: TUDPReadEvent;
UDP读取事件发生时执行。
参数
ABinding
接受UDP数据报的socket。
AData
在UDP数据报中接受数据的流。

property OnStatus: TIdStatusEvent;
指示当前连接状态的句柄。
参数
aaArgs
用来构造当前状态文本消息的格式化参数。
axStatus
当前连接状态。取值范围与TIdUDPClient类中的OnStatus事件相同。

procedure BeginWork(AWorkMode: TWorkMode; const ASize: Integer = 0); virtual;
当OnBeginWork事件触发时执行
AWorkMode可以取的值：
wmRead－－从远程连接中读取数据。
wmWrite－－向远程连接发送数据。

procedure DoWork(AWorkMode: TWorkMode; const ACount: Integer); virtual;
当OnWork事件触发时执行。

procedure EndWork(AWorkMode: TWorkMode); virtual;
当OnEndWork事件触发时执行。

read UDP messages

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdSocketHandle, IdBaseComponent,
  IdComponent, IdUDPBase, IdUDPServer, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    IdUDPServer1: TIdUDPServer;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure IdUDPServer1UDPRead(AThread: TIdUDPListenerThread;
      AData: TBytes; ABinding: TIdSocketHandle);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  MyUDPMessage : String;

implementation

{$R *.dfm}

function BytesToString(bytearray: array of byte; len : Integer): String;
var
  a: Integer;
begin
  result := '';
  for a := 0 to len-1 do begin
    result := result + char(bytearray[a]);
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Form1.IdUDPServer1.Active := False;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.IdUDPServer1.DefaultPort := 3333;
  Form1.IdUDPServer1.Active := True;
  Form1.IdUDPServer1.OnUDPRead := IdUDPServer1UDPRead;
end;

procedure TForm1.IdUDPServer1UDPRead(AThread: TIdUDPListenerThread;
  AData: TBytes; ABinding: TIdSocketHandle);
begin
   MyUDPMessage:=BytesToString(AData,10240);
   Memo1.Lines.Add(MyUDPMessage);
end;

end.

通过Indy的IpWatch取得本机IP

unit Unit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdComponent, Vcl.StdCtrls,
IdBaseComponent, IdIPWatch;

type
TForm1 = class(TForm)
    IdIPWatch1: TIdIPWatch;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
private
    { Private declarations }
public
    { Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
     Edit1.Text := IdIPWatch1.LocalIP;
end;

end.

DELPHI中两个UDP控件的用法

[转] http://www.voidcn.com/article/p-qsnisddi-qr.html

DELPHI中有两个UDP控件：TIdUDPServer和TIdUDPClient控件，可用于传输UDP数据；用法都很简单，主要是一些细微的特性，弄清楚了对正确使用这两种控件有很大的好处；下面分别介绍：

一、              TIdUDPServer：代表一个UDP的服务端，接收UDP客户端发过来的数据；在FORM上放置一个TIdUDPServer控件，命名为UDPSvr，在FormCreate事件中编写如下代码：

    UDPSvr.Bindings.Add;

    UDPSvr.Bindings[0].IP := ‘192.168.2.117’;

UDPSvr.Bindings[0].Port := 1812;

UDPSvr.Active := True;

在UDPSvr控件的OnUDPRead事件中编写如下代码：

var

    Buffer: array[0..1024] of Char;

    iSize: integer;

    sData: string;

begin

      ZeroMemory(@Buffer,sizeof(Buffer));

      iSize := AData.Size;

      if iSize > 1024 then

      begin

        iSize := 1024;

      end;

      AData.Seek(0,soFromBeginning);

      iSize := AData.Read(Buffer,iSize);

      。。。。。{对接收数据的处理}

end;

这样就完成了一个可以接收数据的UDP应用程序；

其实TIdUDPServer有发送数据的方法：Send和SendBuffer，是继承自TIdUPDBase，所以只要利用TIdUDPServer控件就可完成数据的收发，在FORM上添加一个Tbutton控件，在Click事件中添加如下代码；

var

Buffer: array[0..1024] of Char;

sText: string;

iLen: integer;

begin

sText := ‘12345678’

ZeroMemory(@Buffer,sizeof(Buffer));

StrPCopy(Buffer,sText);

iLen := Length(sText);

UDPSvr.SendBuffer(‘192.168.2.117’,1814,Buffer,iLen);

end;

            这样就可以向另一UDP应用程序发送数据；

          一个TIdUDPServer控件可以打开多个端口，如下的代码打开了两个端口：

            UDPSvr.Bindings.Add;

            UDPSvr.Bindings[0].IP := GetLocalIP;

            UDPSvr.Bindings[0].Port := 1812;

            UDPSvr.Bindings.Add;

            UDPSvr.Bindings[1].IP := GetLocalIP;

            UDPSvr.Bindings[1].Port := 1813;

            UDPSvr.Active := True;



             当打开多个端口时，发送数据是从哪个端口发送出去呢？根据测试结果是：最近收到数据的那个端口；如果还没有收到过数据，则为Bindings[0].Port；



            在接收数据的事件中，有一个TidSocketHandle类型的参数：Abinding；这个参数有两对属性：

            IP 、Port：代表本地IP地址和端口；

            PeerIP、PeerPort：代表远端IP地址和端口；

            其中PeerIP、PeerPort在交复发送数据的UDP应用中是很有用的，因为UDP服务端可以向PeerIP和PeerPort回应数据，而不用再去设置UDP客户端的IP地址和端口号（这种方法应用不当，会产生问题，下面会说到）；

二、              TIdUDPClient：代表一个UDP的客户端，专门用于发送UDP数据，不能接收数据，因为没有相应的事件和方法；前面已经说过，利用TIdUDPServer控件就可以完成UDP数据的收发，所以一直怀疑TIdUDPClient控件存在的必要性；除非有一个UDP的客户端只发送数据，而从不接收数据，这样的客户端应该很少；后来我想，可能可以用TIdUDPClient控件来分担TIdUDPServer控件的负载，在一个需要收发大量UDP数据的服务端中，TIdUDPServer控件只接收数据，另外专门用一个TIdUDPClient控件发送数据，也许可以提高应用程序的性能（没有经过验证）；利用TIdUDPClient发送数据有两种方式：

1、利用TIdUDPClient控件本身的Send和SendBuffer方法，这时需要设置Host和Port属性，在FORM上放置一个TIdUDPClient控件，命名为：UDPClt；分别设置Host和Port属性值为：192.168.2.117和1814；再编写如下代码：

var

Buffer: array[0..1024] of Char;

sText: string;

iLen: integer;

begin

sText := ‘12345678’;

ZeroMemory(@Buffer,sizeof(Buffer));

StrPCopy(Buffer,sText);

iLen := Length(sText);

UDPClt.SendBuffer(Buffer,iLen);

   end;

2、不需要设置Host和Port属性，而直接利用从TIdUPDBase继承来的Send和SendBuffer方法，也可发送数据，代码如下所示：

UDPClt.SendBuffer(‘192.168.2.117’,1814,Buffer,iLen);

TIdUDPClient控件发送数据时是通过哪个端口发出去的呢？根据测试的结果：是随机的；这样就给上面说过的UDP服务端可以向PeerIP和PeerPort回应数据造成了麻烦，也就是说如果UDP服务端收到的数据是通过TIdUDPClient控件发过来的，就不能通过PeerIP和PeerPort回应回去，而应设定客户端的IP地址和端口号；在具体应用中是哪种情况，要根据测试结果而定。

Thursday, 2 November 2017

IDUdpServer研究心得

http://www.cnblogs.com/zhmore/archive/2010/08/29/1811921.html

Indy10中的控件IDUdpServer使用方便，比之Indy9有较大的改动，不过使用的时候一定要先弄清楚它的基本工作流程哦，不然会带来很大的麻烦，一下是本人经过查看源代码及N多测试得出的一些心得：
(1)    使用多线程
把控件的ThreadedEvent设置为true后控件事件就会在绑定线程内执行了，这个多线程给人的感觉好像是每个连接创建一个线程，其实不是这样的。Udp是没有连接概念的，而事实上是每个绑定套接字(Binding:TIdSocketHandle)绑定创建后都会开启一个线程，这个线程专门处理当前绑定套接字的收发工作。
(2)    OnUDPRead事件AThread、ABinding直接的关系
上面我们也说到了每个绑定套接字(Binding:TIdSocketHandle)绑定创建后都会开启一个线程，这样就是说这两个参数是一一对应，每个AThread的线程工作期间只处理当前的绑定套接字的收发。
(3)    Dll内使用IdUdpServer无法执行OnUDPRead事件？

...............

http://www.cnblogs.com/zhmore/archive/2010/08/29/1811921.html

[ Worked ] GetDocument filename ...

unit Unit1;

interface

uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
IOUtils, FMX.ScrollBox, FMX.Memo, FMX.Controls.Presentation, FMX.StdCtrls;

type
TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
private
    { Private declarations }
public
    { Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.Button1Click(Sender: TObject);
var
DirList: TStringDynArray;
DirPath: string;
s: string;
begin                                                  (*
DirPath := TPath.Combine(TPath.GetDocumentsPath, 'assets');
DirPath := TPath.Combine(DirPath, 'internal');     *)
DirPath := TPath.GetSharedCameraPath+'/camera/';

// Display where we're looking for the files
Memo1.Lines.Add('Searching ' + DirPath);

if TDirectory.Exists(DirPath, True) then
begin
    // Get all files. Non-Windows systems don't typically care about
    // extensions, so we just use a single '*' as a mask.
    DirList := TDirectory.GetFiles(DirPath, '*');

    // If none found, show that in memo
    if Length(DirList) = 0 then
      Memo1.Lines.Add('No files found in ' + DirPath)
    else // Files found. List them.
    begin
      for s in DirList do
        Memo1.Lines.Add(s);
    end;
end
else
    Memo1.Lines.Add('Directory ' + DirPath + ' does not exist.');
end;

end.

delphi android路径 TPath 文件路径，文件管理

delphi 新路径、文件功能 IOUtils单元,文件路径，文件管理
http://docwiki.embarcadero.com/RADStudio/Berlin/en/Disk_And_Directory_Support_Routines
http://docwiki.embarcadero.com/RADStudio/XE8/en/Standard_RTL_Path_Functions_across_the_Supported_Target_Platforms
use system.IOUtils
       TPath.GetPicturesPath;
       tpath.GetTempPath;
       TPath.GetMusicPath;
       TPath.GetPicturesPath;
       TPath.GetDocumentsPath;
       TPath.GetDownloadsPath;
       TPath.GetCameraPath;
   system.IOUtils.TPath.GetDocumentsPath；
System.IOUtils.TFile.Copy
TFile.Create('');
TDirectory.CreateDirectory('');
GetSharedDocumentsPath
PathDelim
TPath.DirectorySeparatorChar
连接路径字符串

TPath.Combine(System.IOUtils.TPath.GetDocumentsPath, afileName)

c++builder 获取Android路径，可以直接用命名空间::写代码
包含头文件#include <System.Ioutils.hpp>
Caption= System::Ioutils::TPath::GetDocumentsPath();
"D:\\Users\\Administrator\\Documents"
得到文件清单,文件列表
ListBox1->Items->AddStrings( System::Ioutils::TDirectory::GetFiles(Edit1->Text));
递归文件清单

 TStringDynArray sl;
 sl =TDirectory.GetFiles(path, '*.txt', TSearchOption.soAllDirectories);

windows path ：

C:\Users\Administrator\Pictures
C:\Users\Administrator\AppData\Local\Temp\
C:\Users\Administrator\Music
D:\Users\Administrator\Documents
C:\Users\Administrator\AppData\Local
C:\Users\Administrator\Pictures
C:\Users\Administrator\AppData\Local
C:\Users\Administrator\AppData\Roaming
C:\ProgramData
C:\Users\Administrator\Videos
C:\Users\Administrator\Music
C:\Users\Administrator\Music
E:\mytest\Win32\Debug\
-------Shared-------
C:\Users\Public\Documents
C:\Users\Public\Pictures
C:\Users\Public\Pictures
C:\Users\Public\Music
C:\Users\Public\Videos
C:\Users\Public\Music
C:\Users\Public\Music
C:\ProgramData
C:\Users\Public\Music
Android Path
/storage/sdcard0/Android/data/com.mm.mtt/files/Pictures
/storage/sdcard0/Android/data/com.mm.mtt/files/tmp
/storage/sdcard0/Android/data/com.mm.mtt/files/Music
/data/data/com.mm.mtt/files 、、GetDocumentsPath

/storage/sdcard0/Android/data/com.mm.mtt/files/Download
/storage/sdcard0/Android/data/com.mm.mtt/files/DCIM
/data/data/com.mm.mtt/cache
/data/data/com.mm.mtt/files 、、GetHomePath
/storage/sdcard0/Android/data/com.mm.mtt/files
/storage/sdcard0/Android/data/com.mm.mtt/files/Movies
/storage/sdcard0/Android/data/com.mm.mtt/files/Ringtones
/storage/sdcard0/Android/data/com.mm.mtt/files/Alarms
/data/app-lib/com.mm.mtt-2
-------Shared-------
/storage/sdcard0/Android/data/com.mm.mtt/files
/storage/sdcard0/Pictures
/storage/sdcard0/DCIM
/storage/sdcard0/Music
/storage/sdcard0/Movies
/storage/sdcard0/Alarms
/storage/sdcard0/Alarms
/storage/sdcard0/Download
/storage/sdcard0/Ringtones

Wednesday, 1 November 2017

how to show the availble files in Android memory with Firemonkey

uses
  IOUtils;

procedure THeaderFooterForm.SpeedButton1Click(Sender: TObject);
var
  DirList: TStringDynArray;
  DirPath: string;
  s: string;
begin
  DirPath := TPath.Combine(TPath.GetDocumentsPath, 'assets');
  DirPath := TPath.Combine(DirPath, 'internal');

  // Display where we're looking for the files
  Memo1.Lines.Add('Searching ' + DirPath);

  if TDirectory.Exists(DirPath, True) then
  begin
    // Get all files. Non-Windows systems don't typically care about
    // extensions, so we just use a single '*' as a mask.
    DirList := TDirectory.GetFiles(DirPath, '*');

    // If none found, show that in memo
    if Length(DirList) = 0 then
      Memo1.Lines.Add('No files found in ' + DirPath)
    else // Files found. List them.
    begin 
      for s in DirList do
        Memo1.Lines.Add(s);
    end;
  end
  else
    Memo1.Lines.Add('Directory ' + DirPath + ' does not exist.');
end;

delphi udp文件传输

http://www.cnblogs.com/MaxWoods/p/3822407.html

客戶端

unit UnitClient;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdUDPBase, IdUDPClient,
IdAntiFreezeBase, IdAntiFreeze, Gauges;

type
TFormClient = class(TForm)
    IdUDPClient1: TIdUDPClient;
    Edit1: TEdit;
    Label1: TLabel;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Gauge1: TGauge;
    procedure Button1Click(Sender: TObject);
private
    { Private declarations }
public
    { Public declarations }
end;

var
FormClient: TFormClient;

implementation

{$R *.dfm}

procedure TFormClient.Button1Click(Sender: TObject);
Var ReceivedString:String;
Mem:TFileStream;
p:Array[0..1023] of byte;
Posi,Len:Integer;
begin
if OpenDialog1.Execute then
begin
    IdUDPClient1.Host:=Edit1.Text;
    IdUDPClient1.Active:=True;
    IdUDPClient1.Send('Send file:File Name:'+OpenDialog1.FileName);
    ReceivedString := IdUDPClient1.ReceiveString();
    if UpperCase(ReceivedString)='RECIVED FILE NAME OK!' then
    begin
      Mem:=TFileStream.Create(OpenDialog1.FileName,fmOpenRead);
      try
        Posi:=0;
        IdUDPClient1.Send('Send File:File Length:'+IntToStr(Mem.Size));
        ReceivedString := IdUDPClient1.ReceiveString();
        if UpperCase(ReceivedString)='RECIVED FILE LENGTH OK!' then
        begin
          While Posi<Mem.Size do//一次只发1024个字节,字节数不能太多,不过应该还可以增加一些.
          begin
            Len:=1024;
            if Mem.Size-Posi<1024 then
              Len:=Mem.Size-Posi;
            Mem.Read(p,Len);
            IdUDPClient1.SendBuffer(P,Len);
            Inc(Posi,Len);
            Gauge1.Progress:=Round(Posi/Mem.Size*100);
            ReceivedString := IdUDPClient1.ReceiveString();
            if UpperCase(ReceivedString)<>'RECIVED FILE PACKAGE OK!' then
              Break;
            Application.ProcessMessages;
          end;
          IdUDPClient1.Send('Send File:File End!');
        end else
          ShowMessage('Send file cancel!');
      finally
        Mem.Free;
      end;
    end;
end;
end;

end.

服务器端

unit UnitServer;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer,IdSocketHandle,
IdAntiFreezeBase, IdAntiFreeze, Gauges;

type
TFormServer = class(TForm)
    IdUDPServer1: TIdUDPServer;
    SaveDialog1: TSaveDialog;
    Gauge1: TGauge;
    procedure IdUDPServer1UDPRead(Sender: TObject; AData: TStream;ABinding: TIdSocketHandle);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
private
    FileName:String;
    FileSize:Integer;
    Mem:TFileStream;
    { Private declarations }
public
    { Public declarations }
end;

var
FormServer: TFormServer;

implementation

{$R *.dfm}

procedure TFormServer.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
ABinding: TIdSocketHandle);
Var Str:String;
begin
AData.Seek(0,0);
SetLength(Str,AData.Size);
AData.Read(Str[1],AData.Size);
if Pos('Send file:File Name:',Str)>0 then
begin
    Delete(Str,1,Length('Send file:File Name:'));
    FileName:=Str;
    Str:='Recived File Name OK!';
    ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, Str[1], Length(Str));
end else if Pos('Send File:File Length:',Str)>0 then
begin
    Delete(Str,1,Length('Send File:File Length:'));
    FileSize:=StrToIntDef(Str,0);
    SaveDialog1.FileName:=FileName;
    if SaveDialog1.Execute then
    begin
      FileName:=SaveDialog1.FileName;
      if FileExists(FileName) then
        DeleteFile(FileName);
      if Mem<>nil then
      begin
        Mem.Free;
        Mem:=nil;
      end;
      if not FileExists(FileName) then
        Mem:=TFileStream.Create(FileName,fmOpenReadWrite or fmCreate)
      else
        Mem:=TFileStream.Create(FileName,fmOpenReadWrite);
      Str:='Recived File Length OK!';
      ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, Str[1], Length(Str));
    end else
    begin
      Str:='Recived File Length Cancel!';
      ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, Str[1], Length(Str));
    end;
end else if Pos('Send File:File End!',Str)>0 then
begin
    if Mem<>nil then
    begin
      Mem.Free;
      Mem:=nil;
      Str:='Recived File OK!';
      ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, Str[1], Length(Str));
    end;
    FileName:='';
    FileSize:=0;
end
else
begin
    if Mem<>nil then
    begin
      Mem.Seek(0,2);
      AData.Seek(0,0);
      Mem.CopyFrom(AData,AData.Size);
      Gauge1.Progress:=Round(Mem.Size/FileSize*100);
      Str:='Recived File Package OK!';
      ABinding.SendTo(ABinding.PeerIP, ABinding.PeerPort, Str[1], Length(Str));
      Application.ProcessMessages;
    end;
end;
end;

procedure TFormServer.FormCreate(Sender: TObject);
begin
IdUDPServer1.Active:=True;
FileName:='';
FileSize:=0;
Mem:=nil;
end;

procedure TFormServer.FormDestroy(Sender: TObject);
begin
if Mem<>nil then
    Mem.Free;
end;

end.

procedure TGisMapForm.SetAllVidIconXY;
var i: Integer;
X, Y: Integer;
begin
    for i := Low(VI) to High(VI) do
        if VI[i].Img.Visible then
        begin
            GetOffsetXY(VI[i].X, VI[i].Y, X, Y);
            VI[i].Img.Left := X;
            VI[i].Img.Top := Y;
            VI[i].Img.Repaint;
        end;
end;

procedure TGisMapForm.GetOffsetXY(X: Integer; Y: Integer; var OffSetX: integer; var OffSetY: Integer);
var
    ZM: Double; //缩放度
    VX, VY: Integer;
    OX, OY: Integer;
begin
    ZM := Map.Zoom;
    VX := Map.ViewX;
    VY := Map.ViewY;
    OX := Map.OffsetX;
    OY := Map.OffsetY;
    OffSetX := Round(X * ZM / 100 - VX + OX);
    OffSetY := Round(Y * ZM / 100 - VY + OY);
end;

procedure TGisMapForm.UnderGetOffsetXY(OffSetX: integer; OffSetY: Integer;var X: Integer;var Y: Integer);
var
    ZM: Double; //缩放度
    VX, VY: Integer;
    OX, OY: Integer;
begin
    ZM := Map.Zoom;
    VX := Map.ViewX;
    VY := Map.ViewY;
    OX := Map.OffsetX;
    OY := Map.OffsetY;
    X:=Round((OffSetX+VX- OX)* 100 / ZM);
    Y:=Round((OffSetY+VY- OY)* 100 /ZM);
end;

也可參考 https://wenku.baidu.com/view/e167fc68011ca300a6c39053.html

Tuesday, 31 October 2017

[DELPHI] ClientSocket/ServerSocket.

TClientSocket and TServerSocket missing from XE8

How to install TClientSocket and TServerSocket back into your Delphi / C++ Builder XE8 RadStudio IDE.

Select the menu Component->Install Packages
Click on the Add... button
Navigated to your XE8 install directory probably C:\Program Files (x86)\Embarcadero\Studio\16.0\bin
Select dclsockets220.bpl and press open

TclientSocket和TserverSocket

ClientSocket组件为客户端组件。它是通信的请求方，也就是说，它是主动地与服务器端建立连接。

ServerSocket组件为服务器端组件。它是通信的响应方，也就是说，它的动作是监听以及被动接受客户端的连接请
求，并对请求进行回复。

DelphiXE Android的所有权限按照分类总结说明

相关资料：http://www.delphitop.com/html/Android/2778.html

网络相关的：

android.permission.INTERNET 允许程序打开网络套接字

android.permission.CHANGE_NETWORK_STATE 允许程序改变网络连接状态

android.permission.ACCESS_NETWORK_STATE 允许程序访问有关GSM网络信息

位置相关：

android.permission.WRITE_GSERVICES
允许程序修改Google服务地图(Allows an application to modify the Googleservice map. )

android.permission.ACCESS_COARSE_LOCATION
允许一个程序访问CellID或WiFi热点来获取粗略的位置(Allows anapplication to access coarse (e.g., Cell-ID, WiFi) location)

android.permission.ACCESS_FINE_LOCATION
允许一个程序访问精良位置(如GPS) (Allows an application to access fine (e.g., GPS)location)

android.permission.ACCESS_LOCATION_EXTRA_COMMANDS
允许应用程序访问额外的位置提供命令(Allows anapplication to access extra location provider commands)

android.permission.ACCESS_MOCK_LOCATION
允许程序创建模拟位置提供用于测试(Allows anapplication to create mock location providers for testing)

android.permission.CONTROL_LOCATION_UPDATES
允许启用禁止位置更新提示从无线模块(Allows enabling/disabling location update notifications from the radio. )

wifi相关：

android.permission.ACCESS_COARSE_LOCATION 允许一个程序访问CellID或WiFi热点来获取粗略的位置

android.permission.ACCESS_WIFI_STATE 允许程序访问Wi-Fi网络状态信息

android.permission.CHANGE_WIFI_STATE 允许程序改变Wi-Fi连接状态

蓝牙相关：

android.permission.BLUETOOTH 允许程序连接到已配对的蓝牙设备

android.permission.BLUETOOTH_ADMIN 允许程序发现和配对蓝牙设备

广播：

android.permission.BROADCAST_PACKAGE_REMOVED
允许程序广播一个提示消息在一个应用程序包已经移除后(Allows anapplication to broadcast a notification that an application package has beenremoved)

android.permission.BROADCAST_STICKY
允许一个程序广播常用intents(Allowsan application to broadcast sticky intents)

android.permission.RECEIVE_BOOT_COMPLETED
允许一个程序接收到ACTION_BOOT_COMPLETED广播在系统完成启动(Allows anapplication to receive the ACTION_BOOT_COMPLETED that is broadcast after thesystem finishes booting. )

短信相关：

android.permission.READ_SMS
允许程序读取短信息(Allows anapplication to read SMS messages.)

android.permission.RECEIVE_SMS
允许程序监控一个将收到短信息，记录或处理(Allows anapplication to monitor incoming SMS messages, to record or perform processingon them.)

android.permission.SEND_SMS
允许程序发送SMS短信(Allows an application to send SMS messages)

android.permission.WRITE_SMS
允许程序写短信(Allows anapplication to write SMS messages)

android.permission.RECEIVE_MMS
允许一个程序监控将收到MMS彩信,记录或处理(Allows anapplication to monitor incoming MMS messages, to record or perform processingon them. )

android.permission.RECEIVE_WAP_PUSH
允许程序监控将收到WAP PUSH信息(Allows an application to monitor incoming WAP pushmessages. )

拨打电话相关：

android.permission.CALL_PHONE
允许一个程序初始化一个电话拨号不需通过拨号用户界面需要用户确认(Allows anapplication to initiate a phone call without going through the Dialer userinterface for the user to confirm the call being placed.)

android.permission.CALL_PRIVILEGED
允许一个程序拨打任何号码，包含紧急号码无需通过拨号用户界面需要用户确认(Allows anapplication to call any phone number, including emergency numbers, withoutgoing through the Dialer user interface for the user to confirm the call beingplaced)

android.permission.PROCESS_OUTGOING_CALLS
允许程序监视、修改有关播出电话(Allows an application to monitor, modify, or abort outgoing calls)

android.permission.READ_CONTACTS
允许程序读取用户联系人数据(Allows anapplication to read the user’s contacts data.)

android.permission.WRITE_CONTACTS
允许程序写入但不读取用户联系人数据(Allows anapplication to write (but not read) the user’s contacts data. )

系统级权限：

android.permission.ADD_SYSTEM_SERVICE
允许程序发布系统级服务(Allows anapplication to publish system-level services).

android.permission.MANAGE_APP_TOKENS
允许程序管理(创建、催后、 z- order默认向z轴推移)程序引用在窗口管理器中(Allows anapplication to manage (create, destroy, Z-order) application tokens in thewindow manager. )

android.permission.DUMP
允许程序返回状态抓取信息从系统服务(Allows anapplication to retrieve state dump information from system services.)

android.permission.INTERNAL_SYSTEM_WINDOW
允许打开窗口使用系统用户界面(Allows anapplication to open windows that are for use by parts of the system userinterface. )

android.permission.MOUNT_UNMOUNT_FILESYSTEMS
允许挂载和反挂载文件系统可移动存储(Allowsmounting and unmounting file systems for removable storage. )

android.permission.READ_LOGS
允许程序读取底层系统日志文件(Allows anapplication to read the low-level system log files. )

android.permission.SET_ACTIVITY_WATCHER
允许程序监控或控制activities已经启动全局系统中Allows an application to watch and controlhow activities are started globally in the system.

android.permission.WRITE_SETTINGS
允许程序读取或写入系统设置(Allows anapplication to read or write the system settings. )

android.permission.WRITE_SYNC_SETTINGS
允许程序写入同步设置(Allowsapplications to write the sync settings)

Friday, 6 October 2017

Delphi XE10 取得android Wifi資訊

[转]http://kamilia1470.pixnet.net/blog/post/199762657-delphi-xe10-%E5%8F%96%E5%BE%97android-wifi%E8%B3%87%E8%A8%8A

網路上查了很多取得Wifi資訊的方式
但都是XE6 XE7
Code丟到XE10都不能用
以下是XE10測試成功的Code
uses Androidapi.Helpers, Androidapi.JNI.JavaTypes, Androidapi.JNIBridge,
Androidapi.JNI.GraphicsContentViewText,Androidapi.JNI.Net;
procedure TForm2.FormCreate(Sender: TObject);
var
Service: JObject;
WifiManager: JWifiManager;
ConnectionInfo: JWifiInfo;
ScanResults: JList;
ScanResult: JScanResult;
I: Integer;
begin
Memo.Lines.Clear;
Service := SharedActivity.getSystemService(TJContext.JavaClass.WIFI_SERVICE);
WifiManager := TJWifiManager.Wrap((Service as ILocalObject).GetObjectID);
if not WifiManager.isWifiEnabled then
Memo.Lines.Add('Wifi is disabled')
else
begin
ConnectionInfo := WifiManager.getConnectionInfo;
Memo.Lines.Add('Connection info');
Memo.Lines.Add(' SSID: ' + JStringToString(ConnectionInfo.getSSID));
Memo.Lines.Add(' BSSID: ' + JStringToString(ConnectionInfo.getBSSID));
Memo.Lines.Add(' MAC address: ' + JStringToString(ConnectionInfo.getMacAddress));
ScanResults := WifiManager.getScanResults;
for I := 0 to ScanResults.size - 1 do
begin
Memo.Lines.Add('');
Memo.Lines.Add('Detected access point ' + IntToStr(I));
ScanResult := TJScanResult.Wrap((ScanResults.get(I) as ILocalObject).GetObjectID);
Memo.Lines.Add(' SSID: ' + JStringToString(ScanResult.SSID));
Memo.Lines.Add(' BSSID: ' + JStringToString(ScanResult.BSSID));
Memo.Lines.Add(' Capabilities: ' + JStringToString(ScanResult.capabilities));
Memo.Lines.Add(' Frequency: ' + IntToStr(ScanResult.frequency) + 'MHz');
Memo.Lines.Add(' Signal level: ' + IntToStr(ScanResult.level) + 'dBm');
end
end
end

Plan Oct 2017

1. Cool water
2. Add wood
3. Road Tex
4. CCTV
5. Doctor

verificar conexion a internet Firemonkey con Rad

Thursday, 5 October 2017

Android获取当前网络状态

转载地址：http://blog.csdn.net/gdutxiaoxu/article/details/53008266

Detect an internet connection activation with Delphi

uses WinInet;

function IsConnected: boolean;
const
  // local system uses a modem to connect to the Internet.
  INTERNET_CONNECTION_MODEM      = 1;
  // local system uses a local area network to connect to the Internet.
  INTERNET_CONNECTION_LAN        = 2;
  // local system uses a proxy server to connect to the Internet.
  INTERNET_CONNECTION_PROXY      = 4;
  // local system's modem is busy with a non-Internet connection.
  INTERNET_CONNECTION_MODEM_BUSY = 8;

var
  dwConnectionTypes : DWORD;
begin
  dwConnectionTypes := INTERNET_CONNECTION_MODEM +
                       INTERNET_CONNECTION_LAN +
                       INTERNET_CONNECTION_PROXY;
  Result := InternetGetConnectedState(@dwConnectionTypes,0);
end;

Delphi 防止程序多次运行《转》

//防止多次打开
unit MultInst;
interface
uses Windows ,Messages, SysUtils, Classes, Forms;
implementation
const
STR_UNIQUE    = '{2BE6D96E-827F-4BF9-B33E-8740412CDE96}';
MI_ACTIVEAPP = 1; {激活应用程序}
MI_GETHANDLE = 2; {取得句柄}
var
iMessageID    : Integer;
OldWProc      : TFNWndProc;
MutHandle     : THandle;
BSMRecipients : DWORD;
function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint; stdcall;
begin
Result := 0;
if Msg = iMessageID then
begin
    case wParam of
      MI_ACTIVEAPP: {激活应用程序}
        if lParam<>0 then
        begin
          {收到消息的激活前一个实例}
          {为什么要在另一个程序中激活?}
          {因为在同一个进程中SetForegroundWindow并不能把窗体提到最前}
          if IsIconic(lParam) then
            OpenIcon(lParam)
          else
            SetForegroundWindow(lParam);
          Application.Terminate; {终止本实例}
        end;
      MI_GETHANDLE: {取得程序句柄}
        begin
          PostMessage(HWND(lParam), iMessageID, MI_ACTIVEAPP, Application.Handle);
        end;
    end;
end
else
    Result := CallWindowProc(OldWProc, Handle, Msg, wParam, lParam);
end;
procedure InitInstance;
begin
{取代应用程序的消息处理}
OldWProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(@NewWndProc)));
{打开互斥对象}
MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, STR_UNIQUE);
if MutHandle = 0 then
begin
    {建立互斥对象}
    MutHandle := CreateMutex(nil, False, STR_UNIQUE);
end
else
begin
    Application.ShowMainForm := False;
    {已经有程序实例,广播消息取得实例句柄}
    BSMRecipients := BSM_APPLICATIONS;
    BroadcastSystemMessage(BSF_POSTMESSAGE or BSF_POSTMESSAGE,@BSMRecipients,iMessageID,MI_GETHANDLE,Application.Handle);
    //BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE, @BSMRecipients, iMessageID, MI_GETHANDLE,Application.Handle);
end;
end;
initialization
{注册消息}
iMessageID := RegisterWindowMessage(STR_UNIQUE);
InitInstance;
finalization
{还原消息处理过程}
if OldWProc <> Nil then
    SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(OldWProc));
{关闭互斥对象}
if MutHandle <> 0 then
    CloseHandle(MutHandle);
end.

Delphi获取CPU CPUID《转》

uses
ActiveX, ComObj;

function GetWMIProperty(WMIType, WMIProperty:AnsiString):String;
var
Wmi, Objs, Obj:OleVariant;
Enum:IEnumVariant;
C:Cardinal;
begin
try
    Wmi:= CreateOleObject(AnsiString('WbemScripting.SWbemLocator'));
    Objs := Wmi.ConnectServer(AnsiString('.'),AnsiString('root\cimv2')).ExecQuery(AnsiString('Select * from Win32_'+WMIType));

    Enum:=IEnumVariant(IUnknown(Objs._NewEnum));
    Enum.Reset;
    Enum.Next(1,Obj,C);
    Obj:=Obj.Properties_.Item(WMIProperty,0).Value;
    if VarIsArray(Obj) then Result:=Obj[0]
    else Result:=Obj;
except
     Result:='Error';
end;
end;

ShowMessage(GetWMIProperty('Processor','ProcessorId'));

【转】http://www.cnblogs.com/LceMeaning/p/7284202.html

手机电脑互传文件的小工具

http://www.mye100.com/filetransfer/

Tuesday, 3 October 2017

Delphi 10 android 获取网络状态

http://www.cnblogs.com/LceMeaning/p/3509327.html

Helo World

Monday, 2 October 2017

SDK Error

1
C:\Users\Public\Documents\Embarcadero\Studio\17.0\PlatformSDKs\android-sdk-windows\build-tools\22.0.1\ZipAlign.exe
C:\Users\x\AppData\Local\Android\android-sdk\build-tools\26.0.0\ZipAlign.exe

2
C:\Users\Public\Documents\Embarcadero\Studio\17.0\PlatformSDKs\android-sdk-windows\build-tools\22.0.1\Aapt.exe
C:\Users\x\AppData\Local\Android\android-sdk\build-tools\26.0.0

C:\Users\Public\Documents\Embarcadero\Studio\17.0\PlatformSDKs\android-sdk-windows\platforms\android-22
C:\Users\Public\Documents\Embarcadero\Studio\17.0\PlatformSDKs\android-sdk-windows\platforms\android-26

2018 Mar 30 added

Friday, 29 September 2017

Enabling USB Debugging on an Android Device

The steps to enable USB debugging depend on the version of Android running on the target device, as indicated in the following table:

「轉自」http://docwiki.embarcadero.com/RADStudio/Berlin/en/Enabling_USB_Debugging_on_an_Android_Device

[Exec Error] The command exited with code 1.

[Exec Error] The command "PATH C:\Program Files\Java\jdk1.7.0_71\bin;C:\Users\Public\Documents\Embarcadero\InterBase\redist\InterBaseXE7\IDE_spoof;C:\ProgramData\Oracle\Java\javapath;C:\Program Files (x86)\Embarcadero\Studio\17.0\bin;C:\Users\Public\Documents\Embarcadero\Studio\17.0\Bpl;C:\Program Files (x86)\Embarcadero\Studio\17.0\bin64;C:\Users\Public\Documents\Embarcadero\Studio\17.0\Bpl\Win64;C:\Windows\system32;C:\Windows;C:\Windows\System32\Wbem;C:\Windows\System32\WindowsPowerShell\v1.0\;C:\Program Files (x86)\ATI Technologies\ATI.ACE\Core-Static;C:\Users\x\AppData\Local\Microsoft\WindowsApps; & "C:\Users\x\AppData\Local\Android\android-sdk\build-tools\26.0.0\dx.bat" --dex --output="C:\Users\x\Documents\Embarcadero\Studio\Projects\Android\Debug\classes.dex" "c:\program files (x86)\embarcadero\studio\17.0\lib\Android\Debug\android-support-v4.dex.jar" "c:\program files (x86)\embarcadero\studio\17.0\lib\Android\Debug\apk-expansion.dex.jar" "c:\program files (x86)\embarcadero\studio\17.0\lib\Android\Debug\cloud-messaging.dex.jar" "c:\program files (x86)\embarcadero\studio\17.0\lib\Android\Debug\fmx.dex.jar" "c:\program files (x86)\embarcadero\studio\17.0\lib\Android\Debug\google-analytics-v2.dex.jar" "c:\program files (x86)\embarcadero\studio\17.0\lib\Android\Debug\google-play-billing.dex.jar" "c:\program files (x86)\embarcadero\studio\17.0\lib\Android\Debug\google-play-licensing.dex.jar" "c:\program files (x86)\embarcadero\studio\17.0\lib\Android\Debug\google-play-services.dex.jar" " exited with code 1.

问题解决
http://bbs.csdn.net/topics/392088615?page=1#post-402056462
关键是AAPT.EXE , 改成 C:\Users\x\AppData\Local\Android\android-sdk\build-tools\21.1.2 后就没问题。

Wednesday, 30 August 2017

PHP加前导零，去除前导零

$id = 23;
$sn = 0023;
添加前导零：
       方法一：$sn = sprintf("%04d",$id);
       方法二：$sn = str_pad($id,4,"0",STR_PAD_LEFT);
去掉前导零：
       方法一：$id = intval($sn);
       方法二：$id = ltrim($sn,"0");

http://pcwanli.blog.163.com/blog/static/4531561120122129305185/

Wednesday, 16 August 2017

user id

MY-0000 000 - ?

? = 0 ~ 9 a ~ z

Wednesday, 9 August 2017

simply loading an animated gif

5down vote

this is simply loading an animated gif and not making one

procedure TForm1.FormCreate(Sender: TObject);

begin

  ( Image1.Picture.Graphic as TGIFImage ).Animate := True;// gets it goin'

  ( Image1.Picture.Graphic as TGIFImage ).AnimationSpeed:= 500;// adjust your speed

  Form1.DoubleBuffered := True;// stops flickering

end;

Tuesday, 8 August 2017

delphi的Split函数 3种版本

[转]http://blog.163.com/ander_005/blog/static/4407724720110121044457/

一、直接使用如下函数(注：ch只能是单字符，如键盘上英文状态下的字符）
function SplitString(const Source,ch:String):TStringList;
var
temp:String;
i:Integer;
begin
Result:=TStringList.Create;
//如果是空自符串则返回空列表
if Source=''
then exit;
temp:=Source;
i:=pos(ch,Source);
while i<>0 do
begin
Result.add(copy(temp,0,i-1));
Delete(temp,1,i);
i:=pos(ch,temp);
end;
Result.add(temp);
end;

二、直接使用TStringList
procedure TForm1.Button3Click(Sender: TObject);
var
Str:String;
ResultList:TStringList;
I:Integer;
begin
str:= '南京~信息~工程~大学';

ResultList := TStringList.Create;
try
ResultList.Delimiter := '~';
ResultList.DelimitedText := str;

for I:= 0 to ResultList.Count-1 do
begin
Memo1.Lines.Add(ResultList.Strings[I]);
end;
finally
FreeAndNil(ResultList);
end;
end;

三、支持特殊字符版（ch可以为字符串，如'aa')
function SplitString(const Source,ch:String):TStringList;
var
Temp:String;
I:Integer;
chLength:Integer;
begin
Result:=TStringList.Create;
//如果是空自符串则返回空列表
if Source='' then Exit;
Temp:=Source;
I:=Pos(ch,Source);
chLength := Length(ch);
while I<>0 do
begin
Result.Add(Copy(Temp,0,I-chLength+1));
Delete(Temp,1,I-1 + chLength);
I:=pos(ch,Temp);
end;
Result.add(Temp);
end;

Saturday, 18 November 2017

Sunday, 12 November 2017

Complete TFTP Server example, using Indy components

http://code1.okbase.net/codefile/IdTrivialFTPServer.pas_201211268418_275.htm

https://stackoverflow.com/questions/20614431/can-tidtrivialftp-be-used-for-general-file-transfer-in-delphi

http://www.delphigroups.info/2/11/212422.html

https://stackoverflow.com/questions/20614431/can-tidtrivialftp-be-used-for-general-file-transfer-in-delphi

http://delphi-kb.blogspot.my/2011/03/complete-tftp-server-example-using-indy.html

Friday, 10 November 2017

Thursday, 9 November 2017

Wednesday, 8 November 2017

Thursday, 2 November 2017

Wednesday, 1 November 2017

Tuesday, 31 October 2017

Friday, 6 October 2017

Thursday, 5 October 2017

Wednesday, 4 October 2017

Tuesday, 3 October 2017

Monday, 2 October 2017

Friday, 29 September 2017

Wednesday, 30 August 2017

Wednesday, 16 August 2017

Wednesday, 9 August 2017

Tuesday, 8 August 2017