天天看点

Some Delphi tips

====================================

conversion routines

====================================

Format('There are now %d records in the table %s', [10,'TableA']); -->格式化字符串

function Now(): TDateTime; --> 返回当前的日期和时间, DateTime类型(其实就是double型)

function Date(): TDateTime; --> Returns the current date.

function CompareDateTime(const A, B: TDateTime): int; -->比较2个日期

function EncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word):

TDateTime; -->拼日期

procedure DecodeDateTime(const AValue: TDateTime; out AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word);

ExtractFilePath(Application.ExeName) -->获取当前程序路径

//简单类型转换

function IntToStr(Value: Integer): string;

function FloatToStr(Value: Extended): string;

Format('%d%s',[100,'hello'])

procedure DateTimeToString(var Result: string; const Format: string; DateTime: TDateTime);

function FormatDateTime(const Format: string; DateTime: TDateTime): string;

格式'yyyymmddhhnnsszzz' 是精确到毫秒的格式

FormatDateTime()和DateTimeToString() 都能很好将日期格式化成String, 但没有那种根据格式解析DateTime的函数, 需要自己写, 或者找开源的rx_library库

//char和string的转换

Char=>String: StringOfChar(char1, 1), 或者 char1+''即可

String=>Char: String使用下标即可转成Char, 比如String123[0]

//PChar和String的互换

String=>PChar

     最好使用 PChar('your_string') 强转; 使用StrPCopy(Dest: PChar; const Source: string), 它有时会报内存错误.

function StrPas(const Str: PChar): string;

    Converts null-terminated string to an AnsiString (long string)

====================================

how to use Win32 system functions

====================================

function GetTempPath1: string;

var

  TempDir: array[0..255] of Char;

  //DWORD GetTempPath(DWORD nBufferLength, LPTSTR lpBuffer);

begin

  GetTempPath(255, @TempDir);

  Result := StrPas(TempDir);

end;

====================================

refresh FORM appearance in a busy loop

====================================

procedure TMainForm.Btn_Stress_Test_LoopClick(Sender: TObject);

var

  I: Integer;

begin

    for I := 0 to StrToInt(edt_total_count.Text) do

    begin

      edt_current_index.Text:=IntToStr(I);

      self.stressTest();

      Application.ProcessMessages();  

    end;

end;

====================================

解决DCOM中间层报错问题, 报错信息是: Name not unique in this context

====================================

这是一个基于DCOM技术开发的老程序, 包含中间层和客户端, 中间层使用MultiInstance 进程 + Apartment 线程模型, 有一个Remote data module通过BDE技术连接Oracle.

当多个客户端同时连中间层时, 经常能碰到报错: Name not unique in this context.

原因分析: MultiInstance 进程模式的中间层, 也就是一个进程服务所有的RPC调用. 当有多个RPC进来的时候, 启用多线程方式进行服务.  所以需要中间层有一个session管理机制. 默认情况下, BDE中间层仅仅有一个default session, 一旦多个客户端同时连着并作查询, 程序会在同一个session中, 创建数据结果集或其他对象, 就会报"Name not unique in this context."错误.

解决方法是:

首先:Remote data model上, 加 Session1(TSession 组件), 设置AutoSessionName=True, 假设 SessionName为Session1_2 .

接着:确保DBE TDatabase 组件SessionName为Session1的SessionName, 即Session1_2

最后:为Session1 设置PrivateDir. 确保每个连上中间层的session都有一个唯一的PrivateDir, 否则还会报 Directory is busy 错误.  我的做法是在Session1Startup事件中, 为session1动态指定一个临时目录.

测试的策略:

要模拟多个客户端'同时'连接中间层, 需要有点策略.  我的做法是: 随便找一个查询, 循环100次封装成一个方法. 然后启动3份客户端程序, 同时运行这个新的循环程序. 因为有100次循环, 所以必然会有多个客户端同时连接中间层.

增加 TSession 组件,

object Session1: TSession

  AutoSessionName = True

  KeepConnections = False

  PrivateDir = ' '

  OnStartup = Session1Startup

  SessionName= 'Session1_2'

  Left = 32

  Top = 104

end

确保DBE TDatabase 组件SessionName为Session1的SessionName, 不是Session1的组件名字.

object your_db: TDatabase

  AliasName = 'your_db'

  DatabaseName = 'your_db'

  KeepConnection = False

  LoginPrompt = False

  Params.Strings = (

    'user name=user1'

    'password=pwd')

  SessionName = 'Session1_2'

  Left = 24

  Top = 48

end

procedure TApp.Session1Startup(Sender: TObject);

var

   TempDir: array[0..255] of Char;

   tempPath:String ;

   fullPrivatePath:String;   

begin

    // set private dir for this new session

    GetTempPath(255, @TempDir);

    tempPath:= StrPas(TempDir);    

    fullPrivatePath:=tempPath+guid_str(); //使用guid来保证目录的唯一性

    CreateDirectory(PChar(fullPrivatePath),nil);

    Session1.PrivateDir:= fullPrivatePath;

end;