- Actman 3 added (not adopted)

git-svn-id: http://svn.miranda-ng.org/main/trunk@5391 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c

1 files changed, 1023 insertions, 0 deletions

diff --git a/plugins/Actman30/iac_service.pas b/plugins/Actman30/iac_service.pas
new file mode 100644
index 0000000000..67a565c477
--- /dev/null
+++ b/plugins/Actman30/iac_service.pas
@@ -0,0 +1,1023 @@
+unit iac_service;

+

+interface

+

+implementation

+

+uses

+  windows, messages, commctrl,

+  global, iac_global,

+  m_api,

+  sedit,strans,mApiCardM,

+  mirutils,dbsettings, editwrapper,

+  syswin,wrapper,common;

+

+{$include i_cnst_service.inc}

+{$resource iac_service.res}

+

+const

+  ACF_PARNUM  = $00000001; // Param is number

+  ACF_UNICODE = $00000002; // Param is Unicode string

+  ACF_CURRENT = $00000004; // Param is ignored, used current user handle

+                           // from current message window

+  ACF_RESULT  = $00000008; // Param is previous action result

+  ACF_PARAM   = $00000010; // Param is Call parameter

+  ACF_STRUCT  = $00000020;

+  ACF_PARTYPE = ACF_PARNUM  or ACF_UNICODE or

+                ACF_CURRENT or ACF_RESULT  or

+                ACF_PARAM   or ACF_STRUCT;

+

+  ACF_RSTRING  = $00010000; // Service result is string

+  ACF_RUNICODE = $00020000; // Service result is Widestring

+  ACF_RSTRUCT  = $00040000; // Service result in structure

+  ACF_RFREEMEM = $00080000; // Need to free memory

+

+  ACF_SCRIPT_PARAM   = $00001000;

+  ACF_SCRIPT_SERVICE = $00002000;

+  // dummy

+  ACF_STRING = 0;

+

+const

+  opt_service  = 'service';

+  opt_flags2   = 'flags2';

+  opt_wparam   = 'wparam';

+  opt_lparam   = 'lparam';

+const

+  ioService   = 'service';

+  ioType      = 'type';

+  ioResult    = 'result';

+  ioCurrent   = 'current';

+  ioParam     = 'param';

+  ioStruct    = 'struct';

+  ioValue     = 'value';

+  ioNumber    = 'number';

+  ioUnicode   = 'unicode';

+  ioVariables = 'variables';

+  ioWParam    = 'WPARAM';

+  ioLParam    = 'LPARAM';

+  ioOutput    = 'OUTPUT';

+  ioFree      = 'free';

+  ioAnsi      = 'ansi';

+  ioInt       = 'int';

+

+type

+  tServiceAction = class(tBaseAction)

+  private

+    service:PAnsiChar;

+    wparam :pWideChar;

+    lparam :pWideChar;

+    flags2 :dword;

+  public

+    constructor Create(uid:dword);

+    destructor Destroy; override;

+//    function  Clone:tBaseAction; override;

+    function  DoAction(var WorkData:tWorkData):LRESULT; override;

+    procedure Save(node:pointer;fmt:integer); override;

+    procedure Load(node:pointer;fmt:integer); override;

+  end;

+

+//----- Support functions -----

+

+//----- Object realization -----

+

+constructor tServiceAction.Create(uid:dword);

+begin

+  inherited Create(uid);

+end;

+

+procedure ClearParam(flags:dword; var param);

+begin

+  if (flags and (ACF_CURRENT or ACF_RESULT or ACF_PARAM))=0 then

+    mFreeMem(pointer(param));

+end;

+

+destructor tServiceAction.Destroy;

+begin

+  mFreeMem(service);

+  ClearParam(flags ,wparam);

+  ClearParam(flags2,lparam);

+

+  inherited Destroy;

+end;

+{

+function tServiceAction.Clone:tBaseAction;

+begin

+  result:=tServiceAction.Create(0);

+  Duplicate(result);

+

+  tServiceAction(result).flags2 :=flags2;

+  StrDup(tServiceAction(result).service,service);

+

+  if (flags and (ACF_PARNUM or ACF_RESULT or ACF_PARAM))=0 then

+    StrDup(pAnsiChar(tServiceAction(result).wparam),pAnsiChar(wparam))

+  else if ((flags and ACF_PARNUM)<>0) and ((flags and ACF_SCRIPT_PARAM)<>0) then

+    StrDup(pAnsiChar(tServiceAction(result).wparam),pAnsiChar(wparam))

+  else

+    tServiceAction(result).wparam:=wparam;

+

+  if (flags2 and (ACF_PARNUM or ACF_RESULT or ACF_PARAM))=0 then

+    StrDup(pAnsiChar(tServiceAction(result).lparam),pAnsiChar(lparam))

+  else if ((flags2 and ACF_PARNUM)<>0) and ((flags and ACF_SCRIPT_PARAM)<>0) then

+    StrDup(pAnsiChar(tServiceAction(result).lparam),pAnsiChar(lparam))

+  else

+    tServiceAction(result).lparam:=lparam;

+end;

+}

+procedure PreProcess(flags:dword;var l_param:LPARAM;const WorkData:tWorkData);

+var

+  tmp1:pWideChar;

+begin

+  with WorkData do

+  begin

+    if (flags and ACF_STRUCT)<>0 then

+    begin

+      l_param:=uint_ptr(MakeStructure(pAnsiChar(l_param),Parameter,LastResult,ResultType))

+    end

+    else if (flags and ACF_PARAM)<>0 then

