Delphi: Service and parameters API reworked

QS: adapted for new service API
Actman: updated for new service API

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

1 files changed, 146 insertions, 293 deletions

diff --git a/plugins/Actman/iac_service.pas b/plugins/Actman/iac_service.pas
index 205bc67a6f..f9b2b6ba15 100644
--- a/plugins/Actman/iac_service.pas
+++ b/plugins/Actman/iac_service.pas
@@ -10,35 +10,15 @@ uses
   m_api,

   sedit,strans,mApiCardM,

   mirutils,mircontacts,dbsettings, editwrapper,

-  sparam,srvblock,

+  awkservices,

   syswin,wrapper,common;

 

 {$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 set in "sparam" unit

-  ACF_SCRIPT_SERVICE set in "srvblock" unit

-}

-  // dummy

-  ACF_STRING = 0;

-

-const // V2

+// V3

+  ACF_SCRIPT_SERVICE = $00800000;

+// V2

   ACF2_SRV_WPAR = $00000001;

   ACF2_SRV_LPAR = $00000002;

   ACF2_SRV_SRVC = $00000004;

@@ -89,10 +69,7 @@ const
 type

   tServiceAction = class(tBaseAction)

   private

-    service:PAnsiChar;

-    wparam :pWideChar;

-    lparam :pWideChar;

-    flags2 :dword;

+    service:tServiceValue;

   public

     constructor Create(uid:dword);

     destructor Destroy; override;

@@ -111,17 +88,9 @@ 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);

+  ClearServiceValue(service);

 

   inherited Destroy;

 end;

@@ -134,192 +103,67 @@ begin
   tServiceAction(result).flags2 :=flags2;

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

 

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

+  if (flags and (ACF_NUMBER 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

+  else if ((flags and ACF_NUMBER)<>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

+  if (flags2 and (ACF_NUMBER 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

+  else if ((flags2 and ACF_NUMBER)<>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;

+  subst:tSubstData;

 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));

+  subst.Parameter :=WorkData.Parameter;

+  subst.LastResult:=WorkData.LastResult;

+  case WorkData.ResultType of

+    rtInt : subst.ResultType:=ACF_TYPE_NUMBER;

+    rtWide: subst.ResultType:=ACF_TYPE_UNICODE;

+{!!

+    rtAnsi:

+    rtUTF8:

+}

+  end;

 

-  if ServiceExists(buf)<>0 then

+  if ExecuteService(service,subst) 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 or ACF_UNICODE))<>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;

+  // result type processing

+    case subst.ResultType of

+      ACF_TYPE_UNICODE: begin

+        WorkData.ResultType:=rtWide;

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

+      end;

 

-      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);

+      ACF_TYPE_NUMBER: begin

+        WorkData.ResultType:=rtInt;

+        WorkData.LastResult:=subst.LastResult;

+      end;

     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));

+    ClearSubstData(subst);

   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);

+  case flags and ACF_TYPE_MASK of

+    ACF_TYPE_NUMBER,

+    ACF_TYPE_STRING,

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

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

   end;

 end;

 

@@ -327,27 +171,27 @@ function ReadParam(act:HXML; var param:pWideChar;isvar:boolean):dword;
 var

   tmp:pWideChar;

 begin

-  result:=0;

+  result:=ACF_TYPE_NUMBER;

   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

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

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

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

     else if lstrcmpiw(tmp,ioStruct )=0 then

     begin

-      result:=result or ACF_STRUCT;

+      result:=ACF_TYPE_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;

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

+      else if lstrcmpiw(tmp,ioUnicode)=0 then result:=ACF_TYPE_UNICODE

+      else if lstrcmpiw(tmp,ioAnsi   )=0 then result:=ACF_TYPE_STRING;

     end;

   end;

 end;

@@ -372,7 +216,7 @@ begin
   begin

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

 

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

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

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

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

   end;

@@ -393,18 +237,31 @@ begin
     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));

+      StrCopy(pc,opt_flags2 ); service.l_flags:=DBReadDword(0,DBBranch,section,dword(-1));

+      StrCopy(pc,opt_service);

+      if service.l_flags=dword(-1) then

+      begin

+        LoadServiceValue(service,DBBranch,section);

+      end

+      else

+      begin

+        service.service:=DBReadString(0,DBBranch,section,nil);

+        service.flags  :=ConvertResultFlags(flags);

+        service.w_flags:=ConvertParamFlags (flags);

