加载中…
个人资料
步惊云
步惊云
  • 博客等级:
  • 博客积分:0
  • 博客访问:10,100
  • 关注人气:3
  • 获赠金笔:0支
  • 赠出金笔:0支
  • 荣誉徽章:
访客
加载中…
好友
加载中…
评论
加载中…
博文
分类: 数据库
主表:tbM
sfid(char18), //身份证号
address(char) //户籍地
业务表:
表1、
tbMzjz //门诊救助
sfid,
je, //金额
表2、
tbZyzj //住院救助
sfid,
je
表3、
tbTempJz //临时救助
sfid;
je
统计
户籍地 门诊救助 住院救助 临时救助
--------------------------------------------------------
人数|金额 人数|金额 人数|金额
--------------------------------------------------------
良田镇 10 | 33300.22 22 |45622.56 32| 65801.29
桥口镇 21 | 43210.88 11 |21239.33 18| 32010.77
select distinct tbobject.town,ZyjzSum,ZyjzCount ,MzjzSum,MzjzCount,TempSum,TempCount
from tbobject
left join
(select town,sum(jzje) as ZyjzSum,count(tbZyjz.sfid) as ZyjzCount from tbZyjz
left join tbobject on tbobject.sfid=tbzyjz.sfid
where sfsp='√'
group by town)a on a.town=tbobject.town

left join
(select town,sum(jzje) as MzjzSum,count(tbMzjz.sfid) as MzjzCount from tbMzjz
left join tbobject on tbobject.sfid=tbmzjz.sfid
group by town)b on b.town=tbobject.town

left join
(select town,sum(jzje) as TempSum,count(tbtempjz.sfid) as TempCount from tbTempjz
left join tbobject on tbobject.sfid=tbtempjz.sfid
group by town)c on c.town=tbobject.town
阅读  ┆ 评论  ┆ 转载 ┆ 收藏 
分类: VCL

1、取字符串以数字开头的数据

function TForm1.getNumberFromStr(cString:string): string;

var

i:integer;

str:string;

begin

str:='';

For i:=1 to length(cString) do

begin

if Pos(cString[i],'0123456789.')<=0 then

break

else

Case cString[i] of

'.': str:=Str+'.';

'0': str:=Str+'0'; '1': str:=Str+'1'; '2': str:=Str+'2';

'3': str:=Str+'3'; '4': str:=Str+'4'; '5': str:=Str+'5';

'6': str:=Str+'6'; '7': str:=Str+'7';

'8': str:=Str+'8'; '9': str:=Str+'9';

end;

end;

result:=str;

end;

2、动态菜单

procedure TForm1.FormCreate(Sender: TObject);

var

i:integer;

ArrItem:array of TMenuItem;

begin

SetLength(ArrItem,20);

PopupMenu1.Items.Clear;

for i := 0 to 19 do

begin

ArrItem[i]:=TMenuItem.Create(self);

ArrItem[i].Caption:=inttostr(i);

ArrItem[i].OnClick:=MenuItemClick;

PopupMenu1.Items.Add(ArrItem[i]);

PopupMenu1.AutoHotkeys:= maManual;

end;

end;

3、从excel文件中读取图片

procedure TForm1.BitBtn1Click(Sender: TObject);

var

Bitmaps: array of TBitmap;

i,ImgCount:integer;

begin

if OpenDialog1.Execute() then

self.XLSReadWriteII51.Filename:=self.OpenDialog1.FileName;

self.XLSReadWriteII51.Read;

ImgCount:= self.XLSReadWriteII51.Sheets[0].Drawing.Images.Count;

SetLength(Bitmaps,ImgCount);

for I := 0 to ImgCount-1 do

BitMaps[i]:= XLSReadWriteII51.Sheets[0].Drawing.Images[i].CreateBitmap;

Image1.Picture.Bitmap:=BitMaps[0];

Image2.Picture.Bitmap:=BitMaps[1];

Image3.Picture.Bitmap:=BitMaps[2];

Image4.Picture.Bitmap:=BitMaps[3];

end;

4、注册odbc。

