diff options
Diffstat (limited to 'plugins/Actman/iac_service.pas')
| -rw-r--r-- | plugins/Actman/iac_service.pas | 676 |
1 files changed, 676 insertions, 0 deletions
diff --git a/plugins/Actman/iac_service.pas b/plugins/Actman/iac_service.pas new file mode 100644 index 0000000000..205bc67a6f --- /dev/null +++ b/plugins/Actman/iac_service.pas @@ -0,0 +1,676 @@ +unit iac_service;
+
+interface
+
+implementation
+
+uses
+ windows, messages, commctrl,
+ global, iac_global,
+ m_api,
+ sedit,strans,mApiCardM,
+ mirutils,mircontacts,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 set in "sparam" unit
+ ACF_SCRIPT_SERVICE set in "srvblock" unit
+}
+ // dummy
+ ACF_STRING = 0;
+
+const // V2
+ ACF2_SRV_WPAR = $00000001;
+ ACF2_SRV_LPAR = $00000002;
+ ACF2_SRV_SRVC = $00000004;
+ ACF2_FREEMEM = $00000100;
+ ACF_OLD_WPARNUM = $00000001;
+ ACF_OLD_LPARNUM = $00000002;
+ ACF_OLD_WUNICODE = $00000004;
+ ACF_OLD_LUNICODE = $00000008;
+ ACF_OLD_WCURRENT = $00000010;
+ ACF_OLD_LCURRENT = $00000020;
+ ACF_OLD_WPARHEX = $00000040;
+ ACF_OLD_LPARHEX = $00000080;
+
+ ACF_OLD_WRESULT = $00010000;
+ ACF_OLD_LRESULT = $00020000;
+ ACF_OLD_WPARAM = $00040000;
+ ACF_OLD_LPARAM = $00080000;
+ ACF_OLD_WSTRUCT = $00100000;
+ ACF_OLD_LSTRUCT = $00200000;
+
+ ACF_OLD_STRING = $00000800;
+ ACF_OLD_UNICODE = $00001000;
+ ACF_OLD_STRUCT = $00008000;
+
+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;
+ buf:array [0..31] of WideChar;
+ pc:pAnsiChar;
+ sub:HXML;
+ tmp:pWideChar;
+ lflags,lflags2:dword;
+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;
+
+ 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);
+
+
+ if (flags and (ACF_OLD_WCURRENT or ACF_OLD_WRESULT or ACF_OLD_WPARAM))=0 then
+ 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)
+ else
+ StrDupW(wparam,IntToStr(buf,DBReadDWord(0,DBBranch,section)));
+ end;
+
+ if (flags and (ACF_OLD_LCURRENT or ACF_OLD_LRESULT or ACF_OLD_LPARAM))=0 then
+ 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)
+ else
+ StrDupW(lparam,IntToStr(buf,DBReadDWord(0,DBBranch,section)));
+ end;
+
+ lflags :=flags;
+ lflags2:=flags2;
+ 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;
+
+ 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;
+}
+ 13: 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.
|