+        service.l_flags:=ConvertParamFlags (service.l_flags);

+        if (flags and ACF_SCRIPT_SERVICE)<>0 then

+          service.flags:=service.flags or ACF_FLAG_SCRIPT;

+

+        StrCopy(pc,opt_wparam); LoadParam(section,service.w_flags,pointer(service.wparam));

+        StrCopy(pc,opt_lparam); LoadParam(section,service.l_flags,pointer(service.lparam));

+      end;

     end;

 

     100: 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_service); service.service:=DBReadString(0,DBBranch,section,nil);

+      StrCopy(pc,opt_flags2 ); service.l_flags:=DBReadDword (0,DBBranch,section);

 

 

       if (flags and (ACF_OLD_WCURRENT or ACF_OLD_WRESULT or ACF_OLD_WPARAM))=0 then

@@ -412,11 +269,11 @@ begin
         StrCopy(pc,opt_wparam);

 

         if (flags and ACF_OLD_WSTRUCT)<>0 then

-          wparam:=PWideChar(DBReadUTF8(0,DBBranch,section,nil))

-        else if ((flags and ACF_OLD_WPARNUM)=0) or ((flags2 and ACF2_SRV_WPAR)<>0) then

-          wparam:=DBReadUnicode(0,DBBranch,section,nil)

+          service.wparam:=PWideChar(DBReadUTF8(0,DBBranch,section,nil))

+        else if ((flags and ACF_OLD_WPARNUM)=0) or ((service.l_flags and ACF2_SRV_WPAR)<>0) then

+          service.wparam:=DBReadUnicode(0,DBBranch,section,nil)

         else

-          StrDupW(wparam,IntToStr(buf,DBReadDWord(0,DBBranch,section)));

+          StrDupW(PWideChar(service.wparam),IntToStr(buf,DBReadDWord(0,DBBranch,section)));

       end;

 

       if (flags and (ACF_OLD_LCURRENT or ACF_OLD_LRESULT or ACF_OLD_LPARAM))=0 then

@@ -424,69 +281,82 @@ begin
         StrCopy(pc,opt_lparam);

 

         if (flags and ACF_OLD_LSTRUCT)<>0 then

-          lparam:=PWideChar(DBReadUTF8(0,DBBranch,section,nil))

-        else if ((flags and ACF_OLD_LPARNUM)=0) or ((flags2 and ACF2_SRV_LPAR)<>0) then

-          lparam:=DBReadUnicode(0,DBBranch,section,nil)

+          service.lparam:=PWideChar(DBReadUTF8(0,DBBranch,section,nil))

+        else if ((flags and ACF_OLD_LPARNUM)=0) or ((service.l_flags and ACF2_SRV_LPAR)<>0) then

+          service.lparam:=DBReadUnicode(0,DBBranch,section,nil)

         else

-          StrDupW(lparam,IntToStr(buf,DBReadDWord(0,DBBranch,section)));

+          StrDupW(PWideChar(service.lparam),IntToStr(buf,DBReadDWord(0,DBBranch,section)));

       end;

 

       lflags :=flags;

-      lflags2:=flags2;

+      lflags2:=service.l_flags;

       flags :=flags and not ACF_MASK;

-      flags2:=0;

-

-      if (lflags2 and ACF2_SRV_SRVC)<>0 then flags:=flags or ACF_SCRIPT_SERVICE;

-      

-      if (lflags  and ACF_OLD_WPARNUM )<>0 then flags:=flags or ACF_PARNUM;

-      if (lflags  and ACF_OLD_WUNICODE)<>0 then flags:=flags or ACF_UNICODE;

-      if (lflags  and ACF_OLD_WCURRENT)<>0 then flags:=flags or ACF_CURRENT;

-      if (lflags  and ACF_OLD_WRESULT )<>0 then flags:=flags or ACF_RESULT;

-      if (lflags  and ACF_OLD_WPARAM  )<>0 then flags:=flags or ACF_PARAM;

-      if (lflags  and ACF_OLD_WSTRUCT )<>0 then flags:=flags or ACF_STRUCT;

-      if (lflags2 and ACF2_SRV_WPAR   )<>0 then flags:=flags or ACF_SCRIPT_PARAM;

-

-      if (lflags  and ACF_OLD_LPARNUM )<>0 then flags2:=flags2 or ACF_PARNUM;

-      if (lflags  and ACF_OLD_LUNICODE)<>0 then flags2:=flags2 or ACF_UNICODE;