+    begin

+      l_param:=Parameter;

+    end

+    else if (flags and ACF_RESULT)<>0 then

+    begin

+      l_param:=LastResult;

+    end

+    else if (flags and ACF_CURRENT)<>0 then

+    begin

+      l_param:=WndToContact(WaitFocusedWndChild(GetForegroundwindow){GetFocus});

+    end

+    else

+    begin

+      if (flags and ACF_SCRIPT_PARAM)<>0 then

+        l_param:=uint_ptr(ParseVarString(pWideChar(l_param),Parameter));

+

+      tmp1:=pWideChar(l_param);

+      if (flags and ACF_PARNUM)=0 then

+      begin

+        if (flags and ACF_UNICODE)=0 then

+          WideToAnsi(tmp1,pAnsiChar(l_param),MirandaCP)

+        else

+          StrDupW(pWideChar(l_param),tmp1);

+      end

+      else

+        l_param:=NumToInt(tmp1);

+

+      if (flags and ACF_SCRIPT_PARAM)<>0 then

+        mFreeMem(tmp1);

+    end;

+  end;

+end;

+

+procedure PostProcess(flags:dword;var l_param:LPARAM; var WorkData:tWorkData);

+var

+  code:integer;

+  len:integer;

+  pc:pAnsiChar;

+begin

+  if (flags and ACF_STRUCT)<>0 then

+  begin

+    with WorkData do

+    begin

+      LastResult:=GetStructureResult(l_param,@code,@len);

+      case code of

+{

+        SST_LAST: begin

+          result:=LastResult;

+        end;

+}

+        SST_PARAM: begin //??

+          LastResult:=Parameter;

+          ResultType:=rtInt;

+        end;

+        SST_BYTE,SST_WORD,SST_DWORD,

+        SST_QWORD,SST_NATIVE: begin

+          ResultType:=rtInt;

+        end;

+        SST_BARR: begin

+          StrDup(pAnsiChar(pc),pAnsiChar(LastResult),len);

+          AnsiToWide(pAnsiChar(pc),PWideChar(LastResult),MirandaCP);

+          mFreeMem(pAnsiChar(pc));

+          ResultType:=rtWide;

+        end;

+        SST_WARR: begin

+          StrDupW(pWideChar(LastResult),pWideChar(LastResult),len);

+          ResultType:=rtWide;

+        end;

+        SST_BPTR: begin

+          AnsiToWide(pAnsiChar(LastResult),pWideChar(LastResult),MirandaCP);

+          ResultType:=rtWide;

+        end;

+        SST_WPTR: begin

+          StrDupW(pWideChar(LastResult),pWideChar(LastResult));

+          ResultType:=rtWide;

+        end;

+      end;

+      FreeStructure(l_param);

+      l_param:=0;

+    end

+  end;

+end;

+

+function tServiceAction.DoAction(var WorkData:tWorkData):LRESULT;

+var

+  buf:array [0..255] of AnsiChar;

+  lservice:pAnsiChar;

+  lwparam,llparam:TLPARAM;

+  res:int_ptr;

+begin

+  result:=0;

+

+  lservice:=service;

+  lwparam :=TLPARAM(wparam);

+  llparam :=TLPARAM(lparam);

+  // Service name processing

+  if (flags and ACF_SCRIPT_SERVICE)<>0 then

+    lservice:=ParseVarString(lservice,WorkData.Parameter);

+    

+  StrCopy(buf,lservice);

+  if StrPos(lservice,protostr)<>nil then

+    if CallService(MS_DB_CONTACT_IS,WorkData.Parameter,0)=0 then

+    begin

+      if (flags and ACF_SCRIPT_SERVICE)<>0 then

+        mFreeMem(lservice);

+      exit;

+    end

+    else

+      StrReplace(buf,protostr,GetContactProtoAcc(WorkData.Parameter));

+

+  if ServiceExists(buf)<>0 then

+  begin

+

+    PreProcess(flags ,lwparam,WorkData);

+    PreProcess(flags2,llparam,WorkData);

+

+    res:=CallServiceSync(buf,lwparam,llparam);

+    ClearResult(WorkData);

+

+    // result type processing

+    if (flags and ACF_RSTRING)<>0 then

+    begin

+//!! delete old or not?

+      if (flags and ACF_RUNICODE)=0 then

+        AnsiToWide(pAnsiChar(res),pWideChar(WorkData.LastResult),MirandaCP)

+      else

+        StrDupW(pWideChar(WorkData.LastResult),pWideChar(res));

+      WorkData.ResultType:=rtWide;

+

+      if (flags and ACF_RFREEMEM)<>0 then

+        mFreeMem(pAnsiChar(res)); //?? Miranda MM??

+    end

+    else if (flags and ACF_RSTRUCT)=0 then

+      WorkData.ResultType:=rtInt

+    else if (flags and ACF_RSTRUCT)<>0 then

+    begin

+      PostProcess(flags ,lwparam,WorkData);

+      PostProcess(flags2,llparam,WorkData);

+    end;

+

+    // free string (ansi+unicode) parameters

+    if ((flags and ACF_PARTYPE)=ACF_STRING) or

+       ((flags and ACF_PARTYPE)=ACF_UNICODE) then

+      mFreeMem(pointer(lwparam));

+    if ((flags2 and ACF_PARTYPE)=ACF_STRING) or

+       ((flags2 and ACF_PARTYPE)=ACF_UNICODE) then

+      mFreeMem(pointer(llparam));

+  end;

+  if (flags and ACF_SCRIPT_SERVICE)<>0 then

