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,
  sparam,srvblock,
  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   = $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 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;

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

function DlgProc(Dialog:HWND;hMessage:uint;wParam:WPARAM;lParam:LPARAM):LRESULT; stdcall;
var
  ServiceBlock:HWND;
  rc:TRECT;
  sv:tServiceValue;
begin
  result:=0;

  case hMessage of
    WM_DESTROY: begin
    end;
    
    WM_INITDIALOG: begin
      GetClientRect(Dialog,rc);
      ServiceBlock:=CreateServiceBlock(Dialog,0,0,rc.right,rc.bottom,ACF_NOVISUAL or ACF_SCRIPT_EXPAND);
      SetWindowLongPtrW(Dialog,GWLP_USERDATA,ServiceBlock);
      SetServiceListMode(ServiceBlock,DBReadByte(0,DBBranch,'SrvListMode'));

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

    WM_ACT_RESET: begin
      ClearServiceBlock(GetWindowLongPtrW(Dialog,GWLP_USERDATA));
    end;

    WM_ACT_SAVE: 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;
      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_EDITCHANGE,
        BN_CLICKED: 
          SendMessage(GetParent(GetParent(Dialog)),PSM_CHANGED,0,0);
      end;
    end;

    WM_HELP: begin
      ServiceBlock:=GetWindowLongPtrW(Dialog,GWLP_USERDATA);
      SendMessage(ServiceBlock,WM_HELP,0,0);

      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.