-      if (lflags  and ACF_OLD_LCURRENT)<>0 then flags2:=flags2 or ACF_CURRENT;

-      if (lflags  and ACF_OLD_LRESULT )<>0 then flags2:=flags2 or ACF_RESULT;

-      if (lflags  and ACF_OLD_LPARAM  )<>0 then flags2:=flags2 or ACF_PARAM;

-      if (lflags  and ACF_OLD_LSTRUCT )<>0 then flags2:=flags2 or ACF_STRUCT;

-      if (lflags2 and ACF2_SRV_LPAR   )<>0 then flags2:=flags2 or ACF_SCRIPT_PARAM;

-

-      if (lflags  and ACF_OLD_STRING )<>0 then flags:=flags or ACF_RSTRING;

-      if (lflags  and ACF_OLD_UNICODE)<>0 then flags:=flags or ACF_RUNICODE;

-      if (lflags  and ACF_OLD_STRUCT )<>0 then flags:=flags or ACF_RSTRUCT;

-      if (lflags2 and ACF2_FREEMEM   )<>0 then flags:=flags or ACF_RFREEMEM;

 

+      service.flags  :=0;

+      service.w_flags:=0;

+      service.l_flags:=0;

+

+      if      (lflags  and ACF_OLD_WPARNUM )<>0 then service.w_flags:=ACF_TYPE_NUMBER

+      else if (lflags  and ACF_OLD_WUNICODE)<>0 then service.w_flags:=ACF_TYPE_UNICODE

+      else if (lflags  and ACF_OLD_WCURRENT)<>0 then service.w_flags:=ACF_TYPE_CURRENT

+      else if (lflags  and ACF_OLD_WRESULT )<>0 then service.w_flags:=ACF_TYPE_RESULT

+      else if (lflags  and ACF_OLD_WPARAM  )<>0 then service.w_flags:=ACF_TYPE_PARAM

+      else if (lflags  and ACF_OLD_WSTRUCT )<>0 then service.w_flags:=ACF_TYPE_STRUCT

+      else                                           service.w_flags:=ACF_TYPE_STRING;

+      if (lflags2 and ACF2_SRV_WPAR)<>0 then

+        service.w_flags:=service.w_flags or ACF_FLAG_SCRIPT;

+

+      if      (lflags  and ACF_OLD_LPARNUM )<>0 then service.l_flags:=ACF_TYPE_NUMBER

+      else if (lflags  and ACF_OLD_LUNICODE)<>0 then service.l_flags:=ACF_TYPE_UNICODE

+      else if (lflags  and ACF_OLD_LCURRENT)<>0 then service.l_flags:=ACF_TYPE_CURRENT

+      else if (lflags  and ACF_OLD_LRESULT )<>0 then service.l_flags:=ACF_TYPE_RESULT

+      else if (lflags  and ACF_OLD_LPARAM  )<>0 then service.l_flags:=ACF_TYPE_PARAM

+      else if (lflags  and ACF_OLD_LSTRUCT )<>0 then service.l_flags:=ACF_TYPE_STRUCT

+      else                                           service.l_flags:=ACF_TYPE_STRING;

+      if (lflags2 and ACF2_SRV_LPAR)<>0 then

+        service.l_flags:=service.l_flags or ACF_FLAG_SCRIPT;

+

+      if      (lflags  and ACF_OLD_STRING )<>0 then service.flags:=ACF_TYPE_STRING

+      else if (lflags  and ACF_OLD_UNICODE)<>0 then service.flags:=ACF_TYPE_UNICODE

+      else if (lflags  and ACF_OLD_STRUCT )<>0 then service.flags:=ACF_TYPE_STRUCT

+      else                                          service.flags:=ACF_TYPE_NUMBER;

+      if (lflags2 and ACF2_FREEMEM )<>0 then service.flags:=service.flags or ACF_FLAG_FREEMEM;

+      if (lflags2 and ACF2_SRV_SRVC)<>0 then service.flags:=service.flags or ACF_FLAG_SCRIPT;

     end;

 

     1: begin

+      service.flags  :=0;

+      service.w_flags:=0;

+      service.l_flags:=0;

+

       with xmlparser do

       begin

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

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

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

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

-          flags:=flags or ACF_SCRIPT_SERVICE;

+          service.flags:=service.flags or ACF_FLAG_SCRIPT;

 

         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);

+          service.w_flags:=service.w_flags or ACF_FLAG_SCRIPT;