+    mFreeMem(lservice);

+end;

+

+procedure LoadParam(section:PAnsiChar;flags:dword; var param:pointer);

+begin

+  if (flags and (ACF_CURRENT or ACF_RESULT or ACF_PARAM))=0 then

+  begin

+    if (flags and ACF_STRUCT)<>0 then

+      param:=DBReadUTF8(0,DBBranch,section,nil)

+    else

+      param:=DBReadUnicode(0,DBBranch,section,nil);

+  end;

+end;

+

+function ReadParam(act:HXML; var param:pWideChar;isvar:boolean):dword;

+var

+  tmp:pWideChar;

+begin

+  result:=0;

+  if act=0 then

+    exit;

+  with xmlparser do

+  begin

+    tmp:=getAttrValue(act,ioType);

+    if      lstrcmpiw(tmp,ioCurrent)=0 then result:=result or ACF_CURRENT

+    else if lstrcmpiw(tmp,ioResult )=0 then result:=result or ACF_RESULT

+    else if lstrcmpiw(tmp,ioParam  )=0 then result:=result or ACF_PARAM

+    else if lstrcmpiw(tmp,ioStruct )=0 then

+    begin

+      result:=result or ACF_STRUCT;

+//!!!!      param:=ReadStruct(act);

+    end

+    else

+    begin

+      StrDupW(pWideChar(param),getAttrValue(act,ioValue));

+

+      if      lstrcmpiw(tmp,ioNumber )=0 then result:=result or ACF_PARNUM

+      else if lstrcmpiw(tmp,ioUnicode)=0 then result:=result or ACF_UNICODE;

+//      else if lstrcmpiw(tmp,ioAnsi)=0 then;

+    end;

+  end;

+end;

+{

+function ReadParamINI(node:pointer;prefix:pAnsiChar;var param:pWideChar;isvar:boolean):dword;

+var

+  pc,pc1:pAnsiChar;

+  buf:array [0..63] of AnsiChar;

+begin

+  result:=0;

+  pc1:=StrCopyE(buf,prefix);

+  pc:=GetParamSectionStr(node,StrCopy(pc1,ioType));

+  if      lstrcmpi(pc,ioCurrent)=0 then result:=result or ACF_CURRENT

+  else if lstrcmpi(pc,ioResult )=0 then result:=result or ACF_RESULT

+  else if lstrcmpi(pc,ioParam  )=0 then result:=result or ACF_PARAM

+  else if lstrcmpi(pc,ioStruct )=0 then

+  begin

+    result:=result or ACF_STRUCT;

+//!!!!      param:=ReadStruct(act);

+  end

+  else

+  begin

+    UTF8ToWide(GetParamSectionInt(node,StrCopy(pc1,ioValue)),param);

+

+    if      lstrcmpi(pc,ioNumber )=0 then result:=result or ACF_PARNUM

+    else if lstrcmpi(pc,ioUnicode)=0 then result:=result or ACF_UNICODE;

+//      else if lstrcmpi(pc,ioAnsi)=0 then;

+  end;

+end;

+}

+procedure tServiceAction.Load(node:pointer;fmt:integer);

+var

+  section: array [0..127] of AnsiChar;

+  pc:pAnsiChar;

+  sub:HXML;

+  tmp:pWideChar;

+begin

+  inherited Load(node,fmt);

+

+  case fmt of

+    0: begin

+      pc:=StrCopyE(section,pAnsiChar(node));

+

+      StrCopy(pc,opt_service); service:=DBReadString(0,DBBranch,section,nil);

+      StrCopy(pc,opt_flags2 ); flags2 :=DBReadDword (0,DBBranch,section);

+

+      StrCopy(pc,opt_wparam); LoadParam(section,flags ,pointer(wparam));

+      StrCopy(pc,opt_lparam); LoadParam(section,flags2,pointer(lparam));

+    end;

+

+    1: begin

+      with xmlparser do

+      begin

+        FastWideToAnsi(getAttrValue(HXML(node),ioService),service);

+//!!!!        StrDupW(service,getAttrValue(HXML(node),ioService));

+        if StrToInt(getAttrValue(HXML(node),ioVariables))=1 then

+          flags:=flags or ACF_SCRIPT_SERVICE;

+

+        sub:=getNthChild(HXML(node),ioWParam,0);

+        if StrToInt(getAttrValue(sub,ioVariables))=1 then

+          flags:=flags or ACF_SCRIPT_PARAM;

+        flags:=flags or ReadParam(sub,wparam,(flags and ACF_SCRIPT_PARAM)<>0);

+

+        sub:=getNthChild(HXML(node),ioLParam,0);

+        if StrToInt(getAttrValue(sub,ioVariables))=1 then

+          flags2:=flags2 or ACF_SCRIPT_PARAM;

+        flags2:=flags2 or ReadParam(sub,lparam,(flags2 and ACF_SCRIPT_PARAM)<>0);

+

+        sub:=getNthChild(HXML(node),ioOutput,0);

+        if StrToInt(getAttrValue(sub,ioFree))=1 then flags:=flags or ACF_RFREEMEM;

+

+        tmp:=getAttrValue(sub,ioType);

+        if      lstrcmpiw(tmp,ioUnicode)=0 then flags:=flags or ACF_RUNICODE

+        else if lstrcmpiw(tmp,ioAnsi   )=0 then flags:=flags or ACF_RSTRING

+        else if lstrcmpiw(tmp,ioStruct )=0 then flags:=flags or ACF_RSTRUCT

