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

1 files changed, 778 insertions, 0 deletions

diff --git a/plugins/Actman/iac_dbrw.pas b/plugins/Actman/iac_dbrw.pas
new file mode 100644
index 0000000000..7ddbe0b61c
--- /dev/null
+++ b/plugins/Actman/iac_dbrw.pas
@@ -0,0 +1,778 @@
+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,'<last>',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,'<last>',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.