+        service.w_flags:=service.w_flags or

+            ReadParam(sub,PWideChar(service.wparam),(service.w_flags and ACF_FLAG_SCRIPT)<>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);

+          service.l_flags:=service.l_flags or ACF_FLAG_SCRIPT;

+        service.l_flags:=service.l_flags or

+            ReadParam(sub,PWideChar(service.lparam),(service.l_flags and ACF_FLAG_SCRIPT)<>0);

 

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

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

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

+          service.flags:=service.flags or ACF_FLAG_FREEMEM;

 

         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 ;

+        if      lstrcmpiw(tmp,ioUnicode)=0 then service.flags:=service.flags or ACF_TYPE_UNICODE

+        else if lstrcmpiw(tmp,ioAnsi   )=0 then service.flags:=service.flags or ACF_TYPE_STRING

+        else if lstrcmpiw(tmp,ioStruct )=0 then service.flags:=service.flags or ACF_TYPE_STRUCT

+        else if lstrcmpiw(tmp,ioInt    )=0 then service.flags:=service.flags or ACF_TYPE_NUMBER;

       end;

     end;

 {

@@ -516,20 +386,6 @@ begin
   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;

@@ -541,11 +397,8 @@ begin
     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));

+      StrCopy(pc,opt_service);

+      SaveServiceValue(service,DBBranch,section);

     end;

 {

     1: begin

@@ -557,12 +410,18 @@ begin
 end;

 

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

+{

+function EnableThemeDialogTexture(hwnd: HWND; dwFlags: DWORD): HRESULT; stdcall;

+external 'uxtheme.dll' name 'EnableThemeDialogTexture';

 

+function IsThemeDialogTextureEnabled(hwnd: HWND): BOOL; stdcall;

+external 'uxtheme.dll' name 'IsThemeDialogTextureEnabled';

+}

 function DlgProc(Dialog:HWND;hMessage:uint;wParam:WPARAM;lParam:LPARAM):LRESULT; stdcall;

 var

   ServiceBlock:HWND;

   rc:TRECT;

-  sv:tServiceValue;

+  b:bool;

 begin

   result:=0;

 

@@ -572,25 +431,25 @@ begin
     

     WM_INITDIALOG: begin

       GetClientRect(Dialog,rc);

-      ServiceBlock:=CreateServiceBlock(Dialog,0,0,rc.right,rc.bottom,ACF_NOVISUAL or ACF_SCRIPT_EXPAND);

+      ServiceBlock:=CreateServiceBlock(Dialog,0,0,rc.right,rc.bottom,

+          ACF_BLOCK_NOVISUAL or ACF_BLOCK_EXPAND);

       SetWindowLongPtrW(Dialog,GWLP_USERDATA,ServiceBlock);

       SetServiceListMode(ServiceBlock,DBReadByte(0,DBBranch,'SrvListMode'));

-

+{

+      b:=IsThemeDialogTextureEnabled(Dialog);

+      if b then

+      begin

+        b:=IsThemeDialogTextureEnabled(ServiceBlock);

+        if not b then

+          EnableThemeDialogTexture(ServiceBlock,2);

+      end;

+}

       TranslateDialogDefault(Dialog);

     end;

 

     WM_ACT_SETVALUE: begin

       ServiceBlock:=GetWindowLongPtrW(Dialog,GWLP_USERDATA);

-      with tServiceAction(lParam) do

-      begin

-        sv.service:=service;

-        sv.w_flag :=flags;

-        sv.wparam :=wparam;

-        sv.l_flag :=flags2;

-        sv.lparam :=lparam;

-        sv.flags  :=flags;

-      end;

-      SetSrvBlockValue(ServiceBlock,sv);

+      SetSrvBlockValue(ServiceBlock,tServiceAction(lParam).service);

     end;

 

     WM_ACT_RESET: begin

@@ -601,13 +460,7 @@ begin
       with tServiceAction(lParam) do

       begin

         ServiceBlock:=GetWindowLongPtrW(Dialog,GWLP_USERDATA);

-        GetSrvBlockValue(ServiceBlock,sv);

-

-        service:=sv.service;

-        wparam :=sv.wparam;

-        lparam :=sv.lparam;

-        flags2 :=sv.l_flag;

-        flags  :=sv.flags or sv.w_flag;

+        GetSrvBlockValue(ServiceBlock,tServiceAction(lParam).service);

       end;

     end;