path: root/plugins/Actman30/iac_service.pas

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.