2016年8月 – QDAC数据访问组件网站

[FMX] 获取 iOS 设备的类型名称

2016-08-312017-09-23 • Delphi、iOS、教程 • 暂无评论 • swish •浏览 3,454 次

[更新] 2016.10.10 增加 iPad 和 iPod 的几款新型设备 2016.9.30 修改了 GetDeviceModel 函数，由 sysctl 改成使用 uname（Delphi 没有声明，需要声明下）增加对 iPhone 7 的设备型号列表好吧，我承认这个函数不是必需的，只是为了满足我无耻的偷窥欲

检测进程是否存在，简单方法。求更简单方法~~

2016-08-292016-09-02 • Delphi • 2 条评论 • 老衲 •浏览 2,870 次

我一直都在寻找各种业务功能的最简单写法，用减法的模式来开发软件。下面是的写法，如果有更简单的方法，请留言告知。

function CheckProcessExist(const AFileName: string): Boolean;
var
  //用于获得进程列表
  hSnapshot: THandle;
  //用于查找进程
  lppe: TProcessEntry32;
  //用于判断进程遍历是否完成
  Found: Boolean;
begin
  Result := False;
  //获得系统进程列表
  hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  //在调用Process32FirstAPI之前，需要初始化lppe记录的大小
  lppe.dwSize := SizeOf(TProcessEntry32);
  //将进程列表的第一个进程信息读入ppe记录中
  Found := Process32First(hSnapshot, lppe);
  while Found do
  begin
    if ((UpperCase(ExtractFileName(lppe.szExeFile)) = UpperCase(AFileName)) or (UpperCase(lppe.szExeFile) = UpperCase(AFileName))) then
    begin
      Result := True;
    end;
    //将进程列表的下一个进程信息读入lppe记录中
    Found := Process32Next(hSnapshot, lppe);
  end;
end;

procedure TForm4.btn1Click(Sender: TObject);
begin
  if CheckProcessExist(Trim(edt1.Text)+'.exe') then
  begin
    ShowMessage('检测到了');
  end else begin
    ShowMessage('不存在');
  end;
end;

function CheckProcessExist(const AFileName: string): Boolean;

var

//用于获得进程列表

hSnapshot: THandle;

//用于查找进程

lppe: TProcessEntry32;

//用于判断进程遍历是否完成

Found: Boolean;

begin

Result := False;

//获得系统进程列表

hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);

//在调用Process32FirstAPI之前，需要初始化lppe记录的大小

lppe.dwSize := SizeOf(TProcessEntry32);

//将进程列表的第一个进程信息读入ppe记录中

Found := Process32First(hSnapshot, lppe);

while Found do

begin

if ((UpperCase(ExtractFileName(lppe.szExeFile)) = UpperCase(AFileName)) or (UpperCase(lppe.szExeFile) = UpperCase(AFileName))) then

begin

Result := True;

end;

//将进程列表的下一个进程信息读入lppe记录中

Found := Process32Next(hSnapshot, lppe);

end;

procedure TForm4.btn1Click(Sender: TObject);

begin

if CheckProcessExist(Trim(edt1.Text)+'.exe') then

begin

ShowMessage('检测到了');

end else begin

ShowMessage('不存在');

end;

新版 THttpClient组件同步下载文件方法。

2016-08-292016-08-30 • Delphi、教程、杂谈 • 6 条评论 • 老衲 •浏览 4,390 次

我一直都在寻找各种业务功能的最简单写法，用减法的模式来开发软件。下面是我下载文件的写法，如果有更简单的方法，请留言告知。

unit Unit3;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Net.HttpClient,
  Vcl.ComCtrls;

type
  TForm3 = class(TForm)
    btnStart: TButton;
    ProgressBar1: TProgressBar;
    edt1: TEdit;
    procedure btnStartClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }

    /// <summary>
    /// 下载的时候不允许关闭窗体
    /// </summary>
    FAllowFormClose: Boolean;

    /// <summary>
    /// 接收数据事件
    /// </summary>
    procedure ReceiveDataEvent(const Sender: TObject; AContentLength: Int64; AReadCount: Int64; var Abort: Boolean);
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.ReceiveDataEvent(const Sender: TObject; AContentLength: Int64; AReadCount: Int64; var Abort: Boolean);
begin
  //加上这句界面不卡死.
  Application.ProcessMessages;
  ProgressBar1.Position := AReadCount;
end;

procedure TForm3.btnStartClick(Sender: TObject);
var
  MyHTTPClient: THTTPClient;
  MyHTTPResponse: IHTTPResponse;
  MyMemoryStream: TMemoryStream;
  downloadUrl: string;