+        else if lstrcmpiw(tmp,ioInt    )=0 then ;

+      end;

+    end;

+{

+    2: begin

+      StrDup(service,GetParamSectionStr(node,ioService));

+//!!!!      UTF8ToWide(GetParamSectionStr(node,ioService),service);

+      if GetParamSectionInt(node,ioVariables)=1 then

+        flags:=flags or ACF_SCRIPT_SERVICE;

+

+      if GetParamSectionInt(node,ioWParam+'.'+ioVariables))=1 then

+        flags:=flags or ACF_SCRIPT_PARAM;

+      flags:=flags or ReadParamINI(node,ioWParam+'.',wparam,(flags and ACF_SCRIPT_PARAM)<>0);

+

+      if GetParamSectionInt(node,ioLParam+'.'+ioVariables))=1 then

+        flags2:=flags2 or ACF_SCRIPT_PARAM;

+      flags2:=flags2 or ReadParamINI(node,ioLParam+'.',lparam,(flags2 and ACF_SCRIPT_PARAM)<>0);

+

+      if GetParamSectionInt(node,ioFree)=1 then flags:=flags or ACF_RFREEMEM;

+

+      pc:=GetParamSectionStr(node,ioType);

+      if      lstrcmpi(pñ,ioUnicode)=0 then flags:=flags or ACF_RUNICODE

+      else if lstrcmpi(pñ,ioAnsi   )=0 then flags:=flags or ACF_RSTRING

+      else if lstrcmpi(pñ,ioStruct )=0 then flags:=flags or ACF_RSTRUCT

+//      else if lstrcmpi(pñ,ioInt    )=0 then ;

+    end;

+}

+  end;

+end;

+

+procedure SaveParam(section:PAnsiChar;flags:dword; param:pointer);

+begin

+  if (flags and (ACF_CURRENT or ACF_RESULT or ACF_PARAM))=0 then

+  begin

+    if pointer(param)<>nil then

+    begin

+      if (flags and ACF_STRUCT)<>0 then

+        DBWriteUTF8(0,DBBranch,section,param)

+      else

+        DBWriteUnicode(0,DBBranch,section,param);

+    end;

+  end;

+end;

+

+procedure tServiceAction.Save(node:pointer;fmt:integer);

+var

+  section: array [0..127] of AnsiChar;

+  pc:pAnsiChar;

+begin

+  inherited Save(node,fmt);

+

+  case fmt of

+    0: begin

+      pc:=StrCopyE(section,pAnsiChar(node));

+

+      StrCopy(pc,opt_service); DBWriteString(0,DBBranch,section,service);

+      StrCopy(pc,opt_flags2 ); DBWriteDWord (0,DBBranch,section,flags2);

+

+      StrCopy(pc,opt_wparam); SaveParam(section,flags ,pointer(wparam));

+      StrCopy(pc,opt_lparam); SaveParam(section,flags2,pointer(lparam));

+    end;

+{

+    1: begin

+    end;

+}

+  end;

+end;

+

+//----- Dialog realization -----

+

+const

+  ptNumber  = 0;

+  ptString  = 1;

+  ptUnicode = 2;

+  ptCurrent = 3;

+  ptResult  = 4;

+  ptParam   = 5;

+  ptStruct  = 6;

+const

+  sresInt    = 0;

+  sresString = 1;

+  sresStruct = 2;

+

+procedure MakeResultTypeList(wnd:HWND);

+begin

+  SendMessage(wnd,CB_RESETCONTENT,0,0);

+  InsertString(wnd,sresInt   ,'Integer');

+  InsertString(wnd,sresString,'String');

+  InsertString(wnd,sresStruct,'Structure');

+  SendMessage(wnd,CB_SETCURSEL,0,0);

+end;

+

+procedure MakeParamTypeList(wnd:HWND);

+begin

+  SendMessage(wnd,CB_RESETCONTENT,0,0);

+  InsertString(wnd,ptNumber ,'number value');

+  InsertString(wnd,ptString ,'ANSI string');

+  InsertString(wnd,ptUnicode,'Unicode string');

+  InsertString(wnd,ptCurrent,'current contact');

+  InsertString(wnd,ptResult ,'last result');

+  InsertString(wnd,ptParam  ,'parameter');

+  InsertString(wnd,ptStruct ,'structure');

+  SendMessage(wnd,CB_SETCURSEL,0,0);

+end;

+

+var

+  ApiCard:tmApiCard;

+  

+function FixParam(Dialog:HWND;buf:PAnsiChar;flag:integer):integer;

+begin

+  if      StrCmp(buf,Translate('hContact'    ))=0 then result:=ptCurrent

+  else if StrCmp(buf,Translate('parameter'   ))=0 then result:=ptParam

+  else if StrCmp(buf,Translate('result'      ))=0 then result:=ptResult

+  else if StrCmp(buf,Translate('structure'   ))=0 then result:=ptStruct

+  else if StrCmp(buf,Translate('Unicode text'))=0 then result:=ptUnicode

+  else

+  begin

+    if (buf[0] in ['0'..'9']) or ((buf[0]='-') and (buf[1] in ['0'..'9'])) or

+      ((buf[0]='$') and (buf[1] in sHexNum)) or

+      ((buf[0]='0') and (buf[1]='x') and (buf[2] in sHexNum)) then

+      result:=ptNumber

+    else

+      result:=ptString;

+  end;

+

+  CB_SelectData(Dialog,flag,result);

+//    SendDlgItemMessage(Dialog,flag,CB_SETCURSEL,result,0);

