From f2cce78db24a0f0a53b8ca41ff112968a5f2d86b Mon Sep 17 00:00:00 2001 From: Vadim Dashevskiy Date: Fri, 19 Dec 2014 20:02:47 +0000 Subject: Actman 2.0 is moved to deprecated, Actman 3.0 is a new default Actman (with database settings converter from older version) git-svn-id: http://svn.miranda-ng.org/main/trunk@11533 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c --- plugins/Actman30/iac_dbrw.pas | 778 ------------------------------------------ 1 file changed, 778 deletions(-) delete mode 100644 plugins/Actman30/iac_dbrw.pas (limited to 'plugins/Actman30/iac_dbrw.pas') diff --git a/plugins/Actman30/iac_dbrw.pas b/plugins/Actman30/iac_dbrw.pas deleted file mode 100644 index 7ddbe0b61c..0000000000 --- a/plugins/Actman30/iac_dbrw.pas +++ /dev/null @@ -1,778 +0,0 @@ -unit iac_dbrw; - -interface - -implementation - -uses - windows, messages, commctrl, - global, iac_global, - m_api,dbsettings, - common,mirutils,wrapper, - editwrapper,mircontacts,dlgshare; - -{$include i_cnst_database.inc} -{$resource iac_database.res} - -const - opt_module = 'module'; - opt_setting = 'setting'; - opt_value = 'value'; -const - ioOper = 'oper'; - ioDelete = 'delete'; - ioWrite = 'write'; - ioCurrent = 'current'; - ioParam = 'param'; - ioResult = 'result'; - ioModule = 'module'; - ioSetting = 'setting'; - ioContact = 'contact'; - ioFileVariable = 'modvariables'; - ioArgVariable = 'argvariables'; - ioVariables = 'variables'; - ioType = 'type'; - ioByte = 'byte'; - ioWord = 'word'; - ioDword = 'dword'; - ioAnsi = 'ansi'; - ioLast = 'last'; - ioSaveValue = 'savevalue'; - -const - ACF_DBWRITE = $00000001; // write to (not read from) DB - ACF_DBDELETE = $00000002; // delete setting - ACF_DBBYTE = $00000004; // read/write byte (def. dword) - ACF_DBWORD = $00000008; // read/write word (def. dword) - ACF_DBUTEXT = $00000010; // read/write Unicode string - ACF_DBANSI = $00000020; // read/write ANSI string - ACF_PARAM = $00000040; // hContact from parameter - ACF_CURRENT = $00000080; // hContact is 0 (user settings) - ACF_RESULT = $00000100; // hContact is last result value - ACF_LAST = $00000200; // use last result for DB writing - ACF_SAVE = $00000400; // save writing value to Last Result - // dummy - ACF_DBDWORD = 0; - ACF_DBREAD = 0; - ACF_MANUAL = 0; - - ACF_NOCONTACT = ACF_PARAM or ACF_CURRENT or ACF_RESULT; - ACF_VALUETYPE = ACF_DBBYTE or ACF_DBWORD or ACF_DBUTEXT or ACF_DBANSI; - ACF_TEXT = ACF_DBUTEXT or ACF_DBANSI; - ACF_OPERATION = ACF_DBWRITE or ACF_DBDELETE; - - ACF_RW_MODULE = $00001000; // script for module name - ACF_RW_SETTING = $00002000; // script for setting name - ACF_RW_VALUE = $00004000; // script for data value - -const // V2 - ACF_OLD_DBWRITE = $00000001; - ACF_OLD_DBBYTE = $00000002; - ACF_OLD_DBWORD = $00000004; - ACF_OLD_PARAM = $00000008; - ACF_OLD_CURRENT = $00000010; - ACF_OLD_RESULT = $00000020; - ACF_OLD_LAST = $00000040; - ACF_OLD_DBUTEXT = $00000080; - ACF_OLD_DBANSI = $00000082; - ACF_OLD_DBDELETE = $00000100; - ACF_OLD_NOCNTCT = ACF_OLD_PARAM or ACF_OLD_CURRENT or ACF_OLD_RESULT; - - ACF2_RW_MVAR = $00000001; - ACF2_RW_SVAR = $00000002; - ACF2_RW_TVAR = $00000004; - -type - tDataBaseAction = class(tBaseAction) - private - dbcontact:TMCONTACT; - dbmodule :PWideChar; - dbsetting:PWideChar; - dbvalue :PWideChar; // keep all in unicode (str to int translation fast) - 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 tDataBaseACtion.Create(uid:dword); -begin - inherited Create(uid); - - dbcontact:=0; - dbmodule :=nil; - dbsetting:=nil; - dbvalue :=nil; -end; - -destructor tDataBaseAction.Destroy; -begin - mFreeMem(dbmodule); - mFreeMem(dbsetting); - mFreeMem(dbvalue); - - inherited Destroy; -end; -{ -function tDataBaseAction.Clone:tBaseAction; -var - tmp:tDataBaseAction; -begin - result:=tDataBaseAction.Create(0); - Duplicate(result); - - tmp.dbcontact:=dbcontact; - StrDupW(tmp.dbmodule ,dbmodule); - StrDupW(tmp.dbsetting,dbsetting); - - if ((flags and ACF_DBDELETE)=0) and - ((flags and ACF_LAST)=0) then - StrDupW(tmp.dbvalue,dbvalue); - - result:=tmp; -end; -} -function tDataBaseAction.DoAction(var WorkData:tWorkData):LRESULT; -var - sbuf:array [0..31] of WideChar; - bufw:array [0..255] of WideChar; - ambuf,asbuf:array [0..127] of AnsiChar; - ls,tmp:pWideChar; - tmpa,tmpa1:pAnsiChar; - hContact:TMCONTACT; - proto:pAnsiChar; - avalue:uint_ptr; -begin - result:=0; - - if dbmodule=nil then - exit; - if (dbsetting=nil) and ((flags and ACF_DBDELETE)=0) then - exit; - // contact - case (flags and ACF_NOCONTACT) of - ACF_CURRENT: hContact:=0; - ACF_PARAM : hContact:=WorkData.Parameter; - ACF_RESULT : hContact:=WorkData.LastResult; - else - hContact:=dbcontact; - end; - - //--- - // last result for scripts - if WorkData.ResultType=rtWide then - ls:=pWideChar(WorkData.LastResult) - else - begin - ls:=@sbuf; - IntToStr(sbuf,WorkData.LastResult); - end; - - proto:=GetContactProtoAcc(hContact); - // now need to process module - if (flags and ACF_RW_MODULE)<>0 then - begin - tmp:=ParseVarString(dbmodule,hContact,ls); - StrCopyW(bufw,tmp); - mFreeMem(tmp); - end - else - StrCopyW(bufw,dbmodule); - StrReplaceW(@bufw,'',ls); - FastWideToAnsiBuf(bufw,ambuf,SizeOf(ambuf)-1); - StrReplace(ambuf,protostr,proto); - - // now process settings - if dbsetting<>nil then - begin - if (flags and ACF_RW_SETTING)<>0 then - begin - tmp:=ParseVarString(dbsetting,hContact,ls); - StrCopyW(bufw,tmp); - mFreeMem(tmp); - end - else - StrCopyW(bufw,dbsetting); - StrReplaceW(@bufw,'',ls); - FastWideToAnsiBuf(bufw,asbuf,SizeOf(asbuf)-1); - StrReplace(asbuf,protostr,proto); - end - else - asbuf[0]:=#0; - - // Delete data - if (flags and ACF_DBDELETE)<>0 then - begin - if (asbuf[0]='*') or (asbuf[StrLen(asbuf)-1]='*') then - DBDeleteGroup(hContact,ambuf,asbuf) - else if asbuf[0]=#0 then - DBDeleteModule(hContact,ambuf) - else - DBDeleteSetting(hContact,ambuf,asbuf); - end - else - begin - if (flags and ACF_LAST)<>0 then - begin - avalue:=WorkData.LastResult; - if WorkData.ResultType=rtInt then // have number - begin - if (flags and ACF_DBUTEXT)=ACF_DBUTEXT then // need wide text - avalue:=uint_ptr(IntToStr(sbuf,avalue)) - else if (flags and ACF_DBANSI)=ACF_DBANSI then // need ansi text - avalue:=uint_ptr(IntToStr(pAnsiChar(@sbuf),avalue)); - end - // got wide text - else if (flags and ACF_TEXT)=0 then // need number - avalue:=NumToInt(pWideChar(avalue)); -{ - val=LR(wide) (wide,ansi) - val=pointer to static buffer (wide, ansi) - val=number(number) -} - end - else - begin - if (flags and ACF_RW_VALUE)<>0 then - begin - avalue:=uint_ptr(ParseVarString(dbvalue,hContact,ls)); - end - else - avalue:=uint_ptr(dbvalue); - - if (flags and ACF_TEXT)=0 then // need a number - begin - tmp:=pWideChar(avalue); - avalue:=NumToInt(pWideChar(avalue)); - if (flags and ACF_RW_VALUE)<>0 then - mFreeMem(tmp); - end; -{ - val=uint_ptr if need number(number) - val=script result wide(need to free) (wide,ansi) - val=original dbvalue wide (wide,ansi) -} - end; - // Write value - if (flags and ACF_DBWRITE)<>0 then - begin - case (flags and ACF_VALUETYPE) of - ACF_DBBYTE: DBWriteByte(hContact,ambuf,asbuf,avalue); - ACF_DBWORD: DBWriteWord(hContact,ambuf,asbuf,avalue); - ACF_DBANSI: begin - WideToAnsi(pWideChar(avalue),tmpa,MirandaCP); - DBWriteString(hContact,ambuf,asbuf,tmpa); - mFreeMem(tmpa); - end; - ACF_DBUTEXT: begin - DBWriteUnicode(hContact,ambuf,asbuf,pWideChar(avalue)); - end; - else - DBWriteDWord(hContact,ambuf,asbuf,avalue); - end; - - if (flags and ACF_SAVE)<>0 then - begin - ClearResult(WorkData); - case (flags and ACF_VALUETYPE) of - ACF_DBANSI, - ACF_DBUTEXT: begin - StrDupW(pWideChar(WorkData.LastResult),pWideChar(avalue)); - WorkData.ResultType:=rtWide; - end; - else - WorkData.LastResult:=avalue; - WorkData.ResultType:=rtInt; - end; - end; - end - // Read value - else - begin - ClearResult(WorkData); - WorkData.ResultType:=rtInt; - case (flags and ACF_VALUETYPE) of - ACF_DBBYTE: WorkData.LastResult:=DBReadByte(hContact,ambuf,asbuf,avalue); - ACF_DBWORD: WorkData.LastResult:=DBReadWord(hContact,ambuf,asbuf,avalue); - ACF_DBANSI: begin - WideToAnsi(pWideChar(avalue),tmpa1,MirandaCP); - tmpa:=DBReadString(hContact,ambuf,asbuf,tmpa1); - AnsiToWide(tmpa,PWideChar(WorkData.LastResult),MirandaCP); - WorkData.ResultType:=rtWide; - mFreeMem(tmpa1); - mFreeMem(tmpa); - end; - ACF_DBUTEXT: begin - WorkData.LastResult:=uint_ptr(DBReadUnicode(hContact,ambuf,asbuf,pWideChar(avalue))); - WorkData.ResultType:=rtWide; - end - else - WorkData.LastResult:=DBReadDWord(hContact,ambuf,asbuf,avalue); - end; - end; - - if (flags and ACF_RW_VALUE)<>0 then - begin - if (flags and ACF_TEXT)<>0 then - begin - mFreeMem(avalue); - end; - end; - end; -end; - -procedure tDataBaseAction.Load(node:pointer;fmt:integer); -var - section: array [0..127] of AnsiChar; - buf:array [0..31] of WideChar; - pc:pAnsiChar; - tmp:pWideChar; - lflags,flags2:dword; -begin - inherited Load(node,fmt); - case fmt of - 0: begin - if (flags and ACF_NOCONTACT)=0 then - dbcontact:=LoadContact(DBBranch,node); - pc:=StrCopyE(section,pAnsiChar(node)); - StrCopy(pc,opt_module ); dbmodule :=DBReadUnicode(0,DBBranch,section); - StrCopy(pc,opt_setting); dbsetting:=DBReadUnicode(0,DBBranch,section); - if (flags and (ACF_DBDELETE or ACF_LAST))=0 then - begin - StrCopy(pc,opt_value); dbvalue:=DBReadUnicode(0,DBBranch,section); - end; - end; - - 100: begin - if (flags and ACF_OLD_NOCNTCT)=0 then - dbcontact:=LoadContact(DBBranch,node); - pc:=StrCopyE(section,pAnsiChar(node)); - - // auto convert ansi to unicode - StrCopy(pc,opt_module ); dbmodule :=DBReadUnicode(0,DBBranch,section); - StrCopy(pc,opt_setting); dbsetting:=DBReadUnicode(0,DBBranch,section); - - StrCopy(pc,'flags2'); flags2:=DBReadDWord(0,DBBranch,section,0); - - if (flags and (ACF_OLD_DBDELETE or ACF_OLD_LAST))=0 then - begin - StrCopy(pc,opt_value); - if ((flags and ACF_OLD_DBUTEXT)=0) and ((flags2 and ACF2_RW_TVAR)=0) then - StrDupW(dbvalue,IntToStr(buf,DBReadDWord(0,DBBranch,section))) - else - dbvalue:=DBReadUnicode(0,DBBranch,section); - end; - - lflags:=flags; - flags:=flags and not ACF_MASK; - if (lflags and ACF_OLD_DBWRITE )<>0 then flags:=flags or ACF_DBWRITE; - if (lflags and ACF_OLD_DBDELETE)<>0 then flags:=flags or ACF_DBDELETE; - if (lflags and ACF_OLD_PARAM )<>0 then flags:=flags or ACF_PARAM; - if (lflags and ACF_OLD_CURRENT )<>0 then flags:=flags or ACF_CURRENT; - if (lflags and ACF_OLD_RESULT )<>0 then flags:=flags or ACF_RESULT; - if (lflags and ACF_OLD_LAST )<>0 then flags:=flags or ACF_LAST; - if (lflags and ACF_OLD_DBBYTE )=ACF_OLD_DBBYTE then flags:=flags or ACF_DBBYTE; - if (lflags and ACF_OLD_DBWORD )=ACF_OLD_DBWORD then flags:=flags or ACF_DBWORD; - if (lflags and ACF_OLD_DBUTEXT )=ACF_OLD_DBUTEXT then flags:=flags or ACF_DBUTEXT; - if (lflags and ACF_OLD_DBANSI )=ACF_OLD_DBANSI then flags:=(flags or ACF_DBANSI) and not (ACF_DBBYTE or ACF_DBUTEXT); - if (flags2 and ACF2_RW_MVAR)<>0 then flags:=flags or ACF_RW_MODULE; - if (flags2 and ACF2_RW_SVAR)<>0 then flags:=flags or ACF_RW_SETTING; - if (flags2 and ACF2_RW_TVAR)<>0 then flags:=flags or ACF_RW_VALUE; - - end; - - 1: begin - with xmlparser do - begin - tmp:=getAttrValue(HXML(node),ioOper); - if lstrcmpiw(tmp,ioDelete)=0 then flags:=flags or ACF_DBDELETE - else if lstrcmpiw(tmp,ioWrite )=0 then flags:=flags or ACF_DBWRITE; - // else if lstrcmpiw(tmp,ioRead)=0 then ; - tmp:=getAttrValue(HXML(node),ioContact); - if lstrcmpiw(tmp,ioCurrent)=0 then flags:=flags or ACF_CURRENT - else if lstrcmpiw(tmp,ioResult )=0 then flags:=flags or ACF_RESULT - else if lstrcmpiw(tmp,ioParam )=0 then flags:=flags or ACF_PARAM - else if lstrcmpiw(tmp,ioContact)=0 then - begin - dbcontact:=ImportContact(HXML(node)); - end; - - StrDupW(dbmodule ,getAttrValue(HXML(node),ioModule)); - StrDupW(dbsetting,getAttrValue(HXML(node),ioSetting)); - - if StrToInt(getAttrValue(HXML(node),ioFileVariable))=1 then flags:=flags or ACF_RW_MODULE; - if StrToInt(getAttrValue(HXML(node),ioArgVariable ))=1 then flags:=flags or ACF_RW_SETTING; - if StrToInt(getAttrValue(HXML(node),ioVariables ))=1 then flags:=flags or ACF_RW_VALUE; - - tmp:=getAttrValue(HXML(node),ioType); - if lstrcmpiw(tmp,ioByte )=0 then flags:=flags or ACF_DBBYTE - else if lstrcmpiw(tmp,ioWord )=0 then flags:=flags or ACF_DBWORD - else if lstrcmpiw(tmp,ioDword)=0 then - else if lstrcmpiw(tmp,ioAnsi )=0 then flags:=flags or ACF_DBANSI - else flags:=flags or ACF_DBUTEXT; - - if StrToInt(getAttrValue(HXML(node),ioSaveValue))=1 then - flags:=flags or ACF_SAVE; - - if StrToInt(getAttrValue(HXML(node),ioLast))=1 then - flags:=flags or ACF_LAST - else - StrDupW(dbvalue,getText(HXML(node))); - end; - end; -{ - 2: begin - pc:=GetParamSectionStr(node,ioOper); - if lstrcmpi(pc,ioDelete)=0 then flags:=flags or ACF_DBDELETE - else if lstrcmpi(pc,ioWrite )=0 then flags:=flags or ACF_DBWRITE; -// else if lstrcmpiw(tmp,ioRead)=0 then ; - pc:=GetParamSectionStr(node,ioContact); - if lstrcmpi(pc,ioCurrent)=0 then flags:=flags or ACF_CURRENT - else if lstrcmpi(pc,ioResult )=0 then flags:=flags or ACF_RESULT - else if lstrcmpi(pc,ioParam )=0 then flags:=flags or ACF_PARAM - else if lstrcmpi(pc,ioContact)=0 then - begin - dbcontact:=ImportContactINI(node); - end; - - UF8ToWide(GetParamSectionStr(node,ioModule ),dbmodule); - UF8ToWide(GetParamSectionStr(node,ioSetting),dbsetting); - - if GetParamSectionInt(node,ioFileVariable)=1 then flags:=flags or ACF_RW_MODULE; - if GetParamSectionInt(node,ioArgVariable )=1 then flags:=flags or ACF_RW_SETTING; - if GetParamSectionInt(node,ioVariables )=1 then flags:=flags or ACF_RW_VALUE; - - pc:=GetParamSectionStr(node,ioType); - if lstrcmpi(pc,ioByte )=0 then flags:=flags or ACF_DBBYTE - else if lstrcmpi(pc,ioWord )=0 then flags:=flags or ACF_DBWORD - else if lstrcmpi(pc,ioDword)=0 then - else if lstrcmpi(pc,ioAnsi )=0 then flags:=flags or ACF_DBANSI - else flags:=flags or ACF_DBUTEXT; - - if GetParamSectionInt(node,ioLast))=1 then - flags:=flags or ACF_LAST - else - UF8ToWide(GetParamSectionStr(node,'value'),dbvalue); //!! - end; -} - end; -end; - -procedure tDataBaseAction.Save(node:pointer;fmt:integer); -var - section: array [0..127] of AnsiChar; - pc:pAnsiChar; -begin - inherited Save(node,fmt); - case fmt of - 0: begin - if (flags and ACF_NOCONTACT)=0 then - SaveContact(dbcontact,DBBranch,node); - pc:=StrCopyE(section,pAnsiChar(node)); - StrCopy(pc,opt_module ); DBWriteUnicode(0,DBBranch,section,dbmodule); - StrCopy(pc,opt_setting); DBWriteUnicode(0,DBBranch,section,dbsetting); - if ((flags and ACF_DBDELETE)=0) and - ((flags and ACF_LAST)=0) then - begin - StrCopy(pc,opt_value); DBWriteUnicode(0,DBBranch,section,dbvalue); - end; - end; -{ - 1: begin - end; -} - 13: begin - end; - end; -end; - -//----- Dialog realization ----- - -procedure MakeContactTypeList(wnd:HWND); -begin - SendMessage(wnd,CB_RESETCONTENT,0,0); - InsertString(wnd,0,'Own settings'); - InsertString(wnd,1,'Parameter'); - InsertString(wnd,2,'Last result'); - InsertString(wnd,3,'Manual'); - SendMessage(wnd,CB_SETCURSEL,0,0); -end; - -procedure MakeDataTypeList(wnd:HWND); -begin - SendMessage(wnd,CB_RESETCONTENT,0,0); - InsertString(wnd,0,'Byte'); - InsertString(wnd,1,'Word'); - InsertString(wnd,2,'DWord'); - InsertString(wnd,3,'Ansi'); - InsertString(wnd,4,'Unicode'); - SendMessage(wnd,CB_SETCURSEL,0,0); -end; - -procedure ClearFields(Dialog:HWND); -begin - CheckDlgButton(Dialog,IDC_RW_LAST,BST_UNCHECKED); - CheckDlgButton(Dialog,IDC_RW_SAVE,BST_UNCHECKED); - - CheckDlgButton(Dialog,IDC_RW_READ ,BST_UNCHECKED); - CheckDlgButton(Dialog,IDC_RW_WRITE ,BST_UNCHECKED); - CheckDlgButton(Dialog,IDC_RW_DELETE,BST_UNCHECKED); -end; - -function DlgProc(Dialog:HWND;hMessage:uint;wParam:WPARAM;lParam:LPARAM):LRESULT; stdcall; -const - NoProcess:boolean=true; -var - wnd:HWND; - i:integer; - bb:boolean; -begin - result:=0; - - case hMessage of - - WM_INITDIALOG: begin - TranslateDialogDefault(Dialog); - - MakeContactTypeList(GetDlgItem(Dialog,IDC_CONTACTTYPE)); - MakeDataTypeList (GetDlgItem(Dialog,IDC_RW_DATATYPE)); - - wnd:=GetDlgItem(Dialog,IDC_CNT_REFRESH); - OptSetButtonIcon(wnd,ACI_REFRESH); - SendMessage(wnd,BUTTONADDTOOLTIP,TWPARAM(TranslateW('Refresh')),BATF_UNICODE); - OptFillContactList(GetDlgItem(Dialog,IDC_CONTACTLIST)); - - MakeEditField(Dialog,IDC_RW_MODULE); - MakeEditField(Dialog,IDC_RW_SETTING); - MakeEditField(Dialog,IDC_RW_VALUE); - end; - - WM_ACT_SETVALUE: begin - NoProcess:=true; - ClearFields(Dialog); - - with tDataBaseAction(lParam) do - begin - // operation - if (flags and ACF_DBDELETE)<>0 then i:=IDC_RW_DELETE - else if (flags and ACF_DBWRITE )= 0 then i:=IDC_RW_READ - else i:=IDC_RW_WRITE; - CheckDlgButton(Dialog,i,BST_CHECKED); - - // contact - bb:=false; - wnd:=GetDlgItem(Dialog,IDC_CONTACTLIST); - case (flags and ACF_NOCONTACT) of - ACF_CURRENT: i:=0; - ACF_PARAM : i:=1; - ACF_RESULT : i:=2; - else - i:=3; - bb:=true; - SendMessage(wnd,CB_SETCURSEL,FindContact(wnd,dbcontact),0); - end; - CB_SelectData(GetDlgItem(Dialog,IDC_CONTACTTYPE),i); - EnableWindow(wnd,bb); - - SetDlgItemTextW(Dialog,IDC_RW_MODULE ,dbmodule); - SetDlgItemTextW(Dialog,IDC_RW_SETTING,dbsetting); - SetEditFlags(Dialog,IDC_RW_MODULE ,EF_SCRIPT,ord((flags and ACF_RW_MODULE )<>0)); - SetEditFlags(Dialog,IDC_RW_SETTING,EF_SCRIPT,ord((flags and ACF_RW_SETTING)<>0)); - - // values - bb:=true; - if (flags and ACF_LAST)<>0 then - begin - CheckDlgButton(Dialog,IDC_RW_LAST,BST_CHECKED); - bb:=false; - end; - if (flags and ACF_DBDELETE)<>0 then - bb:=false; - EnableWindow(GetDlgItem(Dialog,IDC_RW_VALUE),bb); - - if (flags and ACF_SAVE)<>0 then - CheckDlgButton(Dialog,IDC_RW_SAVE,BST_CHECKED); - EnableWindow(GetDlgItem(Dialog,IDC_RW_SAVE),(flags and ACF_DBWRITE)<>0); - - case (flags and ACF_VALUETYPE) of - ACF_DBBYTE : i:=0; - ACF_DBWORD : i:=1; - ACF_DBANSI : i:=3; - ACF_DBUTEXT: i:=4; - else - i:=2; - end; - CB_SelectData(GetDlgItem(Dialog,IDC_RW_DATATYPE),i); - - SetDlgItemTextW(Dialog,IDC_RW_VALUE,dbvalue); - SetEditFlags(Dialog,IDC_RW_VALUE,EF_SCRIPT,ord((flags and ACF_RW_VALUE)<>0)); - end; - NoProcess:=false; - end; - - WM_ACT_RESET: begin - NoProcess:=true; - ClearFields(Dialog); - - CB_SelectData(GetDlgItem(Dialog,IDC_CONTACTTYPE),0); - - SetDlgItemTextW(Dialog,IDC_RW_MODULE ,nil); - SetDlgItemTextW(Dialog,IDC_RW_SETTING,nil); - SetDlgItemTextW(Dialog,IDC_RW_VALUE ,nil); - SetEditFlags(Dialog,IDC_RW_MODULE ,EF_ALL,0); - SetEditFlags(Dialog,IDC_RW_SETTING,EF_ALL,0); - SetEditFlags(Dialog,IDC_RW_VALUE ,EF_ALL,0); - - CB_SelectData(GetDlgItem(Dialog,IDC_RW_DATATYPE),0); - CheckDlgButton(Dialog,IDC_RW_READ ,BST_CHECKED); - CheckDlgButton(Dialog,IDC_RW_SAVE ,BST_CHECKED); - - EnableWindow(GetDlgItem(Dialog,IDC_CONTACTLIST),true); - EnableWindow(GetDlgItem(Dialog,IDC_RW_VALUE),true); - NoProcess:=false; - end; - - WM_ACT_SAVE: begin - with tDataBaseAction(lParam) do - begin - // contact - i:=CB_GetData(GetDlgItem(Dialog,IDC_CONTACTTYPE)); - case i of - 0: flags:=flags or ACF_CURRENT; - 1: flags:=flags or ACF_PARAM; - 2: flags:=flags or ACF_RESULT; - 3: begin - wnd:=GetDlgItem(Dialog,IDC_CONTACTLIST); - dbcontact:=SendMessage(wnd,CB_GETITEMDATA,SendMessage(wnd,CB_GETCURSEL,0,0),0); - end; - end; - - {mFreeMem(dbmodule ); }dbmodule :=GetDlgText(Dialog,IDC_RW_MODULE); - {mFreeMem(dbsetting); }dbsetting:=GetDlgText(Dialog,IDC_RW_SETTING); - if (GetEditFlags(Dialog,IDC_RW_MODULE ) and EF_SCRIPT)<>0 then flags:=flags or ACF_RW_MODULE; - if (GetEditFlags(Dialog,IDC_RW_SETTING) and EF_SCRIPT)<>0 then flags:=flags or ACF_RW_SETTING; - - // operation - if IsDlgButtonChecked(Dialog,IDC_RW_WRITE )=BST_CHECKED then flags:=flags or ACF_DBWRITE - else if IsDlgButtonChecked(Dialog,IDC_RW_DELETE)=BST_CHECKED then flags:=flags or ACF_DBDELETE; - - // value - if IsDlgButtonChecked(Dialog,IDC_RW_LAST)<>BST_UNCHECKED then - flags:=flags or ACF_LAST - else if (flags and ACF_DBDELETE)=0 then - begin - {mFreeMem(dbvalue); }dbvalue:=GetDlgText(Dialog,IDC_RW_VALUE); - if (GetEditFlags(Dialog,IDC_RW_VALUE) and EF_SCRIPT)<>0 then flags:=flags or ACF_RW_VALUE; - end; - - if IsDlgButtonChecked(Dialog,IDC_RW_SAVE)<>BST_UNCHECKED then - flags:=flags or ACF_SAVE; - - i:=CB_GetData(GetDlgItem(Dialog,IDC_RW_DATATYPE)); - case i of - 0: flags:=flags or ACF_DBBYTE; - 1: flags:=flags or ACF_DBWORD; - 2: flags:=flags or 0; - 3: flags:=flags or ACF_DBANSI; - 4: flags:=flags or ACF_DBUTEXT; - end; - end; - end; - - WM_COMMAND: begin - case wParam shr 16 of - CBN_SELCHANGE: begin - if loword(wParam)=IDC_CONTACTTYPE then - begin - i:=CB_GetData(lParam); - case i of - 0,1,2: bb:=false; - else // 3 - bb:=true; - end; - EnableWindow(GetDlgItem(Dialog,IDC_CONTACTLIST),bb); - end; - if not NoProcess then - SendMessage(GetParent(GetParent(Dialog)),PSM_CHANGED,0,0); - end; - - EN_CHANGE: if not NoProcess then - SendMessage(GetParent(GetParent(Dialog)),PSM_CHANGED,0,0); - - BN_CLICKED: begin - case loword(wParam) of - IDC_RW_READ, - IDC_RW_WRITE, - IDC_RW_DELETE: begin - bb:=IsDlgButtonChecked(Dialog,IDC_RW_DELETE)=BST_UNCHECKED; - EnableWindow(GetDlgItem(Dialog,IDC_RW_DATATYPE),bb); - EnableWindow(GetDlgItem(Dialog,IDC_RW_LAST),bb); - if bb then - bb:=IsDlgButtonChecked(Dialog,IDC_RW_LAST)=BST_UNCHECKED; - EnableEditField(GetDlgItem(Dialog,IDC_RW_VALUE),bb); - - bb:=loword(wParam)=IDC_RW_WRITE; - EnableWindow(GetDlgItem(Dialog,IDC_RW_SAVE),bb); - end; - - IDC_RW_LAST: begin - EnableEditField(GetDlgItem(Dialog,IDC_RW_VALUE), - IsDlgButtonChecked(Dialog,IDC_RW_LAST)=BST_UNCHECKED); - end; - - IDC_CNT_REFRESH: begin - OptFillContactList(GetDlgItem(Dialog,IDC_CONTACTLIST)); - exit; - end; - end; - SendMessage(GetParent(GetParent(Dialog)),PSM_CHANGED,0,0); - end; - - end; - end; - - WM_HELP: begin - result:=1; - end; - - end; -end; - -//----- Export/interface functions ----- - -var - vc:tActModule; - -function CreateAction:tBaseAction; -begin - result:=tDataBaseAction.Create(vc.Hash); -end; - -function CreateDialog(parent:HWND):HWND; -begin - result:=CreateDialogW(hInstance,'IDD_ACTDATABASE',parent,@DlgProc); -end; - -procedure Init; -begin - vc.Next :=ModuleLink; - - vc.Name :='Database'; - vc.Dialog :=@CreateDialog; - vc.Create :=@CreateAction; - vc.Icon :='IDI_DATABASE'; - vc.Hash :=0; - - ModuleLink :=@vc; -end; - -begin - Init; -end. -- cgit v1.2.3