begin
  MyHTTPClient := THTTPClient.Create;
  MyMemoryStream := TMemoryStream.Create;
  try
    btnStart.Enabled := False;
    FAllowFormClose := False;
    downloadUrl := Trim(edt1.Text);

    //获取文件的大小
    MyHTTPResponse := MyHTTPClient.Head(downloadUrl);
    ProgressBar1.Position := 0;
    ProgressBar1.Max := MyHTTPResponse.ContentLength;

    //开始下载,保存到本地
    MyHTTPClient.OnReceiveData := ReceiveDataEvent;
    MyHTTPResponse := MyHTTPClient.Get(downloadUrl, MyMemoryStream);
    if MyHTTPResponse.StatusCode = 200 then
    begin
      MyMemoryStream.SaveToFile('c:\aa.exe');
      ShowMessage('下载完成');
    end;
  finally
    MyHTTPClient.Free;
    MyMemoryStream.Free;
    //最终都允许关闭窗体
    btnStart.Enabled := True;
    FAllowFormClose := True;
  end;
end;

procedure TForm3.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := FAllowFormClose;
end;

procedure TForm3.FormCreate(Sender: TObject);
begin
  ReportMemoryLeaksOnShutdown := True;
end;

procedure TForm3.FormShow(Sender: TObject);
begin
  btnStart.Enabled := True;
  FAllowFormClose := True;
  ProgressBar1.Position := 0;
end;

end.

100

101

102

unit Unit3;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Net.HttpClient,

Vcl.ComCtrls;

type

TForm3 = class(TForm)

btnStart: TButton;

ProgressBar1: TProgressBar;

edt1: TEdit;

procedure btnStartClick(Sender: TObject);

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