+  SendMessage(Dialog,WM_COMMAND,(CBN_SELCHANGE shl 16) or flag,GetDlgItem(Dialog,flag));

+end;

+

+procedure ReloadService(Dialog:HWND;setvalue:boolean);

+var

+  pc:pAnsiChar;

+  buf,buf1:array [0..127] of AnsiChar;

+  wnd:hwnd;

+  i:integer;

+  struct:pAnsiChar;

+//    bufw:array [0..MaxDescrLen] of WideChar;

+begin

+  wnd:=GetDlgItem(Dialog,IDC_EDIT_SERVICE);

+  SendMessageA(wnd,CB_GETLBTEXT,SendMessage(wnd,CB_GETCURSEL,0,0),tlparam(@buf));

+  ApiCard.Service:=@buf;

+

+  pc:=ApiCard.FillParams(GetDlgItem(Dialog,IDC_EDIT_WPAR),true);

+  if pc<>nil then

+  begin

+    if GetDlgItemTextA(Dialog,IDC_EDIT_WPAR,buf1,SizeOf(buf1))>0 then

+      case FixParam(Dialog,@buf1,IDC_FLAG_WPAR) of

+        ptStruct: begin

+          if setvalue then

+          begin

+            struct:=pAnsiChar(SetWindowLongPtrW(GetDlgItem(Dialog,IDC_WSTRUCT),GWLP_USERDATA,

+            long_ptr(StrDup(struct,StrScan(pc,'|')+1))));

+            mFreeMem(struct);

+          end;

+

+{          struct:=pAnsiChar(GetWindowLongPtrW(GetDlgItem(Dialog,IDC_WSTRUCT),GWLP_USERDATA));

+          mFreeMem(struct);

+          StrDup(struct,StrScan(pc,'|')+1);

+          SetWindowLongPtrW(GetDlgItem(Dialog,IDC_WSTRUCT),GWLP_USERDATA,long_ptr(struct));

+//            AnsiToWide(StrScan(pc,'|')+1,wstruct,MirandaCP);

+}

+        end;

+      end;

+    mFreeMem(pc);

+  end;

+

+  pc:=ApiCard.FillParams(GetDlgItem(Dialog,IDC_EDIT_LPAR),false);

+  if pc<>nil then

+  begin

+    if GetDlgItemTextA(Dialog,IDC_EDIT_LPAR,buf1,SizeOf(buf1))>0 then

+      case FixParam(Dialog,@buf1,IDC_FLAG_LPAR) of

+        ptStruct: begin

+          if setvalue then

+          begin

+            struct:=pAnsiChar(SetWindowLongPtrW(GetDlgItem(Dialog,IDC_LSTRUCT),GWLP_USERDATA,

+            long_ptr(StrDup(struct,StrScan(pc,'|')+1))));

+            mFreeMem(struct);

+          end;

+{

+          struct:=pAnsiChar(GetWindowLongPtrW(GetDlgItem(Dialog,IDC_LSTRUCT),GWLP_USERDATA));

+          mFreeMem(struct);

+          StrDup(struct,StrScan(pc,'|')+1);

+          SetWindowLongPtrW(GetDlgItem(Dialog,IDC_LSTRUCT),GWLP_USERDATA,long_ptr(struct));

+//            AnsiToWide(StrScan(pc,'|')+1,lstruct,MirandaCP);

+}

+        end;

+      end;

+    mFreeMem(pc);

+  end;

+

+  pc:=ApiCard.ResultType;

+  i:=sresInt;

+  if pc<>nil then

+  begin

+    if      lstrcmpia(pc,'struct')=0 then i:=sresStruct

+    else if lstrcmpia(pc,'str')=0 then

+    begin

+      i:=sresString;

+      CheckDlgButton(Dialog,IDC_RES_UNICODE,BST_UNCHECKED);

+    end

+    else if lstrcmpia(pc,'wide')=0 then

+    begin

+      i:=sresString;

+      CheckDlgButton(Dialog,IDC_RES_UNICODE,BST_CHECKED);

+    end;

+    mFreeMem(pc);

+  end;

+  CB_SelectData(Dialog,IDC_SRV_RESULT,i);

+//    ApiCard.Show;

+end;

+

+// true - need to show structure

+function SetParam(Dialog:HWND; aflags:dword; id:integer; aparam:pWideChar):integer;

+var

+  wnd:HWND;

+begin

+  wnd:=GetDlgItem(Dialog,id);

+  if (aflags and ACF_PARAM)<>0 then

+  begin

+    EnableWindow(wnd,false);

+    result:=ptParam;

+  end

+  else if (aflags and ACF_RESULT)<>0 then

+  begin

+    EnableWindow(wnd,false);

+    result:=ptResult;

+  end

+  else if (aflags and ACF_CURRENT)<>0 then

+  begin

+    EnableWindow(wnd,false);

+    result:=ptCurrent;

+  end

+  else if (aflags and ACF_PARNUM)<>0 then

+  begin

+    result:=ptNumber;

+    SetDlgItemTextW(Dialog,id,aparam);

+  end

+  else if (aflags and ACF_STRUCT)<>0 then

+  begin

+    result:=ptStruct;

+  end

+  else if (aflags and ACF_UNICODE)<>0 then

+  begin

+    result:=ptUnicode;

+    SetDlgItemTextW(Dialog,id,aparam);

+  end

+  else

+  begin

+    result:=ptString;

+    SetDlgItemTextW(Dialog,id,aparam);

+  end;

