diff options
Diffstat (limited to 'plugins/Actman30/iac_service.pas')
| -rw-r--r-- | plugins/Actman30/iac_service.pas | 1023 |
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.
|