procedure FormShow(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

/// <summary>

/// 下载的时候不允许关闭窗体

/// </summary>

FAllowFormClose: Boolean;

/// <summary>

/// 接收数据事件

/// </summary>

procedure ReceiveDataEvent(const Sender: TObject; AContentLength: Int64; AReadCount: Int64; var Abort: Boolean);

public

{ Public declarations }

end;

var

Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.ReceiveDataEvent(const Sender: TObject; AContentLength: Int64; AReadCount: Int64; var Abort: Boolean);

begin

//加上这句界面不卡死.

Application.ProcessMessages;

ProgressBar1.Position := AReadCount;

end;

procedure TForm3.btnStartClick(Sender: TObject);

var

MyHTTPClient: THTTPClient;

MyHTTPResponse: IHTTPResponse;

MyMemoryStream: TMemoryStream;

downloadUrl: string;

begin

MyHTTPClient := THTTPClient.Create;

MyMemoryStream := TMemoryStream.Create;

try

btnStart.Enabled := False;

FAllowFormClose := False;

downloadUrl := Trim(edt1.Text);

//获取文件的大小

MyHTTPResponse := MyHTTPClient.Head(downloadUrl);

ProgressBar1.Position := 0;

ProgressBar1.Max := MyHTTPResponse.ContentLength;

//开始下载,保存到本地

MyHTTPClient.OnReceiveData := ReceiveDataEvent;

MyHTTPResponse := MyHTTPClient.Get(downloadUrl, MyMemoryStream);

if MyHTTPResponse.StatusCode = 200 then

begin

MyMemoryStream.SaveToFile('c:\aa.exe');

ShowMessage('下载完成');

end;

finally

MyHTTPClient.Free;

MyMemoryStream.Free;

//最终都允许关闭窗体

btnStart.Enabled := True;

FAllowFormClose := True;

end;

procedure TForm3.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

CanClose := FAllowFormClose;

end;

procedure TForm3.FormCreate(Sender: TObject);

begin

ReportMemoryLeaksOnShutdown := True;

end;

procedure TForm3.FormShow(Sender: TObject);

begin

btnStart.Enabled := True;

FAllowFormClose := True;

ProgressBar1.Position := 0;

end;

end.

[iOS] 测试应用在 IPv6 环境下是否能够正常工作

2016-08-272016-08-28 • C++ Builder、Delphi、iOS、教程 • 暂无评论 • swish •浏览 2,462 次

在前面的文章中我们为服务器分配了一个 IPv6 的地址，但是仅仅有它还是不够的。就我的应用环境来说，为了通过苹果的 IPv6 Only 环境的兼容测试，我需要我的 Web 服务器能够在 IPv6 的地址上进行监听并进行响应。我的 Web 服务器使用的是 nginx，默认的编译方式下，并没有启用 IPv6，我们需要重新下

[网络] 为阿里云 CentOS 6.x 添加 IPV6 支持

2016-08-262016-08-26 • Delphi、杂谈 • 暂无评论 • swish •浏览 3,847 次

好吧，阿里云的公开CentOS 镜像将 IPV6 支持给去掉了，即使你按照网络上的教程，启用 /etc/sysconfig/network 中的 NETWORKING_IPV6 也没啥用，反正它就是不加载 IPV6 的相关模块。经过一番近乎绝望的折腾之后，终于搞定了。我们首入进入 /etc/sysconfig/mod

[iOS] Delphi/C++ Builder 如何编写、调试及发布 iOS 程序

2016-08-242016-09-18 • C++ Builder、Delphi、iOS • 4 条评论 • swish •浏览 3,808 次

第一步：准备 OSX 设备要编写和调试 iOS 程序，你至少需要一台 OSX 的设备（可以是虚拟机，也可以是真正的 Mac 设备，例如黑苹果或Macbook Pro），否则后面的步骤是没法进行的。如果你使用 VMWare workstation 或 VirtualBox 来安装虚拟机，则可以参考以前的文章： Vir

[QString] 关于新增的 JavaEscape 和 JavaUnescape 函数说明

2016-08-242016-08-25 • C++ Builder、Delphi • 1 条评论 • swish •浏览 2,125 次

QString 新增了两个函数 JavaEscape 和 JavaUnescape 来处理字符串的转义。实际上，它的转义规则和 C++/C# 基本一致，所以同样的处理也适应于 C++/C# 函数。目前该函数支持的转义序列包括： ASCII 码 7 至 13 对应的转义符，分别是： 7 -> \a 8 ->

[杂谈] 使用 Delphi 在 Vivo Y51A 手机上 Delphi 应用故障的一处问题的简单研究

2016-08-102016-08-11 • Android、杂谈 • 暂无评论 • swish •浏览 3,748 次

这个问题，实际上北京老猫在它的 FireMonkey 移动开发中已经给出了一个解决方案，要求修改 FMX.Canvas.GPU，因为实际遇到了这个情况，所以我就特意跟踪了下，我觉得真正的问题应该是出在 Vivo，或者是高通提供的驱动上的问题。FMX.Canvas.GPU 实际上低层调用的是 FMX.Context.GL

[翻译]安全存储私密信息

2016-08-10 • Delphi • 暂无评论 • 青春 •浏览 1,834 次

注：基于本人英文水平，以下翻译只是我自己的理解，如对读者造成未知影响，一切后果自负。如果发现有翻译错误的，欢迎交流指正。原文地址：http://blog.synopse.info/post/2016/05/14/AntiForensicKeyStorage 现代程序中, 特别是 Client/Server N层架构软

做最好的自己，你就是我们的英雄

2016-08-092016-08-09 • 杂谈 • 1 条评论 • swish •浏览 1,747 次

我们从未如此渴望成功，我们从未如此渴望公平，可是渴望不代表我们天真。我们知道，你们就在某个阴暗的角落里，静静的等待着我们出错，大声的将我们污蔑。可我想说，那又怎样？黑哨不代表正义，就让持有傲慢和偏见的人在自己梦中沉沦。你的努力我们都看得见，你的成就我们都看得见，做最好的自己，你就是我们的英雄

[QSDK] 在 Android 使用微信 SDK 的步骤

2016-08-092016-08-09 • Android、C++ Builder、Delphi • 1 条评论 • swish •浏览 3,066 次

iOS 版微信 SDK 集成的步骤参考：[QSDK]在 iOS 中使用微信 SDK 的步骤测试环境：微信 SDK 版本:3.1.1 QSDK 中的微信 SDK 相关的单元：qsdk.wechat,qsdk.wechat.android、libammsdk.jar 开发工具：Delphi 10.1 使用步骤： 1、新

[译]在你的 Rad Studio Android 应用中使用 Java 库

2016-08-09 • Delphi • 暂无评论 • swish •浏览 2,668 次

本文译自 Rad Studio 帮助 Using Java Libraries in Your RAD Studio Android Apps。为提供 Android 目标平台的支持，FireMonkey 应用平台需要访问 Android API 和其它 Java 库。RAD Studio 包含一套 FireMonk

[QSDK] 在 iOS 中使用微信 SDK 的步骤

2016-08-082016-08-09 • C++ Builder、Delphi、iOS • 暂无评论 • swish •浏览 2,931 次

在 Android 中集成微信 SDK 的步骤参考：[QSDK] 在 Android 使用微信 SDK 的步骤测试环境：微信 SDK 版本:1.7.2 iOS SDK 版本：9.3 QSDK 中的微信 SDK 相关的单元：qsdk.wechat.ios、iOSapi.CFNetwork、iOSapi.SCNetwo

[转]Tht:Firemonkey使用iOS的第三方静态库（Link Binary With Libraries）

2016-08-08 • Delphi、iOS • 暂无评论 • swish •浏览 2,482 次

原文地址：http://blog.csdn.net/tht2009/article/details/50183721 最近需要从内存流中直接播放音频，想到了使用第三方音频播放库bass。在windows上可以很方便的使用相应动态库（具体参考万一的博客），但在iOS上却没有相应的使用介绍，准确的说是没有用于Firemon

[教程] 在 FMX 中通过样式实现自定义样式的 TCheckBox

2016-08-06 • C++ Builder、Delphi、教程 • 4 条评论 • swish •浏览 3,178 次

这个的目的是为了让大家明白如何在 FMX 中自定义样式，结合自己在实践中遇到的问题，做一个简单的教程。首先准备好素材图片，TCheckBox 的素材要求有三组：获得焦点（ Focus ）、鼠标移入（ Hot ）和普通，每组都包含选中和未选中两种状态，对于禁用的情况下，FMX 会自动处理，不需要准备素材。我们从网站上准

[FMX] 将颜色字符串值转换为 TAlphaColor

2016-08-052016-08-06 • Android、C++ Builder、Delphi、iOS • 1 条评论 • swish •浏览 3,167 次

Delphi 自带一个 StringToAlphaColor ，我重新实现了一个自己的版本，定义为 ParseColor，区别就不说了，自己看。

function ParseColor(const S: String; ADefColor: TAlphaColor): TAlphaColor;
var
  p: PWideChar;
  V: Integer absolute Result;
  ARGB: TAlphaColorRec absolute Result;
begin
  if Length(S) > 0 then
  begin
    p := Pointer(S);
    if ((p^ >= 'a') and (p^ <= 'z')) or ((p^ >= 'A') and (p^ <= 'Z')) then
    // #AARRGGBB
    begin
      if not IdentToAlphaColor('cla' + S, V) then
        Result := ADefColor;
    end
    else if (p^ = '#') or (p^ = 'x') or (p^ = '$') or (p^ = 'H') then
    begin
      if Length(S) = 7 then // #RRGGBB?
      begin
        Inc(p);
        if TryStrToInt('$'+p, V) then
          ARGB.A := 255
        else
          Result := ADefColor;
      end
      else if Length(S) = 9 then // AARRGGBB
      begin
        Inc(p);
        if not TryStrToInt('$'+p, V) then
          Result := ADefColor;
      end
      else
        Result := ADefColor;
    end
    else
      Result := ADefColor;
  end
  else
    Result := ADefColor;
end;

function ParseColor(const S: String; ADefColor: TAlphaColor): TAlphaColor;

var

p: PWideChar;

V: Integer absolute Result;

ARGB: TAlphaColorRec absolute Result;

begin

if Length(S) > 0 then

begin

p := Pointer(S);

if ((p^ >= 'a') and (p^ <= 'z')) or ((p^ >= 'A') and (p^ <= 'Z')) then

// #AARRGGBB

begin

if not IdentToAlphaColor('cla' + S, V) then

Result := ADefColor;

end

else if (p^ = '#') or (p^ = 'x') or (p^ = '$') or (p^ = 'H') then

begin

if Length(S) = 7 then // #RRGGBB?

begin

Inc(p);

if TryStrToInt('$'+p, V) then

ARGB.A := 255

else

Result := ADefColor;

end

else if Length(S) = 9 then // AARRGGBB

begin

Inc(p);

if not TryStrToInt('$'+p, V) then

Result := ADefColor;

end

else

Result := ADefColor;

end

else

Result := ADefColor;

end

else

Result := ADefColor;

end;

[译] Delphi/C++ Builder 官方全新产品路线图

2016-08-042016-08-04 • C++ Builder、Delphi、杂谈 • 1 条评论 • swish •浏览 4,277 次

原文：http://community.embarcadero.com/article/news/16418-product-roadmap-august-2016 二月份我们提供了我们产品的一份详细路线图表并且我们确定我们将每六个月更新一次路线图以便我们的众多客户了解接下来是什么。根据众多像您一样的客户要求，我们改为

[FMX] FMX.MultiResBitmap 的一处改进

2016-08-032016-08-03 • Android、C++ Builder、Delphi、iOS、杂谈 • 暂无评论 • swish •浏览 3,246 次

红鱼儿在其博客中发表的一篇文章中引述了官方QC中的一处缺陷报告，谈到了 TCustomMultiResBitmap.ItemByScale 的效率问题，并提供了一个优化。不过我觉得它的优化有点太偷懒了，而且一旦不匹配，效率还不如原来的实现。所以我简单审视了下 ItemByScale 的代码，实际上它的效率问题在于过度优

登录