+  SetEditFlags(wnd,EF_SCRIPT,ord((aflags and ACF_SCRIPT_PARAM)<>0));

+end;

+

+procedure ClearFields(Dialog:HWND);

+var

+  wnd:HWND;

+begin

+  ShowWindow(GetDlgItem(Dialog,IDC_WSTRUCT),SW_HIDE);

+  wnd:=GetDlgItem(Dialog,IDC_EDIT_WPAR);

+  ShowEditField  (wnd,SW_SHOW);

+  EnableEditField(wnd,true);

+  SendMessage    (wnd,CB_RESETCONTENT,0,0);

+//??  SetDlgItemTextW(Dialog,IDC_EDIT_WPAR,nil);

+  CB_SelectData(GetDlgItem(Dialog,IDC_FLAG_WPAR),ptNumber);

+  SetEditFlags(wnd,EF_ALL,0);

+

+  ShowWindow  (GetDlgItem(Dialog,IDC_LSTRUCT),SW_HIDE);

+  wnd:=GetDlgItem(Dialog,IDC_EDIT_LPAR);

+  ShowEditField  (wnd,SW_SHOW);

+  EnableEditField(wnd,true);

+  SendMessage    (wnd,CB_RESETCONTENT,0,0);

+//??  SetDlgItemTextW(Dialog,IDC_EDIT_LPAR,nil);

+  CB_SelectData(GetDlgItem(Dialog,IDC_FLAG_LPAR),ptNumber);

+  SetEditFlags(wnd,EF_ALL,0);

+

+  ShowWindow(GetDlgItem(Dialog,IDC_RES_FREEMEM),SW_HIDE);

+  ShowWindow(GetDlgItem(Dialog,IDC_RES_UNICODE),SW_HIDE);

+  CheckDlgButton(Dialog,IDC_RES_FREEMEM,BST_UNCHECKED);

+  CheckDlgButton(Dialog,IDC_RES_UNICODE,BST_UNCHECKED);

+

+  CB_SelectData(Dialog,IDC_SRV_RESULT,sresInt);

+end;

+

+function DlgProc(Dialog:HWnd;hMessage:UINT;wParam:WPARAM;lParam:LPARAM):lresult; stdcall;

+const

+  NoProcess:boolean=true;

+var

+  i:integer;

+  pc,pc1:pAnsiChar;

+  wnd,wnd1:HWND;

+  pcw:PWideChar;

+begin

+  result:=0;

+

+  case hMessage of

+    WM_DESTROY: begin

+      ApiCard.Free;

+      pc:=pAnsiChar(GetWindowLongPtrW(GetDlgItem(Dialog,IDC_WSTRUCT),GWLP_USERDATA));

+      mFreeMem(pc);

+      pc:=pAnsiChar(GetWindowLongPtrW(GetDlgItem(Dialog,IDC_LSTRUCT),GWLP_USERDATA));

+      mFreeMem(pc);

+    end;

+    

+    WM_INITDIALOG: begin

+      MakeResultTypeList(GetDlgItem(Dialog,IDC_SRV_RESULT));

+      MakeParamTypeList(GetDlgItem(Dialog,IDC_FLAG_WPAR));

+      MakeParamTypeList(GetDlgItem(Dialog,IDC_FLAG_LPAR));

+

+      TranslateDialogDefault(Dialog);

+

+//??

+      MakeEditField(Dialog,IDC_EDIT_SERVICE);

+      MakeEditField(Dialog,IDC_EDIT_WPAR);

+      MakeEditField(Dialog,IDC_EDIT_LPAR);

+

+      ApiCard:=CreateServiceCard(Dialog);

+      ApiCard.FillList(GetDlgItem(Dialog,IDC_EDIT_SERVICE),

+        DBReadByte(0,DBBranch,'SrvListMode'));

+    end;

+

+    WM_ACT_SETVALUE: begin

+      NoProcess:=true;

+      ClearFields(Dialog);

+

+      with tServiceAction(lParam) do

+      begin

+        if CB_SelectData(Dialog,IDC_EDIT_SERVICE,Hash(service,StrLen(service)))<>CB_ERR then

+//        if SendDlgItemMessageA(Dialog,IDC_EDIT_SERVICE,CB_SELECTSTRING,twparam(-1),tlparam(service))<>CB_ERR then

+          ReloadService(Dialog,false)

+        else

+          SetDlgItemTextA(Dialog,IDC_EDIT_SERVICE,service);

+//!!

+        SetEditFlags(GetDlgItem(Dialog,IDC_EDIT_SERVICE),EF_SCRIPT,

+              ord((flags and ACF_SCRIPT_SERVICE)<>0));

+

+        // RESULT

+        if (flags and ACF_RSTRUCT)<>0 then

+          i:=sresStruct

+        else if (flags and ACF_RSTRING)<>0 then

+        begin

+          i:=sresString;

+          if (flags and ACF_RUNICODE)<>0 then CheckDlgButton(Dialog,IDC_RES_UNICODE,BST_CHECKED);

+          if (flags and ACF_RFREEMEM)<>0 then CheckDlgButton(Dialog,IDC_RES_FREEMEM,BST_CHECKED);

+        end

+        else

+        begin

+          i:=sresInt;

+        end;

+        CB_SelectData(Dialog,IDC_SRV_RESULT,i);

+

+        // WPARAM

+        i:=SetParam(Dialog,flags,IDC_EDIT_WPAR,pWideChar(wparam));

+        if i=ptStruct then

+        begin

+          ShowEditField(GetDlgItem(Dialog,IDC_EDIT_WPAR),SW_HIDE);

