path: root/plugins/Actman/iac_dbrw.pas

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:=Proto_GetBaseAccountName(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
      tmp:=xmlGetAttrValue(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;
      tmp:=xmlGetAttrValue(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 ,xmlGetAttrValue(HXML(node),ioModule));
      StrDupW(dbsetting,xmlGetAttrValue(HXML(node),ioSetting));

      if StrToInt(xmlGetAttrValue(HXML(node),ioFileVariable))=1 then flags:=flags or ACF_RW_MODULE;
      if StrToInt(xmlGetAttrValue(HXML(node),ioArgVariable ))=1 then flags:=flags or ACF_RW_SETTING;
      if StrToInt(xmlGetAttrValue(HXML(node),ioVariables   ))=1 then flags:=flags or ACF_RW_VALUE;
	
      tmp:=xmlGetAttrValue(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(xmlGetAttrValue(HXML(node),ioSaveValue))=1 then
        flags:=flags or ACF_SAVE;

      if StrToInt(xmlGetAttrValue(HXML(node),ioLast))=1 then
        flags:=flags or ACF_LAST
      else
        StrDupW(dbvalue,xmlGetText(HXML(node)));
    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.