没安装sqlanywhere odbc的环境将无法启动exe。要用RegSvr32。 RegSvr32 d:\YzdjSrv\dbodbc8.dll

5、压缩图片

var

AStream:TMemoryStream;

jpg: TJpegImage;

begin

AStream:=TMemoryStream.Create;

jpg := TJPEGImage.Create;

jpg.Assign(BitMaps[0]);

jpg.CompressionQuality := 60;

jpg.Compress;

jpg.SaveToFile('g:\1.jpg');

jpg.SaveToStream( AStream);

AStream.SaveToFile('g:\2.jpg');

6、访问服务器网页

http://222.242.155.31:55688/Yzdjsrv/platform/5PHD5GkC8W.Jpg

7、删除文件

procedure DeleteDirectory(const Name: string);

var

F: TSearchRec;

begin

if FindFirst(Name + '\*', faAnyFile, F) = 0 then begin

try

repeat

if (F.Attr and faDirectory <> 0) then begin

if (F.Name <> '.') and (F.Name <> '..') then begin

DeleteDirectory(Name + '\' + F.Name);

end;

end else begin

DeleteFile(Name + '\' + F.Name);

end;

until FindNext(F) <> 0;

finally

FindClose(F);

end;

RemoveDir(Name);

end;

end;

8、快速简单遍历文件夹

uses System.IOUtils,System.Types;

procedure TForm1.Button1Click(Sender: TObject);

var

aimDir:string;

dir: TDirectory;

files: TStringDynArray;//需要 Types 单元支持

str: string;

begin

aimDir:='F:\report';

files := dir.GetFiles(aimDir, '*.fr3', TSearchOption.soAllDirectories);

Memo1.Lines.Clear;

for str in files do

Memo1.Lines.Add(ExtractFileName(str));

Memo1.Lines.Add(inttostr( High(files)));

end;

9、只能输入人民币的Edit

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);

var

DotPos,Len:integer;

begin

DotPos:=pos('.',(Sender as TEdit).Text);

Len:=length((Sender as TEdit).Text);

if key in ['0'..'9',#8,'.','+','-'] then

begin

if (key in ['+','-']) then

begin

//只能在光标处于第一的位置,才能输入'+'或者'-'

if ((Sender as TEdit).SelStart>0) then

begin

key:=#0;

exit;

end;

//'+','-'互斥

if (pos('+',(Sender as TEdit).Text)>0) or (pos('-',(Sender as TEdit).Text)>0) then

begin

key:=#0;

exit;

end;

end;

if key in ['.'] then

begin

//只能输入一个'.'

if (DotPos>0) then

begin

key:=#0;

exit;

end;

//只能在'+','-'后面输入'.'

if (pos('+',(Sender as TEdit).Text)>0) or (pos('-',(Sender as TEdit).Text)>0) then

if ((Sender as TEdit).SelStart<=0) then

begin

key:=#0;

exit;

end;

//小数点必须在最后两位

if (DotPos<=0) and ((Sender as TEdit).SelStart<Len-2) then

begin

key:=#0;

exit;

end;

end;

if key in ['0'..'9'] then

//小数点后面最多两位

if (DotPos>0) and (DotPos<=Len-2) and ((Sender as TEdit).SelStart>=DotPos) then

key:=#0 ;

end

else

key:=#0;

end;

阅读  ┆ 评论  ┆ 转载 ┆ 收藏 
(2020-11-25 17:24)
标签:

杂谈

分类: FMX$Datasnap

泛型是一种占位替代。先设计好一个模板,这个模板可以是类、结构体、数组、函数等,模板的可变数据类型部分先用<T>占个位,然后在最终使用时,迭代为具体真实的数据类型。objectpascal对泛型支持上,对泛型函数似乎还不够彻底。

implementation

{$R *.fmx}

type

TArr<T> = array of T; //定义一个泛型数组类型

Ttest<T1,T2>=record //定义一个泛型结构

a:T1;

b:T2;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

Arr:Tarr<integer>;//具体使用时,必须替换为真实数据类型

i:integer;

begin

SetLength(Arr,10);

for i := Low(Arr) to High(Arr) do

Arr[i] := i * i;

Memo1.Lines.Clear;

for i := Low(Arr) to High(Arr) do

Memo1.Lines.Add(Format('Arr[%d] = %d', [i, Arr[i]]));

end;

procedure TForm1.Button2Click(Sender: TObject);

var

Arecord:Ttest<string,string>;//具体使用时,必须替换为真实数据类型

begin

Arecord.a:='测试';

ARecord.b:='泛型';

Memo1.Lines.Clear;

Memo1.Lines.Add(ARecord.a+arecord.b);

end;

阅读  ┆ 评论  ┆ 转载 ┆ 收藏 
分类: FMX$Datasnap

首先要理解什么是回调函数,可以参考这篇博文什么是回调函数

       DataSnap支持在客户端写的回调函数,也就是服务端的主调函数的参数可以是一个客户端写好的回调函数名,这样调用主调函数时,客户端的回调函数也将会调用。

例如,我们修改EchoString方法,向其中添加回调支持,EchoString方法是主调函数:

Function EchoString(Value: string; callback: TDBXcallback): string;

TDBXcallback类定义在DBXJSON单元,这是一个虚拟类,是对客户端回调函数的包装。

在我们实现服务端主调EchoString方法前,先搞清楚如何在客户端定义回调函数(毕竟,这是一个可以让服务端调用的客户端方法)。

在客户端,我们必须定义一个新类,从TDBXCallbacK继承,重写其Execute方法.

type

    TCallbackClient = class(TDBXCallback)

public

    function Execute(const Arg: TJSONValue): TJSONValue; override;

end;

在Execute方法中,有一个TJSONValue类型的参数,而且返回值也是TJSONValue,TJSONValue是Json数据类型TJSONObject, TJSONArray, TJSONNumber, TJSONString, TJSONTrue, TJSONFalse, TJSONNull的父类,也就是可以传递和返回多种数据类型。

可以复制(Clone)这个参数然后设置其具体内容.Execute方法也返回一个TJSONValue类型的值,这里我们只返回同样的值。

function TCallbackClient.Execute(const Arg: TJSONValue): TJSONValue;//实现回调函数

var

    Data: TJSONValue;

begin

    Data := TJSONValue(Arg.Clone);//深度复制

    ShowMessage('Callback: ' + TJSONObject(Data).Get(0).JSonValue.value);

    Result := Data

end;

例如, 在方法实际返回前(如方法正在执行),回调函数将显示EchoString方法传递参数的值。服务端新的EchoString方法实现需要将String值赋给一个TJSONObject对象,并将其传递给回调函数.如下:

function TServerMethods2.EchoString(Value: string; callback: TDBXcallback): string;//实现主调函数

var

    msg: TJSONObject;

    pair: TJSONPair;

begin

    Result := Value;

    msg := TJSONObject.Create;

    pair := TJSONPair.Create('ECHO', Value);

    pair.Owned := True;

    msg.AddPair(pair);

    callback.Execute(msg);

end;

注意这个回调函数将在客户端执行—然后在服务端Echostring方法执行完毕前返回

最后,在客户端调用EchoString方法也需要修改,因为我们现在要提供一个回调类TCallbackClient的实例,如

下所示:

var

MyCallback: TCallbackClient;

begin

    MyCallback := TCallbackClient.Create;

try

    Server.EchoString(Edit1.text, MyCallback);

finally

    MyCallback.Free;

end;

end;

为何datasnap的EchoString主调函数不使用函数类型为参数,而要使用 TDBXcallback这个类?

其实,要在datansap与客户端传递信息,数据格式是要受限制的,除一般基础类型外,能够支持的数据类型还有Json、TStream,包括过程类型、类类型、接口、数组这些类型是不能传递的。所以,EchoString不能直接使用普通过程类型的参数。

TDBXcallback这个类其实是虚拟类,它是对回调函数 Execute的包装而已。TDBXcallback是DBXJSON单元实现的类,这个单元是对专门对Json类型进行处理而设计的,可以用于服务器与客户端的通信。



阅读  ┆ 评论  ┆ 转载 ┆ 收藏 
(2020-11-05 11:51)
分类: FMX$Datasnap

implementation

uses

Androidapi.Helpers,

FMX.Helpers.Android,

FMX.Platform,

FMX.Platform.Android,

Androidapi.JNI.GraphicsContentViewText,

Androidapi.JNI.JavaTypes,

Androidapi.JNI.Os,

Androidapi.JNI.Telephony,

Androidapi.JNI.Net,

Androidapi.JNI, Androidapi.JNI.Provider,

Androidapi.JNIBridge,

System.Permissions;

{$R *.fmx}

{$IFDEF Android}

function GetAndroidID(): string;

var

JObj: JObject;

JTM: JTelephonyManager;

begin

try

JObj := SharedActivityContext.getSystemService(TJContext.JavaClass.TELEPHONY_SERVICE);

if Assigned(JObj) then begin

JTM := TJTelephonyManager.Wrap( (JObj as ILocalObject).GetObjectID );

if ASsigned(JTM) then begin

Result:= JStringToString(JTM.getDeviceId);

end;

end;

finally

if Result = '' then begin

showmessage('');

Result:= JStringToString(TJSettings_Secure.JavaClass.getString(SharedActivity.getContentResolver, TJSettings_Secure.JavaClass.ANDROID_ID));

end;

end;

end;

{$ENDIF}

procedure TForm1.Button1Click(Sender: TObject);

begin

Edit1.Text:= GetAndroidID;

end;

procedure TForm1.FormCreate(Sender: TObject);

var

AStr:string;

begin

//程序启动时获得读取电话状态权限

AStr := JStringToString(TJManifest_permission.JavaClass.READ_PHONE_STATE);

PermissionsService.RequestPermissions([AStr], nil, nil);

end;

end.

阅读  ┆ 评论  ┆ 转载 ┆ 收藏 
(2020-10-20 17:00)
标签:

匿名函数

分类: FMX$Datasnap
一、匿名函数是一种数据类型
这个有点像函数类型、过程类型,可以定义匿名函数类型。
implementation
{$R *.fmx}
type
  TFun = reference to function(const num: Integer): Integer; {用 reference 定义匿名方法类型}
二、匿名函数没有函数名,是一种嵌套函数,也是一个代码块
函数或过程就是一个代码块,你可以把一个代码块赋值给一个匿名函数变量。
procedure TForm1.Button1Click(Sender: TObject);
var
  fun: TFun;
  n: Integer;
begin
   //定义一个没有名字的函数来求平方,这个是函数里面再定义函数
  fun := function(const a: Integer): Integer {注意本行最后不能有 ; 号}
  begin
    Result := a * a;
  end;
  n := fun(9);
  ShowMessage(IntToStr(n)); {81}
  //再定义一个没有名字的函数来求倍数
  fun := function(const a: Integer): Integer
  begin
    Result := a + a;
  end;
  n := fun(9);
  ShowMessage(IntToStr(n)); {18}
end;
三、匿名函数可以用做其它函数的参数,或函数的返回值
匿名函数既然是数据类型,就可以放在表示数据类型的任何地方,包括函数体内。
implementation

{$R *.fmx}
//先定义一个匿名函数类型
type
  TFun = reference to function(const num: Integer): Integer; {用 reference 定义匿名方法类型}
//再定义一个有匿名函数作为参数的函数
function FunTest(const n: Integer; fun: TFun): string;
  begin
    Result :=IntTostr(Fun(n));
  end;
procedure TForm1.Button2Click(Sender: TObject);
var
  f: TFun;
  s: string;
begin
  f := function(const a: Integer): Integer {注意本行最后不能有 ; 号}
  begin
    Result := a * a;
  end;
  s := FunTest(10, f);
  ShowMessage(s); {9, 81}
end;
//或者直接把匿名函数块传给函数的参数,即在调用时直接写函数
procedure TForm1.Button3Click(Sender: TObject);
var
  s:string;
begin
  ShowMessage(
  FunTest(10, function(const a: Integer): Integer
  begin
    Result := a * a;
  end)
  );
end;
四、匿名函数的用处
匿名函数主要用做闭包,在javascript中使用广泛,在delphi中使用不多,特别是vcl中,但在FMX中,有时会遇到。例如,在android中模拟模式对话框。
procedure TForm1.Button3Click(Sender: TObject);
var
   AFDJSONDelta: TFDJSONDeltas;
begin
 TDialogServiceAsync.MessageDialog
    (
      '真的删除记录吗?', TMsgDlgType.mtInformation,
      [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo,TMsgDlgBtn.mbCancel],
      TMsgDlgBtn.mbYes, 0,
      procedure(const AResult: TModalResult)
      begin
        if AResult=mrYes then
        begin
          FDMemTable2.Open;
          FDMemTable2.Delete;
          AFDJSONDelta:= TFDJSONDeltas.Create;
          TFDJSONDeltasWriter.ListAdd(AFDJSONDelta, FDMemTable2);
          ClientModule1.ServerMethods1Client.UpdateTable('tbtest',AFDJSONDelta);
            Form1.Button4Click(Sender);
          showmessage('记录删除了');
        end
        else if AResult=mrNo then
        begin
          showmessage('没有删除任何记录');
        end
      end
    );
end;
这里,TDialogServiceAsync.MessageDialog函数的最后一个参数,是一个匿名方法类型,调用DialogServiceAsync.MessageDialog时,直接把匿名方法块写在参数的位置,会等到该匿名方法调用返回后才最后完成MessageDialog的调用。
可以参考万一的https://www.cnblogs.com/del/archive/2008/08/15/1268301.html
阅读  ┆ 评论  ┆ 转载 ┆ 收藏 
(2020-08-09 21:12)
标签:

delphi

分类: VCL
class function TForm1.RMBFloatToChinese(ARMBCash: Real): string;
const
  cNum: WideString = '零壹贰叁肆伍陆柒捌玖-万仟佰拾亿仟佰拾万仟佰拾元角分';
  cCha: array [0 .. 1, 0 .. 11] of string =
    (('零仟', '零佰', '零拾', '零零零', '零零', '零亿', '零万', '零元', '亿万', '零角', '零分', '零整'),
    ('零', '零', '零', '零', '零', '亿', '万', '元', '亿', '零', '整', '整'));
var
  i: Integer;
  sNum: WideString;
begin
  Result := '';
  sNum := FormatFloat('0', ARMBCash * 100);
  for i := 1 to Length(sNum) do
    Result := Result + cNum[Ord(sNum[i]) - 47] + cNum[26 - Length(sNum) + i];
  for i := 0 to 11 do // 去掉多余的零
    Result := StringReplace(Result, cCha[0, i], cCha[1, i], [rfReplaceAll]);
end;
阅读  ┆ 评论  ┆ 转载 ┆ 收藏 
标签:

frame

vcl

delphi

子窗口

分类: VCL

管理型程序往往有很多子模块,如果都写在主程序是非常难于维护的。因此把业务写在子窗口中,然后在主控窗口中创建并调用子窗口,实现模块化编程。以前用delphi xe,只要记住一点,用全局变量引用创建的Form,用后和创建前,一律FreeAndNil,就不会有内存访问错误和重复创建问题,但10.3,这样操作会频繁出现不可解决的内存管理问题,可能是内存管理方式与xe不同导致的,必须另谋出路。

一、用Form还是Frame

必须用Frame。Frame是纯vcl控件,里面的消息管理机制比较简单。Form则是一个复杂的vcl/win32窗口控件,delphi对它进行了复杂处理,比如消除处理机制,同时还有些处理是隐藏的。当然一次性创建相同窗口,一般不会出现问题。但重复创建不同的子窗口,则肯定会频繁出现invalid pointer opertor错误,有时正常有时不正常,这个问题具有一定隐匿性,要反复测试才会重现问题。

二、怎样创建

procedure TYzdjMainFM.RzGroup1Items4Click(Sender: TObject);
var
  FrArchives:TFrArchives;
  OldFr:TComponent;
begin
    FindOldFr(OldFr);
    if Assigned(OldFr) then FreeAndNil(OldFr);
    FrArchives:=TFrArchives.Create(self);
    FrArchives.Name:='FrArchives';
    FrArchives.Parent:=RzPanel2;
    FrArchives.Align:=alclient;
    FrArchives.SetFocus;
    FrArchives.Show;
end;

procedure TYzdjMainFM.RzGroup1Items5Click(Sender: TObject);
  var
   FrFinanReg:TFrFinanReg;
   OldFr:TComponent;
begin
  FindOldFr(OldFr);
  if Assigned(OldFr) then FreeAndNil(OldFr);
  FrFinanReg:=TFrFinanReg.Create(self);
  FrFinanReg.Name:='FrFinanReg';
  FrFinanReg.Parent:=RzPanel2;
  FrFinanReg.Align:=alClient;
  FrFinanReg.SetFocus;
  FrFinanReg.Show;
end;

三、怎样避免内存访问错误

一是必须   FrFinanReg.SetFocus;防止子窗口焦点乱跑,这个是内嵌窗口的通病,

二是创建前必须先在内存里寻找是否有该Frame的实例,如果没有才创建。

这里必须对前面已经创建的各类Frame对象进行销毁。

Procedure TYzdjMainFM.FindOldFr(var OldFr:TComponent);
begin
   if FindComponent('FrArchives')<>nil then OldFr:=FindComponent('FrArchives');
   if FindComponent('FrFinanReg')<>nil then OldFr:=FindComponent('FrFinanReg');

   ..........//所有要创建的窗口对象找到后都必须销毁
end;

三是用局部变量接纳窗口变量,实践表明,如果用全局变量引用不同的窗口变量,又会导致新的内存管理错误。

这样写后,不管子窗口里有任何复杂的内在操作,例如动态创建窗口、流、数据集等,都不会再出现内存访问错误。

四、怎样初始化Frame

 覆盖这两个事件方法,可分别在这两个事件中初始化和事后处理。

 private
    { Private declarations }
  public
    { Public declarations }
     procedure AfterConstruction; override;   //类似OnCreate事件
    procedure BeforeDestruction; override; //类型OnDestroy事件
  end;

但是没有onclose。

//初始化,给DBComboBoxEh1添加下拉选项

procedure TFrArchives.AfterConstruction;
var
  TempFdq:TFdquery;
begin
  inherited;//这个必须写在第一句
  TempFdq:=TFdquery.Create(self);
  TempFdq.Connection:=MainDataMd.FDConnection1;
  TempFdq.Open('select * from dmArchtype order by xh');
  while not TempFdq.Eof do
  begin
    DBComboBoxEh1.Items.Add(TempFdq.Fields[1].asstring);
    TempFdq.Next;
  end;
end;

 



 

阅读  ┆ 评论  ┆ 转载 ┆ 收藏 
(2020-05-28 20:55)
分类: FMX$Datasnap

回调函数,说穿了就是把回调函数当成主调函数的参数,也就是把回调函数地址传给主调函数,在主调函数体中适时调用回调函数。这样当主调函数调用时,回调函数也被调用了。

在主调函数定义时,在主周函数调用时传实参。

1、定义回调函数原型。

type

TProc=procedure (S:string) ;//函数或过程数据类型,类型必须与回调函数完全一致。

TForm1 = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

2、定义回调函数。

这就是一个普通的函数而已,也就是回调函数。

procedure Test(S:string);

begin

ShowMessage(S);

end;

3、定义主调函数。

这个是主调函数,该函数是一个特别的函数,特别之处在于这个函数有一个参数是函数或过程数据类型。

procedure dotest(value:string;Proc:TProc);

begin

//此处调用回调函数,objectpascal规定可用过程变量名代替函数名进行函数调用

    Proc(value);  //此时传形参

end;

4、调用主调函数

//执行主调函数时,此时回调函数的函数名称是主调函数的一个参数

procedure TForm1.Button1Click(Sender: TObject);

begin

    dotest('这是测试程序',test);  //此处传实参

end;

5、回调函数有什么用?

这样做有两个用途。

一是主调函数只要管函数的格式,而不需要知道函数是如何实现的。

二是主调函数与回调函数可以不在同一物理空间。例如,客户端调用datasnap rest服务器上的一个主调函数,而这个主调函数有一个参数是回调函数,回调函数的实现是在客户端,这样可以实现服务器对客户端函数的调用,具体参考http://blog.sina.com.cn/s/blog_61214b550102z0kk.html

阅读  ┆ 评论  ┆ 转载 ┆ 收藏 
标签:

firedac

数据库连接池

datasnap

分类: FMX$Datasnap

查了网上很多代码都不行,从delphi 10.3中帮助文件,直接抄写现成代码。&#8203;

新建一个datasnap rest server ,然后在项目中建一个数据模块ConnectDM,在数据模块中放置FDConnection等组件。

&#8203;请注意:数据模块中可以放置公共组件,请不要放在数据模块ServerMethodsUnit1单元中,因为这个单元会为每个连接生成一个实例,这个可在该模块的oncreate事件中写代码证实确实每次连接都会触发一次oncreate事件,前提是DSServerClass1的lifecycle设置为session生命周期。&#8203;

现在在ConnectDM的oncreate写这样的代码:&#8203;

procedure TConnectDM.DataModuleCreate(Sender: TObject);

var

oDef: IFDStanConnectionDef;

oParams: TFDPhysMSSQLConnectionDefParams; // MSSQL connection params

const cNameConnDef = 'MSSQL_Connection';

begin

// Adding new persistent connection to fdconnectiondefs.ini

FDManager.ConnectionDefs.AddConnectionDef;

oDef := FDManager.ConnectionDefs.AddConnectionDef;

oDef.Name := cNameConnDef;

oParams := TFDPhysMSSQLConnectionDefParams(oDef.Params);

oParams.DriverID := 'MSSQL' ;

oParams.Database := 'Adj';

oParams.UserName := 'MyminUser';

oParams.Password := '20513';

oParams.Server := '212.225.153.74,3228';

oParams.Pooled:=true;//这里开启

oParams.PoolCleanupTimeout:=0;

oParams.PoolExpireTimeout:=0;

oParams.PoolMaximumItems:=100;

//oParams.MARS := false;

//oDef.MarkPersistent;

oDef.Apply;

FDConnection1.ConnectionDefName := cNameConnDef;

FDConnection1.Connected := True;

end;&#8203;

注意,有时重启项目时会提示'MSSQL_Connection'重复,请找到C:\Users\Public\Documents\Embarcadero\Studio\FireDAC\FDConnectionDefs.ini,删除'MSSQL_Connection'节点即可。

最后,发布该应用项目时,可以不带&#8203;FDConnectionDefs.ini(这个我自己没搞懂为什么可以让'MSSQL_Connection'不写入FDConnectionDefs.ini)。&#8203;

怎么证实开启了数据库线程池呢?&#8203;将有数据库查询操作的datasnap rest编译项目放在服务器上,用JMeter测试其中访问数据库查询的函数网页,如果将Jmeter中线程组的线程数据设为300,而oParams.PoolMaximumItems:=100;此时测试Jmeter会提示出错,{"error":"[FireDAC][Stan]-708. Cannot acquire item (connection) from pool. Maximal number [100] of simultaneous items (connections) reached."},意思是 {“错误”:“[FireDAC][Stan]-708。无法从池中获取项(连接)。已达到同时项(连接)的最大数目[100]。“}

)如果修改为300则不出错。

阅读  ┆ 评论  ┆ 转载 ┆ 收藏 
  

新浪BLOG意见反馈留言板 电话:4000520066 提示音后按1键(按当地市话标准计费) 欢迎批评指正

新浪简介 | About Sina | 广告服务 | 联系我们 | 招聘信息 | 网站律师 | SINA English | 会员注册 | 产品答疑

新浪公司 版权所有