+          ShowWindow   (GetDlgItem(Dialog,IDC_WSTRUCT  ),SW_SHOW);

+

+{

+          p:=pAnsiChar(GetWindowLongPtrW(GetDlgItem(Dialog,IDC_WSTRUCT),GWLP_USERDATA));

+          mFreeMem(p);

+}

+          SetWindowLongPtrW(GetDlgItem(Dialog,IDC_WSTRUCT),GWLP_USERDATA,

+            long_ptr(StrDup(pc,pAnsiChar(wparam))));

+        end;

+        CB_SelectData(GetDlgItem(Dialog,IDC_FLAG_WPAR),i);

+

+        // LPARAM

+        i:=SetParam(Dialog,flags2,IDC_EDIT_LPAR,pWideChar(lparam));

+        if i=ptStruct then

+        begin

+          ShowEditField(GetDlgItem(Dialog,IDC_EDIT_LPAR),SW_HIDE);

+          ShowWindow   (GetDlgItem(Dialog,IDC_LSTRUCT  ),SW_SHOW);

+

+{

+          p:=pAnsiChar(GetWindowLongPtrW(GetDlgItem(Dialog,IDC_LSTRUCT),GWLP_USERDATA));

+          mFreeMem(p);

+}

+          SetWindowLongPtrW(GetDlgItem(Dialog,IDC_LSTRUCT),GWLP_USERDATA,

+            long_ptr(StrDup(pc,pAnsiChar(lparam))));

+        end;

+        CB_SelectData(GetDlgItem(Dialog,IDC_FLAG_LPAR),i);

+

+      end;

+      NoProcess:=false;

+    end;

+

+    WM_ACT_RESET: begin

+      NoProcess:=true;

+      ClearFields(Dialog);

+      SetDlgItemTextW(Dialog,IDC_EDIT_SERVICE,nil);

+      SetDlgItemTextW(Dialog,IDC_EDIT_WPAR,'0');

+      SetDlgItemTextW(Dialog,IDC_EDIT_LPAR,'0');

+{

+      ShowWindow(GetDlgItem(Dialog,IDC_WSTRUCT),SW_HIDE);

+      ShowWindow(GetDlgItem(Dialog,IDC_LSTRUCT),SW_HIDE);

+}

+      NoProcess:=false;

+    end;

+

+    WM_ACT_SAVE: begin

+      with tServiceAction(lParam) do

+      begin

+        //WPARAM

+        wnd:=GetDlgItem(Dialog,IDC_EDIT_WPAR);

+        case CB_GetData(GetDlgItem(Dialog,IDC_FLAG_WPAR)) of

+          ptParam: begin

+            flags:=flags or ACF_PARAM

+          end;

+          ptResult: begin

+            flags:=flags or ACF_RESULT

+          end;

+          ptCurrent: begin

+            flags:=flags or ACF_CURRENT

+          end;

+          ptNumber: begin

+            flags:=flags or ACF_PARNUM;

+            wparam:=GetDlgText(wnd);

+          end;

+          ptStruct: begin

+            flags:=flags or ACF_STRUCT;

+            StrDup(pAnsiChar(wparam),

+                pAnsiChar(GetWindowLongPtrW(GetDlgItem(Dialog,IDC_WSTRUCT),GWLP_USERDATA)));

+          end;

+          ptUnicode: begin

+            flags:=flags or ACF_UNICODE;

+            wparam:=GetDlgText(wnd);

+          end;

+          ptString: wparam:=GetDlgText(wnd);

+        end;

+        if (GetEditFlags(wnd) and EF_SCRIPT)<>0 then

+           flags:=flags or ACF_SCRIPT_PARAM;

+

+        // LPARAM

+        wnd:=GetDlgItem(Dialog,IDC_EDIT_LPAR);

+        case CB_GetData(GetDlgItem(Dialog,IDC_FLAG_LPAR)) of

+          ptParam: begin

+            flags2:=flags2 or ACF_PARAM

+          end;

+          ptResult: begin

+            flags2:=flags2 or ACF_RESULT

+          end;

+          ptCurrent: begin

+            flags2:=flags2 or ACF_CURRENT

+          end;

+          ptNumber: begin

+            flags2:=flags2 or ACF_PARNUM;

+            lparam:=GetDlgText(wnd);

+          end;

+          ptStruct: begin

+            flags2:=flags2 or ACF_STRUCT;

+            StrDup(pAnsiChar(lparam),

+                pAnsiChar(GetWindowLongPtrW(GetDlgItem(Dialog,IDC_LSTRUCT),GWLP_USERDATA)));

+          end;

+          ptUnicode: begin

+            flags2:=flags2 or ACF_UNICODE;

+            lparam:=GetDlgText(wnd);

+          end;

+          ptString: lparam:=GetDlgText(wnd);

+        end;

+        if (GetEditFlags(wnd) and EF_SCRIPT)<>0 then

+           flags2:=flags2 or ACF_SCRIPT_PARAM;

+

+        // RESULT

+        case CB_GetData(GetDlgItem(Dialog,IDC_SRV_RESULT)) of

+          sresString: begin

+            flags:=flags or ACF_RSTRING;

+            if IsDlgButtonChecked(Dialog,IDC_RES_UNICODE)=BST_CHECKED then

+              flags:=flags or ACF_RUNICODE;

+            if IsDlgButtonChecked(Dialog,IDC_RES_FREEMEM)=BST_CHECKED then

+              flags:=flags or ACF_RFREEMEM;

+          end;

+          sresStruct: flags:=flags or ACF_RSTRUCT;

+        end;

+

+        service:=ApiCard.NameFromList(GetDlgItem(Dialog,IDC_EDIT_SERVICE));

+//!!

+        if (GetEditFlags(Dialog,IDC_EDIT_SERVICE) and EF_SCRIPT)<>0 then

+           flags:=flags or ACF_SCRIPT_SERVICE;

+      end;

+    end;

+

+    WM_SHOWWINDOW: begin

+      // hide window by ShowWindow function

+      if (lParam=0) and (wParam=0) then

+      begin

+        pc:=pAnsiChar(SetWindowLongPtrW(GetDlgItem(Dialog,IDC_WSTRUCT),GWLP_USERDATA,0));

+        mFreeMem(pc);

+        pc:=pAnsiChar(SetWindowLongPtrW(GetDlgItem(Dialog,IDC_LSTRUCT),GWLP_USERDATA,0));

+        mFreeMem(pc);

+      end;

+    end;

+

+    WM_COMMAND: begin

+      case wParam shr 16 of

+{        CBN_EDITUPDATE,

+}

+        CBN_EDITCHANGE,

+        EN_CHANGE: if not NoProcess then

+            SendMessage(GetParent(GetParent(Dialog)),PSM_CHANGED,0,0);

+

+        CBN_SELCHANGE:  begin

+          case loword(wParam) of

+            IDC_SRV_RESULT: begin

+              i:=CB_GetData(lParam);

+              case i of

+                sresInt,sresStruct: begin

+                  ShowWindow(GetDlgItem(Dialog,IDC_RES_FREEMEM),SW_HIDE);

+                  ShowWindow(GetDlgItem(Dialog,IDC_RES_UNICODE),SW_HIDE);

+                end;

+                sresString: begin

+                  ShowWindow(GetDlgItem(Dialog,IDC_RES_FREEMEM),SW_SHOW);

+                  ShowWindow(GetDlgItem(Dialog,IDC_RES_UNICODE),SW_SHOW);

+                end;

+              end;

+            end;

+

+            IDC_FLAG_WPAR,IDC_FLAG_LPAR: begin

+              if loword(wParam)=IDC_FLAG_WPAR then

+              begin

+                wnd :=GetDlgItem(Dialog,IDC_EDIT_WPAR);

+                wnd1:=GetDlgItem(Dialog,IDC_WSTRUCT);

+              end

+              else

+              begin

+                wnd :=GetDlgItem(Dialog,IDC_EDIT_LPAR);

+                wnd1:=GetDlgItem(Dialog,IDC_LSTRUCT);

+              end;

+              i:=CB_GetData(GetDlgItem(Dialog,loword(wParam)));

+

+              if i=ptStruct then

+              begin

+                ShowEditField(wnd,SW_HIDE);

+                ShowWindow(wnd1,SW_SHOW);

+              end

+              else

+              begin

+                ShowEditField(wnd,SW_SHOW);

+                ShowWindow(wnd1,SW_HIDE);

+                if i in [ptCurrent,ptResult,ptParam] then

+                  EnableEditField(wnd,false)

+                else

+                begin

+                  if i=ptNumber then

+                  begin

+                    pcw:='0';

+                    SendMessageW(wnd,WM_SETTEXT,0,TLParam(pcw));

+                  end;

+                  EnableEditField(wnd,true);

+                end;

+              end;

+            end;

+

+            IDC_EDIT_SERVICE: ReloadService(Dialog,true);

+          end;

+          if not NoProcess then

+            SendMessage(GetParent(GetParent(Dialog)),PSM_CHANGED,0,0);

+        end;

+

+        BN_CLICKED: begin

+          case loword(wParam) of

+            IDC_WSTRUCT, IDC_LSTRUCT: begin

+              pc:=pAnsiChar(GetWindowLongPtrW(lParam,GWLP_USERDATA));

+//!!!!

+              pc1:=EditStructure(pAnsiChar(pc),Dialog);

+              if pc1<>nil then

+              begin

+                mFreeMem(pc);

+                SetWindowLongPtrW(lParam,GWLP_USERDATA,long_ptr(pc1));

+                SendMessage(GetParent(GetParent(Dialog)),PSM_CHANGED,0,0);

+              end;

+            end;

+          else

+            SendMessage(GetParent(GetParent(Dialog)),PSM_CHANGED,0,0);

+          end;

+        end;

+

+      end;

+    end;

+

+    WM_HELP: begin

+      pc:=ApiCard.NameFromList(GetDlgItem(Dialog,IDC_EDIT_SERVICE));

+      ApiCard.Service:=pc;

+      mFreeMem(pc);

+      ApiCard.Show;

+

+      result:=1;

+    end;

+

+  end;

+end;

+

+//----- Export/interface functions -----

+

+var

+  vc:tActModule;

+

+function CreateAction:tBaseAction;

+begin

+  result:=tServiceAction.Create(vc.Hash);

+end;

+

+function CreateDialog(parent:HWND):HWND;

+begin

+  result:=CreateDialogW(hInstance,'IDD_ACTSERVICE',parent,@DlgProc);

+end;

+

+procedure Init;

+begin

+  vc.Next    :=ModuleLink;

+

+  vc.Name    :='Service';

+  vc.Dialog  :=@CreateDialog;

+  vc.Create  :=@CreateAction;

+  vc.Icon    :='IDI_SERVICE';

+  vc.Hash    :=0;

+

+  ModuleLink :=@vc;

+end;

+

+begin

+  Init;

+end.