summaryrefslogtreecommitdiff
path: root/plugins/Utils.pas/old
diff options
context:
space:
mode:
authorVadim Dashevskiy <watcherhd@gmail.com>2012-10-08 18:43:29 +0000
committerVadim Dashevskiy <watcherhd@gmail.com>2012-10-08 18:43:29 +0000
commit864081102a5f252415f41950b3039a896b4ae9c5 (patch)
treec6b764651e9dd1f8f53b98eab05f16ba4a492a79 /plugins/Utils.pas/old
parentdb5149b48346c417e18add5702a9dfe7f6e28dd0 (diff)
Awkwars's plugins - welcome to our trunk
git-svn-id: http://svn.miranda-ng.org/main/trunk@1822 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c
Diffstat (limited to 'plugins/Utils.pas/old')
-rw-r--r--plugins/Utils.pas/old/hotkeys.pas574
-rw-r--r--plugins/Utils.pas/old/ini.pas857
-rw-r--r--plugins/Utils.pas/old/mApiCardC.pas399
3 files changed, 1830 insertions, 0 deletions
diff --git a/plugins/Utils.pas/old/hotkeys.pas b/plugins/Utils.pas/old/hotkeys.pas
new file mode 100644
index 0000000000..32f6e201e5
--- /dev/null
+++ b/plugins/Utils.pas/old/hotkeys.pas
@@ -0,0 +1,574 @@
+{Hotkey and timer related functions}
+unit hotkeys;
+
+interface
+
+uses windows;
+
+type
+ AWKHotKeyProc = function(hotkey:integer):integer;
+
+function AddProc(aproc:AWKHotKeyProc;ahotkey:integer;global:bool=false):integer; overload;
+function AddProc(ahotkey:integer;wnd:HWND;aproc:AWKHotKeyProc ):integer; overload;
+function AddProc(ahotkey:integer;wnd:HWND;msg:uint_ptr ):integer; overload;
+function DelProc(hotkey:integer ):integer; overload;
+function DelProc(hotkey:integer;wnd:HWND):integer; overload;
+
+procedure InitHotKeys;
+procedure FreeHotKeys;
+
+implementation
+
+uses messages;
+
+const
+ HWND_MESSAGE = HWND(-3);
+
+var
+ CurThread:THANDLE;
+
+type
+ PKBDLLHOOKSTRUCT = ^TKBDLLHOOKSTRUCT;
+ TKBDLLHOOKSTRUCT = record
+ vkCode :dword;
+ scanCode :dword;
+ flags :dword;
+ time :dword;
+ dwExtraInfo:dword;
+ end;
+
+const
+ WH_KEYBOARD_LL = 13;
+ WM_MYMESSAGE = WM_USER +13;
+
+// const from commctrl module;
+const
+ HOTKEYF_SHIFT = $01;
+ HOTKEYF_CONTROL = $02;
+ HOTKEYF_ALT = $04;
+ HOTKEYF_EXT = $08;
+
+const
+ hkAssigned = 1;
+ hkGlobal = 2;
+ hkMessage = 4;
+const
+ kbHook:THANDLE=0;
+ hiddenwindow:HWND=0;
+ modifiers:dword=0;
+const
+ PageStep = 10;
+type
+ PHKRec = ^THKRec;
+ THKRec = record
+ proc :AWKHotKeyProc; // procedure
+ flags :integer; // options
+ handle:THANDLE; // thread or window?
+ atom :TATOM; // hotkey id
+ hotkey:integer; // hotkey
+ end;
+ PHKRecs = ^THKRecs;
+ THKRecs = array [0..15] of THKRec;
+
+const
+ NumRecs:integer=0;
+ MaxRecs:integer=10;
+ hkRecs:pHKRecs=nil;
+
+//----- simpler version of 'common' function -----
+
+const
+ HexDigitChr: array [0..15] of AnsiChar = ('0','1','2','3','4','5','6','7',
+ '8','9','A','B','C','D','E','F');
+
+function IntToHex(dst:PAnsiChar;Value:cardinal):PAnsiChar;
+var
+ Digits:integer;
+begin
+ dst[8]:=#0;
+ Digits:=8;
+ repeat
+ Dec(Digits);
+ dst[Digits]:=HexDigitChr[Value and $F];
+ Value:=Value shr 4;
+ until Digits=0;
+ result:=dst;
+end;
+
+//----- utils -----
+
+function GetAtom(hotkey:dword):dword;
+const
+ HKPrefix = 'awk_';
+var
+ p:array [0..15] of AnsiChar;
+begin
+ lstrcpya(p,HKPrefix);
+ IntToHex(p+Length(HKPrefix),hotkey);
+ result:=GlobalAddAtomA(p);
+end;
+
+function HotKeyDlgToHook(w:cardinal):cardinal; register;
+asm
+ movzx ecx,al
+ xor al,al
+ test ah,HOTKEYF_ALT
+ je @L1
+ or al,MOD_ALT
+@L1:
+ test ah,HOTKEYF_CONTROL
+ je @L2
+ or al,MOD_CONTROL
+@L2:
+ test ah,HOTKEYF_SHIFT
+ je @L3
+ or al,MOD_SHIFT
+@L3:
+ test ah,HOTKEYF_EXT
+ je @L4
+ or al,MOD_WIN
+@L4:
+ mov ch,al
+ mov eax,ecx
+{
+begin
+ result:=w and $FF;
+ if (w and (HOTKEYF_ALT shl 8))<>0 then result:=result or (MOD_ALT shl 8);
+ if (w and (HOTKEYF_CONTROL shl 8))<>0 then result:=result or (MOD_CONTROL shl 8);
+ if (w and (HOTKEYF_SHIFT shl 8))<>0 then result:=result or (MOD_SHIFT shl 8);
+ if (w and (HOTKEYF_EXT shl 8))<>0 then result:=result or (MOD_WIN shl 8);
+}
+end;
+
+function HotKeyHookToDlg(w:cardinal):cardinal; register;
+asm
+ movzx ecx,al
+ xor al,al
+ test ah,MOD_ALT
+ je @L1
+ or al,HOTKEYF_ALT
+@L1:
+ test ah,MOD_CONTROL
+ je @L2
+ or al,HOTKEYF_CONTROL
+@L2:
+ test ah,MOD_SHIFT
+ je @L3
+ or al,HOTKEYF_SHIFT
+@L3:
+ test ah,MOD_WIN
+ je @L4
+ or al,HOTKEYF_EXT
+@L4:
+ mov ch,al
+ mov eax,ecx
+{
+begin
+ result:=w and $FF;
+ if (w and (MOD_ALT shl 8))<>0 then result:=result or (HOTKEYF_ALT shl 8);
+ if (w and (MOD_CONTROL shl 8))<>0 then result:=result or (HOTKEYF_CONTROL shl 8);
+ if (w and (MOD_SHIFT shl 8))<>0 then result:=result or (HOTKEYF_SHIFT shl 8);
+ if (w and (MOD_WIN shl 8))<>0 then result:=result or (HOTKEYF_EXT shl 8);
+}
+end;
+
+//----- Hook -----
+
+function FindHotkey(keycode:integer;local:boolean):pointer;
+var
+ i:integer;
+ p:pHKRec;
+begin
+ i:=NumRecs;
+ p:=pointer(HKRecs);
+ while i>0 do
+ begin
+ dec(i);
+ with p^ do
+ begin
+ if (flags and hkAssigned)<>0 then
+ begin
+ if (local xor ((flags and hkGlobal)<>0)) then
+ begin
+ if hotkey=keycode then
+ begin
+ if handle<>0 then
+ begin
+ if GetFocus=handle then
+ begin
+ if (flags and hkMessage)<>0 then
+ begin
+ PostMessage(handle,wparam(@proc),keycode,0);
+ result:=pointer(-1);
+ end
+ else
+ result:=@proc;
+ exit;
+ end;
+ end
+ else
+ begin
+ result:=@proc;
+ exit;
+ end;
+ end;
+ end;
+ end;
+ end;
+ inc(p);
+ end;
+ result:=nil;
+end;
+
+function wmKeyboard_hook(code:integer;wParam:WPARAM;lParam:LPARAM):longint; stdcall;
+var
+ key:dword;
+ proc:pointer;
+begin
+ if (code=HC_ACTION) and
+ (lParam>0) and (LoWord(lParam)=1) then
+ begin
+ key:=0;
+ if (GetKeyState(VK_SHIFT ) and $8000)<>0 then key:=key or (MOD_SHIFT shl 8);
+ if (GetKeyState(VK_CONTROL) and $8000)<>0 then key:=key or (MOD_CONTROL shl 8);
+ if (GetKeyState(VK_MENU ) and $8000)<>0 then key:=key or (MOD_ALT shl 8);
+ if (GetKeyState(VK_LWIN ) and $8000)<>0 then key:=key or (MOD_WIN shl 8);
+ if (GetKeyState(VK_RWIN ) and $8000)<>0 then key:=key or (MOD_WIN shl 8);
+// if (GetKeyState(VK_APPS) and $8000)<>0 then
+// if (GetKeyState(VK_SLEEP) and $8000)<>0 then
+ key:=key or (cardinal(wParam) and $FF);
+ proc:=FindHotkey(key,true);
+ if proc<>nil then
+ begin
+ if proc<>pointer(-1) then
+ PostMessageA(hiddenwindow,WM_MYMESSAGE,key,windows.lparam(proc));
+ result:=1;
+ exit;
+ end;
+ end;
+ result:=CallNextHookEx(KbHook,code,wParam,lParam);
+end;
+
+function wmKeyboardLL_hook(code:integer;wParam:WPARAM;lParam:LPARAM):integer; stdcall;
+const
+ lastkey:dword=0;
+var
+ mask:dword;
+ key:dword;
+ proc:pointer;
+begin
+ if code=HC_ACTION then
+ begin
+ case PKBDLLHOOKSTRUCT(lParam)^.vkCode of
+ VK_MENU,
+ VK_LMENU,
+ VK_RMENU: mask:=MOD_ALT shl 8;
+ VK_LWIN,
+ VK_RWIN: mask:=MOD_WIN shl 8;
+ VK_SHIFT,
+ VK_LSHIFT,
+ VK_RSHIFT: mask:=MOD_SHIFT shl 8;
+ VK_CONTROL,
+ VK_LCONTROL,
+ VK_RCONTROL: mask:=MOD_CONTROL shl 8;
+ else
+ if (PKBDLLHOOKSTRUCT(lParam)^.flags and 128)=0 then
+ begin
+ // local only
+// maybe process will better choice?
+ if //(lastkey=0) and
+ (CurThread=GetWindowThreadProcessId(GetForegroundWindow,nil)) then
+ begin
+ key:=PKBDLLHOOKSTRUCT(lParam)^.vkCode or modifiers;
+ proc:=FindHotkey(key,true);
+ if proc<>nil then
+ begin
+ lastkey:=PKBDLLHOOKSTRUCT(lParam)^.vkCode;
+ if proc<>pointer(-1) then
+ PostMessageA(hiddenwindow,WM_MYMESSAGE,key,windows.lparam(proc));
+ result:=1;
+ exit;
+ end;
+ end;
+ end
+ else if (lastkey<>0) and (lastkey=PKBDLLHOOKSTRUCT(lParam)^.vkCode) then
+ begin
+ lastkey:=0;
+ result :=1;
+ exit;
+ end;
+ mask:=0;
+ end;
+ if mask<>0 then
+ begin
+ if (PKBDLLHOOKSTRUCT(lParam)^.flags and 128)=0 then
+ modifiers:=modifiers or mask
+ else
+ modifiers:=modifiers and not mask;
+ end
+ end;
+ result:=CallNextHookEx(KbHook,code,wParam,lParam);
+end;
+
+function HiddenWindProc(wnd:HWnd;msg:UINT;wParam:WPARAM;lParam:LPARAM):lresult; stdcall;
+var
+ key:dword;
+begin
+ if Msg=WM_HOTKEY then
+ begin
+ key:=(lParam shr 16)+((lParam and $FF) shl 8);
+ result:=lresult(FindHotKey(key,false));
+ if result<>0 then
+ begin
+ result:=AWKHotKeyProc(result)(HotkeyHookToDlg(key));
+ exit;
+ end;
+ end
+ else if Msg=WM_MYMESSAGE then
+ begin
+ result:=AWKHotKeyProc(lParam)(HotkeyHookToDlg(wParam));
+ exit;
+ end;
+ result:=DefWindowProcA(wnd,msg,wparam,lparam);
+end;
+
+procedure DestroyHiddenWindow;
+begin
+ if hiddenwindow<>0 then
+ begin
+ DestroyWindow(hiddenwindow);
+ hiddenwindow:=0;
+ end;
+end;
+
+procedure CreateHiddenWindow;
+var
+ wnd:HWND;
+begin
+ if hiddenwindow=0 then
+ begin
+ wnd:=CreateWindowExA(0,'STATIC',nil,0,
+ 1,1,1,1,HWND_MESSAGE,0,hInstance,nil);
+ if wnd<>0 then
+ begin
+ SetWindowLongPtrA(wnd,GWL_WNDPROC,LONG_PTR(@HiddenWindProc));
+ hiddenwindow:=wnd;
+ end
+ end
+end;
+//----- interface -----
+
+function CheckTable(ahotkey:integer;global:bool):integer;
+var
+ tmp:pHKRecs;
+ i:integer;
+ p:pHKRec;
+begin
+ if HKRecs=nil then
+ begin
+ MaxRecs:=PageStep;
+ GetMem (HKRecs ,MaxRecs*SizeOf(THKRec));
+ FillChar(HKRecs^,MaxRecs*SizeOf(THKRec),0);
+ NumRecs:=0;
+ end;
+ // search existing
+ i:=0;
+ p:=pointer(HKRecs);
+ while i<NumRecs do
+ begin
+ if (p^.flags and hkAssigned)<>0 then
+ begin
+ if (p^.hotkey=ahotkey) and
+ (((p^.flags and hkGlobal)<>0) xor not global) then
+ break;
+ end;
+ inc(p);
+ inc(i);
+ end;
+ //search empty
+ if i=NumRecs then
+ begin
+ i:=0;
+ p:=pointer(HKRecs);
+ while i<NumRecs do
+ begin
+ if (p^.flags and hkAssigned)=0 then
+ break;
+ inc(p);
+ inc(i);
+ end;
+ end;
+ if i=NumRecs then // allocate if not found
+ begin
+ if NumRecs=MaxRecs then
+ begin
+ inc(MaxRecs,PageStep);
+ GetMem (tmp ,MaxRecs*SizeOf(THKRec));
+ FillChar(tmp^,MaxRecs*SizeOf(THKRec),0);
+ move(HKRecs^,tmp^,NumRecs*SizeOf(THKRec));
+ FreeMem(HKRecs);
+ HKRecs:=tmp;
+ end;
+ inc(NumRecs);
+ end;
+ if global then
+ HKRecs^[i].flags:=hkAssigned or hkGlobal
+ else
+ HKRecs^[i].flags:=hkAssigned;
+ HKRecs^[i].hotkey:=HotKeyDlgToHook(ahotkey);
+ result:=i;
+end;
+
+function AddProc(aproc:AWKHotKeyProc;ahotkey:integer;global:bool=false):integer;
+begin
+ result:=1;
+ if @aproc=nil then exit;
+
+ with HKRecs^[CheckTable(ahotkey,global)] do
+ begin
+ proc :=aproc;
+ handle:=0;
+ if global then
+ begin
+ atom:=GetAtom(hotkey);
+ if not RegisterHotKey(hiddenwindow,atom,((hotkey and $FF00) shr 8),(hotkey and $FF)) then
+ result:=0;
+ end;
+ end;
+end;
+
+// search needed
+function AddProcWin(ahotkey:integer;wnd:HWND):integer;
+begin
+ result:=CheckTable(ahotkey,false);
+ with HKRecs^[result] do
+ begin
+ handle:=wnd;
+ end;
+end;
+
+function AddProc(ahotkey:integer;wnd:HWND;aproc:AWKHotKeyProc):integer;
+begin
+ if @aproc=nil then
+ begin
+ result:=0;
+ exit;
+ end;
+
+ result:=AddProcWin(ahotkey,wnd);
+ if result<0 then
+ result:=0
+ else
+ begin
+ HKRecs^[result].proc:=@aproc;
+ end;
+end;
+
+function AddProc(ahotkey:integer;wnd:HWND;msg:uint_ptr):integer;
+begin
+ result:=AddProcWin(ahotkey,wnd);
+ if result<0 then
+ result:=0
+ else
+ begin
+ HKRecs^[result].flags:=HKRecs^[result].flags or hkMessage;
+ HKRecs^[result].proc:=pointer(msg);
+ end;
+end;
+
+function DelProc(hotkey:integer):integer;
+var
+ i:integer;
+ p:pHKRec;
+begin
+ hotkey:=HotKeyDlgToHook(hotkey); //!!
+ p:=pointer(HKRecs);
+ i:=NumRecs;
+ while i>0 do
+ begin
+ dec(i);
+ if ((p^.flags and hkAssigned)<>0) and (p^.handle=0) then
+ if p^.hotkey=hotkey then
+ begin
+ if (p^.flags and hkGlobal)<>0 then
+ begin
+ UnregisterHotKey(hiddenwindow,p^.atom);
+ GlobalDeleteAtom(p^.atom);
+ end;
+ p^.flags:=p^.flags and not hkAssigned;
+ result:=i;
+ exit;
+ end;
+ inc(p);
+ end;
+ result:=0;
+end;
+
+function DelProc(hotkey:integer;wnd:HWND):integer;
+var
+ i:integer;
+ p:pHKRec;
+begin
+ hotkey:=HotKeyDlgToHook(hotkey); //!!
+ p:=pointer(HKRecs);
+ i:=NumRecs;
+ while i>0 do
+ begin
+ dec(i);
+ if (p^.flags and hkAssigned)<>0 then
+ if (p^.handle=wnd) {and ((p^.flags and hkGlobal)=0)} then
+ begin
+ if (hotkey=0) or (hotkey=p^.hotkey) then
+ begin
+ p^.flags:=p^.flags and not hkAssigned;
+ result:=i;
+ exit;
+ end;
+ end;
+ inc(p);
+ end;
+ result:=0;
+end;
+
+procedure InitHotKeys;
+begin
+ MaxRecs:=10;
+ GetMem(HKRecs,SizeOf(THKRec)*MaxRecs);
+ FillChar(HKRecs^,SizeOf(THKRec)*MaxRecs,0);
+ NumRecs:=0;
+ CreateHiddenWindow;
+ kbhook:=SetWindowsHookExA(WH_KEYBOARD_LL,@wmKeyboardLL_hook,hInstance,0);
+
+ if KbHook=0 then
+ KbHook:=SetWindowsHookExA(WH_KEYBOARD,@wmKeyboard_hook,0,GetCurrentThreadId);
+end;
+
+procedure FreeHotKeys;
+var
+ i:integer;
+ p:pHKRec;
+begin
+ i:=NumRecs;
+ p:=pointer(HKRecs);
+ while i>0 do
+ begin
+ dec(i);
+ if (p^.flags and (hkAssigned or hkGlobal))=(hkAssigned or hkGlobal) then
+ begin
+ UnregisterHotKey(hiddenwindow,p^.atom);
+ GlobalDeleteAtom(p^.atom);
+ end;
+ inc(p);
+ end;
+ DestroyHiddenWindow;
+ if kbhook<>0 then
+ UnhookWindowsHookEx(kbhook);
+ FreeMem(HKRecs);
+ HKRecs:=nil;
+ MaxRecs:=0;
+ NumRecs:=0;
+end;
+
+initialization
+ CurThread:=GetCurrentThreadId();
+end. \ No newline at end of file
diff --git a/plugins/Utils.pas/old/ini.pas b/plugins/Utils.pas/old/ini.pas
new file mode 100644
index 0000000000..8746b51c53
--- /dev/null
+++ b/plugins/Utils.pas/old/ini.pas
@@ -0,0 +1,857 @@
+unit INI;
+
+interface
+
+uses windows;
+
+{+}function SetStorage(name:PAnsiChar;inINI:boolean):cardinal;
+{+}procedure FreeStorage(aHandle:cardinal);
+
+{+}procedure SetDefaultSection(aHandle:cardinal;name:PAnsiChar);
+{+}procedure SetCurrentSection(aHandle:cardinal;sect:PAnsiChar);
+
+{+}procedure FlushSettings(aHandle:cardinal);
+{+}procedure FlushSection(aHandle:cardinal);
+
+{+}procedure WriteNCInt(aHandle:cardinal;sect:PAnsiChar;param:PAnsiChar;value:integer);
+{+}procedure WriteNCStr(aHandle:cardinal;sect:PAnsiChar;param:PAnsiChar;value:PAnsiChar);
+
+{+}procedure WriteNCStruct(aHandle:cardinal;sect:PAnsiChar;param:PAnsiChar;ptr:pointer;size:integer);
+{*}procedure WriteStruct(aHandle:cardinal;param:PAnsiChar;ptr:pointer;size:integer);
+{+}function ReadStruct (aHandle:cardinal;param:PAnsiChar;ptr:pointer;size:integer):boolean;
+
+{+}procedure WriteFlag(aHandle:cardinal;param:PAnsiChar;value:integer);
+{+}procedure WriteInt (aHandle:cardinal;param:PAnsiChar;value:integer);
+{+}procedure WriteStr (aHandle:cardinal;param:PAnsiChar;value:PWideChar);
+procedure WriteAnsiStr(aHandle:cardinal;param:PAnsiChar;value:PAnsiChar);
+{+}function ReadFlag(aHandle:cardinal;param:PAnsiChar; default:integer):integer;
+{+}function ReadInt (aHandle:cardinal;param:PAnsiChar; default:integer):integer;
+procedure ReadStr (aHandle:cardinal;var dst:PWideChar;param:PAnsiChar;default:PWideChar);
+procedure ReadAnsiStr(aHandle:cardinal;var dst:PAnsiChar;param:PAnsiChar;default:PAnsiChar);
+
+procedure WriteSect(aHandle:cardinal;src:PAnsiChar);
+procedure ReadSect (aHandle:cardinal;var dst:PAnsiChar);
+
+{*}procedure ClearSection(aHandle:cardinal);
+{+}procedure DeleteParam(aHandle:cardinal;param:PAnsiChar);
+
+implementation
+
+uses common,io,m_api,dbsettings;
+
+type
+ PStorage = ^TStorage;
+ TStorage = record
+ SName :PAnsiChar;
+ SType :bool;
+ SHandle :THANDLE;
+ DefSection:PAnsiChar;
+ Section :Array [0..127] of AnsiChar;
+ ParOffset :integer;
+ Buffer :PAnsiChar;
+ INIBuffer :PAnsiChar;
+ end;
+ PStHeap = ^TStHeap;
+ TStHeap = array [0..10] of TStorage;
+
+const
+ Storage:PStHeap=nil;
+ NumStorage:cardinal=0;
+
+type
+ pbrec=^brec;
+ brec=record
+ ptr:PAnsiChar;
+ handle:cardinal;
+ end;
+
+const
+ DefDefSection:PAnsiChar = 'default';
+
+{+}function SetStorage(name:PAnsiChar;inINI:boolean):cardinal;
+var
+ i:integer;
+ tmp:PStHeap;
+begin
+ if Storage=nil then
+ begin
+ mGetMem(Storage,SizeOf(TStorage));
+ FillChar(Storage^,SizeOf(TStorage),0);
+ NumStorage:=1;
+ result:=0;
+ end
+ else
+ begin
+ integer(result):=-1;
+ for i:=0 to NumStorage-1 do
+ begin
+ if Storage^[i].SName=nil then // free cell
+ begin
+ result:=i;
+ break;
+ end;
+ end;
+ if integer(result)<0 then
+ begin
+ mGetMem(tmp,SizeOf(TStorage)*(NumStorage+1));
+ move(Storage^,tmp^,SizeOf(TStorage)*NumStorage);
+ mFreeMem(Storage);
+ Storage:=tmp;
+ FillChar(Storage^[NumStorage],SizeOf(TStorage),0);
+ result:=NumStorage;
+ inc(NumStorage);
+ end
+ end;
+ with Storage^[result] do
+ begin
+ StrDup(SName,name);
+ SType:=inINI;
+ end;
+end;
+
+{+}procedure FreeStorage(aHandle:cardinal);
+begin
+ if aHandle>=NumStorage then
+ exit;
+ with Storage^[aHandle] do
+ begin
+ mFreeMem(SName);
+ mFreeMem(DefSection);
+ mFreeMem(Buffer);
+ mFreeMem(INIBuffer);
+ end;
+end;
+
+{+}procedure WriteNCStruct(aHandle:cardinal;sect:PAnsiChar;param:PAnsiChar;ptr:pointer;size:integer);
+var
+ cws:TDBCONTACTWRITESETTING;
+ pn:array [0..127] of AnsiChar;
+ i:integer;
+begin
+ if aHandle>=NumStorage then
+ exit;
+ with Storage^[aHandle] do
+ if SType then
+ begin
+ if (sect=nil) or (sect^=#0) then
+ sect:=DefSection;
+ if sect=nil then
+ sect:=DefDefSection;
+ WritePrivateProfileStructA(sect,param,ptr,size,SName);
+ end
+ else
+ begin
+ if (sect<>nil) and (sect^<>#0) then
+ begin
+ i:=StrLen(sect);
+ move(sect^,pn,i);
+ pn[i]:='/';
+ inc(i);
+ end
+ else
+ i:=0;
+ StrCopy(pn+i,param);
+ cws.szModule :=SName;
+ cws.szSetting :=pn;
+ cws.value._type :=DBVT_BLOB;
+ cws.value.pbVal :=ptr;
+ cws.value.cpbVal:=size;
+ PluginLink^.CallService(MS_DB_CONTACT_WRITESETTING,0,lParam(@cws));
+ end
+end;
+
+{*}procedure WriteStruct(aHandle:cardinal;param:PAnsiChar;ptr:pointer;size:integer);
+const
+ hex:array [0..15] of AnsiChar = '0123456789ABCDEF';
+var
+ lptr:PAnsiChar;
+ buf,buf1:PAnsiChar;
+ i:integer;
+ crc:integer;
+ cws:TDBCONTACTWRITESETTING;
+begin
+ if aHandle>=NumStorage then
+ exit;
+ with Storage^[aHandle] do
+ if SType then
+ begin
+ mGetMem(buf,(size+1)*2);
+ crc:=0;
+ buf1:=buf;
+ for i:=0 to size-1 do
+ begin
+ inc(crc,PByte(ptr)^);
+ buf1^ :=hex[pbyte(ptr)^ shr 4];
+ (buf1+1)^:=hex[pbyte(ptr)^ and $0F];
+ inc(buf1,2);
+ inc(pbyte(ptr));
+ end;
+ buf1^ :=hex[(crc and $FF) shr 4];
+ (buf1+1)^:=hex[(crc and $0F)];
+
+ StrCat(Buffer,param);
+ lptr:=StrEnd(Buffer);
+ lptr^:='=';
+ inc(lptr);
+ move(buf^,lptr^,(size+1)*2);
+ mFreeMem(buf);
+ inc(lptr,(size+1)*2);
+ lptr^ :=#13;
+ (lptr+1)^:=#10;
+ (lptr+2)^:=#0;
+ end
+ else
+ begin
+ StrCopy(Section+ParOffset,param);
+ cws.szModule :=SName;
+ cws.szSetting :=Section;
+ cws.value._type :=DBVT_BLOB;
+ cws.value.pbVal :=ptr;
+ cws.value.cpbVal:=size;
+ PluginLink^.CallService(MS_DB_CONTACT_WRITESETTING,0,lParam(@cws));
+ end
+end;
+
+{+}function ReadStruct(aHandle:cardinal;param:PAnsiChar;ptr:pointer;size:integer):boolean;
+var
+ dbv:TDBVariant;
+begin
+ if aHandle>=NumStorage then
+ begin
+ result:=false;
+ exit;
+ end;
+ with Storage^[aHandle] do
+ if SType then
+ begin
+ result:=GetPrivateProfileStructA(Section,param,ptr,size,SName);
+ end
+ else
+ begin
+ dbv._type:=DBVT_BLOB;
+ dbv.pbVal:=nil;
+ StrCopy(Section+ParOffset,param);
+ if (DBReadSetting(0,SName,Section,@dbv)=0) and
+ (dbv.pbVal<>nil) and (dbv.cpbVal=size) then
+ begin
+ move(dbv.pbVal^,ptr^,size);
+ DBFreeVariant(@dbv);
+ result:=true;
+ end
+ else
+ result:=false;
+ end
+end;
+
+{+}procedure WriteNCInt(aHandle:cardinal;sect:PAnsiChar;param:PAnsiChar;value:integer);
+var
+ pn:array [0..127] of AnsiChar;
+ i:integer;
+begin
+ if aHandle>=NumStorage then
+ exit;
+ with Storage^[aHandle] do
+ if Stype then
+ begin
+ if (sect=nil) or (sect^=#0) then
+ sect:=DefSection;
+ if sect=nil then
+ sect:=DefDefSection;
+ WritePrivateProfileStringA(sect,param,IntToStr(pn,value),SName);
+ end
+ else
+ begin
+ if (sect<>nil) and (sect^<>#0) then
+ begin
+ i:=StrLen(sect);
+ move(sect^,pn,i);
+ pn[i]:='/';
+ inc(i);
+ end
+ else
+ i:=0;
+ StrCopy(pn+i,param);
+ DBWriteDWord(0,SName,pn,value)
+ end
+end;
+
+{+}procedure WriteNCStr(aHandle:cardinal;sect:PAnsiChar;param:PAnsiChar;value:PAnsiChar);
+var
+ pn:array [0..127] of AnsiChar;
+ i:integer;
+begin
+ if aHandle>=NumStorage then
+ exit;
+ with Storage^[aHandle] do
+ if SType then
+ begin
+ if (sect=nil) or (sect^=#0) then
+ sect:=DefSection;
+ if sect=nil then
+ sect:=DefDefSection;
+ WritePrivateProfileStringA(sect,param,value,SName);
+ end
+ else
+ begin
+ if (sect<>nil) and (sect^<>#0) then
+ begin
+ i:=StrLen(sect);
+ move(sect^,pn,i);
+ pn[i]:='/';
+ inc(i);
+ end
+ else
+ i:=0;
+ StrCopy(pn+i,param);
+ DBWriteString(0,SName,pn,value);
+ end
+end;
+
+{+}procedure SetDefaultSection(aHandle:cardinal;name:PAnsiChar);
+begin
+ if aHandle>=NumStorage then
+ exit;
+ with Storage^[aHandle] do
+ begin
+ mFreeMem(DefSection);
+ StrDup(DefSection,name);
+ end;
+end;
+
+{+}procedure SetCurrentSection(aHandle:cardinal;sect:PAnsiChar);
+begin
+ if aHandle>=NumStorage then
+ exit;
+ with Storage^[aHandle] do
+ begin
+ if sect=nil then
+ sect:=DefSection;
+ if sect=nil then
+ sect:='';
+ if SType then
+ begin
+ if (sect=nil) or (sect^=#0) then
+ sect:=DefDefSection;
+ StrCopy(Section,sect);
+ mGetMem(Buffer,16384);
+ Buffer^ :=#13;
+ (Buffer+1)^:=#10;
+ (Buffer+2)^:=#0;
+ end
+ else
+ begin
+ if sect<>nil then
+ begin
+ StrCopy(Section,sect);
+ ParOffset:=StrLen(Section);
+ Section[ParOffset]:='/';
+ inc(ParOffset);
+ end
+ else
+ ParOffset:=0;
+ end
+ end;
+end;
+
+{+}procedure FlushSettings(aHandle:cardinal);
+var
+ size:integer;
+ ptr:PAnsiChar;
+begin
+ if aHandle>=NumStorage then
+ exit;
+ with Storage^[aHandle] do
+ begin
+ if SType then
+ begin
+ if INIBuffer=nil then
+ exit;
+ ptr:=INIBuffer+1;
+ size:=StrLen(ptr);
+ seek(SHandle,0);
+ BlockWrite(SHandle,ptr^,size);
+ SetEndOfFile(SHandle);
+ mFreeMem(INIBuffer);
+ CloseHandle(SHandle);
+ end;
+ end;
+end;
+
+{+}procedure FlushSection(aHandle:cardinal);
+var
+ size,i:integer;
+ sect:array [0..127] of AnsiChar;
+ ptr1,ptr:PAnsiChar;
+begin
+ if aHandle>=NumStorage then
+ exit;
+ with Storage^[aHandle] do
+ if SType then
+ begin
+ if INIBuffer=nil then
+ begin
+ mGetMem(INIBuffer,32768);
+ INIBuffer[0]:=#10;
+ SHandle:=Reset(SName);
+ if thandle(SHandle)=INVALID_HANDLE_VALUE then
+ INIBuffer[1]:=#0
+ else
+ begin
+ size:=FileSize(SHandle);
+ INIBuffer[size+1]:=#0;
+ BlockRead(SHandle,(INIBuffer+1)^,size);
+ CloseHandle(SHandle);
+ end;
+ SHandle:=ReWrite(SName);
+ end;
+ // construct section name
+ sect[0]:=#10;
+ sect[1]:='[';
+ size:=StrLen(Section);
+ move(Section,sect[2],size);
+ sect[size+2]:=']';
+ sect[size+3]:=#0;
+ // search section
+ ptr:=StrPos(INIBuffer,sect);
+ // delete section
+ if ptr<>nil then
+ begin
+ ptr1:=ptr;
+//!! inc(ptr);
+ while (ptr^<>#0) and ((ptr^<>#10) or ((ptr+1)^<>'[')) do inc(ptr);
+ if ptr^<>#0 then
+ StrCopy(ptr1,ptr+1)
+ else
+ ptr1^:=#0;
+ end;
+ // append section
+ if (Buffer<>nil) and (StrLen(Buffer)>0) then
+ begin
+ i:=StrLen(INIBuffer);
+ if INIBuffer[i-1]<>#10 then
+ begin
+ INIBuffer[i] :=#13;
+ INIBuffer[i+1]:=#10;
+ inc(i,2);
+ end;
+ StrCopy(INIBuffer+i,sect+1);
+ StrCat(INIBuffer,Buffer);
+ end;
+ mFreeMem(Buffer);
+ end;
+end;
+
+{+}procedure WriteFlag(aHandle:cardinal;param:PAnsiChar;value:integer);
+var
+ ptr:PAnsiChar;
+begin
+ if aHandle>=NumStorage then
+ exit;
+ with Storage^[aHandle] do
+ if SType then
+ begin
+ StrCat(Buffer,param);
+ ptr:=StrEnd(Buffer);
+ ptr^:='=';
+ (ptr+1)^:=CHR((value and 1)+ORD('0'));
+ inc(ptr,2);
+ ptr^ :=#13;
+ (ptr+1)^:=#10;
+ (ptr+2)^:=#0;
+ end
+ else
+ begin
+ StrCopy(Section+ParOffset,param);
+ DBWriteByte(0,SName,Section,value)
+ end;
+end;
+
+{+}procedure WriteInt(aHandle:cardinal;param:PAnsiChar;value:integer);
+var
+ ptr:PAnsiChar;
+begin
+ if aHandle>=NumStorage then
+ exit;
+ with Storage^[aHandle] do
+ if SType then
+ begin
+ StrCat(Buffer,param);
+ ptr:=StrEnd(Buffer);
+ ptr^:='=';
+ IntToStr(ptr+1,value);
+ ptr:=StrEnd(Buffer);
+ ptr^ :=#13;
+ (ptr+1)^:=#10;
+ (ptr+2)^:=#0;
+ end
+ else
+ begin
+ StrCopy(Section+ParOffset,param);
+ DBWriteDWord(0,SName,Section,value)
+ end;
+end;
+
+procedure WriteStrInt(aHandle:cardinal;param:PAnsiChar;value:pointer;wide:bool);
+var
+ buf:array [0..2047] of AnsiChar;
+ ptr:PAnsiChar;
+ lval:PAnsiChar;
+begin
+ if aHandle>=NumStorage then
+ exit;
+ with Storage^[aHandle] do
+ if SType then
+ begin
+ StrCat(Buffer,param);
+ ptr:=StrEnd(Buffer);
+ ptr^:='=';
+ inc(ptr);
+ if (value<>nil) then
+ begin
+ buf[0]:=#0;
+ if wide then
+ begin
+ if PWideChar(value)^<>#0 then
+ begin
+ WideToUTF8(value,lval);
+ StrCopy(buf,lval,SizeOf(buf)-1);
+ mFreeMem(lval);
+ end
+ end
+ else if PAnsiChar(value)^<>#0 then
+ StrCopy(buf,value,SizeOf(buf)-1);
+ if buf[0]<>#0 then
+ begin
+ Escape(buf);
+ StrCopy(ptr,buf);
+ ptr:=StrEnd(Buffer);
+ end;
+ end;
+ ptr^ :=#13;
+ (ptr+1)^:=#10;
+ (ptr+2)^:=#0;
+ end
+ else
+ begin
+ StrCopy(Section+ParOffset,param);
+ if wide then
+ DBWriteUnicode(0,SName,Section,value)
+ else
+ DBWriteString(0,SName,Section,value)
+ end;
+end;
+
+{+}procedure WriteStr(aHandle:cardinal;param:PAnsiChar;value:PWideChar);
+begin
+ WriteStrInt(aHandle,param,value,true);
+end;
+
+{+}procedure WriteAnsiStr(aHandle:cardinal;param:PAnsiChar;value:PAnsiChar);
+begin
+ WriteStrInt(aHandle,param,value,false);
+end;
+
+{+}function ReadFlag(aHandle:cardinal; param:PAnsiChar; default:integer):integer;
+begin
+ if aHandle>=NumStorage then
+ begin
+ result:=default;
+ exit;
+ end;
+ with Storage^[aHandle] do
+ if SType then
+ begin
+ result:=GetPrivateProfileIntA(Section,param,default,SName)
+ end
+ else
+ begin
+ StrCopy(Section+ParOffset,param);
+ result:=DBReadByte(0,SName,Section,default)
+ end;
+end;
+
+{+}function ReadInt(aHandle:cardinal; param:PAnsiChar; default:integer):integer;
+begin
+ if aHandle>=NumStorage then
+ begin
+ result:=default;
+ exit;
+ end;
+ with Storage^[aHandle] do
+ if SType then
+ begin
+ result:=GetPrivateProfileIntA(Section,param,default,SName)
+ end
+ else
+ begin
+ StrCopy(Section+ParOffset,param);
+ result:=DBReadDWord(0,SName,Section,default)
+ end;
+end;
+
+procedure ReadStrInt(aHandle:cardinal;var dst;param:PAnsiChar;default:pointer;wide:bool);
+
+ function EnumSettingsProc(const szSetting:PAnsiChar;lParam:LPARAM):int; cdecl;
+ var
+ p:pbrec;
+ i:integer;
+ begin
+ p:=pbrec(lparam);
+ if StrCmp(Storage^[p^.handle].Section,szSetting,Storage^[p^.handle].ParOffset)=0 then
+ begin
+ i:=StrLen(szSetting)+1;
+ move(szSetting^,p^.ptr^,i);
+ inc(p^.ptr,i);
+ end;
+ result:=0;
+ end;
+
+var
+ buf:array [0..4095] of AnsiChar;
+ p:brec;
+ ces:TDBCONTACTENUMSETTINGS;
+ def:PAnsiChar;
+ i:integer;
+begin
+ if aHandle>=NumStorage then
+ begin
+ if wide then
+ StrDupW(pWideChar(dst),pWideChar(default))
+ else
+ StrDup(PAnsiChar(dst),PAnsiChar(default));
+ exit;
+ end;
+ with Storage^[aHandle] do
+ if SType then
+ begin
+ if wide then
+ begin
+ if default=nil then
+ StrDup(def,'')
+ else
+ WideToUTF8(default,def);
+ end
+ else
+ begin
+ if default=nil then
+ def:=''
+ else
+ def:=default;
+ end;
+ i:=GetPrivateProfileStringA(Section,param,def,buf,4095,SName)+1;
+ mFreeMem(def);
+ if param<>nil then
+ begin
+ if buf[0]<>#0 then
+ begin
+ Unescape(buf);
+ if wide then
+ UTF8ToWide(buf,pWideChar(dst))
+ else
+ StrDup(PAnsiChar(dst),buf);
+ end
+ else
+ PAnsiChar(dst):=nil;
+ end
+ else //!! full section
+ begin
+ mGetMem(dst,i);
+ move(buf,PAnsiChar(dst)^,i);
+ buf[i-1]:=#0;
+ end;
+ end
+ else
+ begin
+ if param<>nil then
+ begin
+ StrCopy(Section+ParOffset,param);
+ if wide then
+ pWideChar(dst):=DBReadUnicode(0,SName,Section,pWideChar(default))
+ else
+ PAnsiChar(dst):=DBReadString(0,SName,Section,PAnsiChar(default));
+ end
+ else
+ begin
+ p.ptr:=@buf;
+ p.handle:=aHandle;
+ FillChar(buf,SizeOf(buf),0);
+ ces.pfnEnumProc:=@EnumSettingsProc;
+ ces.lParam :=lparam(@p);
+ ces.szModule :=SName;
+ ces.ofsSettings:=0;
+ PluginLink^.CallService(MS_DB_CONTACT_ENUMSETTINGS,0,lparam(@ces));
+ mGetMem(dst,p.ptr-PAnsiChar(@buf)+1);
+ move(buf,PAnsiChar(dst)^,p.ptr-PAnsiChar(@buf)+1);
+ end;
+ end;
+end;
+
+procedure ReadStr(aHandle:cardinal;var dst:PWideChar;param:PAnsiChar;default:PWideChar);
+begin
+ ReadStrInt(aHandle,dst,param,default,true);
+end;
+
+procedure ReadAnsiStr(aHandle:cardinal;var dst:PAnsiChar;param:PAnsiChar;default:PAnsiChar);
+begin
+ ReadStrInt(aHandle,dst,param,default,false);
+end;
+
+{*}procedure ClearSection(aHandle:cardinal);
+
+ function EnumSettingsProc(const szSetting:PAnsiChar;lParam:LPARAM):int; cdecl;
+ var
+ db:TDBCONTACTGETSETTING;
+ begin
+ with Storage^[lParam] do
+ begin
+ db.szModule:=SName;
+ StrCopy(Section+ParOffset,szSetting);
+ db.szSetting:=Section;
+ end;
+ PluginLink^.CallService(MS_DB_CONTACT_DELETESETTING,0,tlparam(@db));
+ result:=0;
+ end;
+
+var
+ ces:TDBCONTACTENUMSETTINGS;
+begin
+ if aHandle>=NumStorage then
+ exit;
+ with Storage^[aHandle] do
+ if SType then
+ WritePrivateProfileStringA(Section,nil,nil,SName)
+ else
+ begin
+ ces.pfnEnumProc:=@EnumSettingsProc;
+ ces.lParam :=aHandle;
+ ces.szModule :=SName;
+ ces.ofsSettings:=0;
+ PluginLink^.CallService(MS_DB_CONTACT_ENUMSETTINGS,0,lparam(@ces));
+ end;
+end;
+
+{*}procedure WriteSect(aHandle:cardinal;src:PAnsiChar);
+var
+ p:PAnsiChar;
+begin
+ if aHandle>=NumStorage then
+ exit;
+ with Storage^[aHandle] do
+ if SType then
+ WritePrivateProfileSectionA(Section,src,SName)
+ else
+ begin
+ ClearSection(aHandle);
+ while src^<>#0 do
+ begin
+ // write as strings
+ p:=src;
+ while src^<>'=' do inc(src);
+ inc(src);
+ DBWriteString(0,SName,p,src);
+ while src^<>#0 do inc(src);
+ inc(src);
+ end;
+ end;
+end;
+
+procedure ReadSect(aHandle:cardinal;var dst:PAnsiChar);
+
+ function EnumSettingsProc(const szSetting:PAnsiChar;lParam:LPARAM):int; cdecl;
+ var
+ dbv:TDBVariant;
+ i:integer;
+ p:pbrec;
+ buf:array [0..31] of AnsiChar;
+ begin
+ result:=1;
+
+ p:=pbrec(lparam);
+ if (DBReadSetting(0,Storage^[p^.handle].Section,szSetting,@dbv)=0) then
+ begin
+ i:=StrLen(szSetting);
+ move(szSetting^,p^.ptr^,i);
+ inc(p^.ptr,i);
+ p^.ptr^:='=';
+ case dbv._type of
+ DBVT_ASCIIZ: begin
+ if dbv.szVal.a<>nil then
+ begin
+ i:=StrLen(dbv.szVal.a)+1;
+ move(dbv.szVal.a^,(p^.ptr+1)^,i);
+ DBFreeVariant(@dbv);
+ end
+ end;
+ DBVT_BYTE,DBVT_WORD,DBVT_DWORD: begin
+ case dbv._type of
+ DBVT_BYTE : i:=dbv.bVal;
+ DBVT_WORD : i:=dbv.wVal;
+ DBVT_DWORD: i:=dbv.dVal;
+ end;
+ i:=StrLen(IntToStr(buf,i))+1;
+ move(buf,(p^.ptr+1)^,i);
+ end;
+ else
+ exit;
+ end;
+ inc(p^.ptr,i{+1});
+ end;
+ end;
+
+var
+ buf:array [0..16383] of AnsiChar;
+ p:brec;
+ ces:TDBCONTACTENUMSETTINGS;
+ i:integer;
+begin
+ if aHandle>=NumStorage then
+ begin
+ dst:=nil;
+ exit;
+ end;
+ with Storage^[aHandle] do
+ begin
+ if SType then
+ begin
+ i:=GetPrivateProfileSectionA(Section,buf,SizeOf(buf),SName)+1;
+ end
+ else
+ begin
+ p.ptr:=@buf;
+ p.handle:=aHandle;
+ FillChar(buf,SizeOf(buf),0);
+
+ ces.pfnEnumProc:=@EnumSettingsProc;
+ ces.lParam :=lparam(@p);
+ ces.szModule :=SName;
+ ces.ofsSettings:=0;
+ PluginLink^.CallService(MS_DB_CONTACT_ENUMSETTINGS,0,lparam(@ces));
+ i:=p.ptr-PAnsiChar(@buf)+1;
+ end;
+ mGetMem(dst,i);
+ move(buf,dst^,i);
+ buf[i-1]:=#0;
+ end;
+end;
+
+{+}procedure DeleteParam(aHandle:cardinal;param:PAnsiChar);
+var
+ db:TDBCONTACTGETSETTING;
+begin
+ if aHandle>=NumStorage then
+ exit;
+ with Storage^[aHandle] do
+ begin
+ if SType then
+ WritePrivateProfileStringA(Section,param,nil,SName)
+ else
+ begin
+ StrCopy(Section+ParOffset,param);
+ db.szModule :=SName;
+ db.szSetting:=Section;
+ PluginLink^.CallService(MS_DB_CONTACT_DELETESETTING,0,lparam(@db));
+ end;
+ end;
+end;
+
+end.
diff --git a/plugins/Utils.pas/old/mApiCardC.pas b/plugins/Utils.pas/old/mApiCardC.pas
new file mode 100644
index 0000000000..507bc79d79
--- /dev/null
+++ b/plugins/Utils.pas/old/mApiCardC.pas
@@ -0,0 +1,399 @@
+{service insertion code}
+unit mApiCardC;
+
+interface
+
+uses windows,messages;
+
+type
+ tmApiCard = class
+ private
+ function GetDescription:pAnsiChar;
+ function GetResultType :pAnsiChar;
+ procedure SetCurrentService(item:pAnsiChar);
+ public
+ constructor Create(fname:pAnsiChar; lparent:HWND=0);
+// procedure Free;
+ procedure FillList(combo:HWND; mode:integer=0);
+
+ function FillParams(wnd:HWND{;item:pAnsiChar};wparam:boolean):pAnsiChar;
+ procedure Show;//(item:pAnsiChar);
+
+ property Description:pAnsiChar read GetDescription;
+ property ResultType :pAnsiChar read GetResultType;
+ property Service :pAnsiChar write SetCurrentService;
+ property Event :pAnsiChar write SetCurrentService;
+ private
+ current: array [0..127] of AnsiChar;
+ IniFile: array [0..511] of AnsiChar;
+ parent,
+ HelpWindow:HWND;
+ isServiceHelp:boolean;
+
+ procedure Update(item:pAnsiChar=nil);
+ end;
+
+function CreateServiceCard(parent:HWND=0):tmApiCard;
+function CreateEventCard (parent:HWND=0):tmApiCard;
+
+implementation
+
+uses common,io,m_api,mirutils;
+
+{$r mApiCard.res}
+
+{$include i_card_const.inc}
+
+const
+ WM_UPDATEHELP = WM_USER+100;
+
+const
+ BufSize = 2048;
+
+const
+ ServiceHlpFile = 'plugins\services.ini';
+ EventsHlpFile = 'plugins\events.ini';
+{
+procedure tmApiCard.Free;
+begin
+end;
+}
+function tmApiCard.GetResultType:pAnsiChar;
+var
+ buf:array [0..2047] of AnsiChar;
+ p:pAnsiChar;
+begin
+ if INIFile[0]<>#0 then
+ begin
+ GetPrivateProfileStringA(@current,'return','',buf,SizeOf(buf),@INIFile);
+ p:=@buf;
+ while p^ in sWordOnly do inc(p);
+ p^:=#0;
+ StrDup(result,@buf);
+ end
+ else
+ result:=nil;
+end;
+
+function tmApiCard.GetDescription:pAnsiChar;
+var
+ buf:array [0..2047] of AnsiChar;
+begin
+ if INIFile[0]<>#0 then
+ begin
+ GetPrivateProfileStringA(@current,'descr','',buf,SizeOf(buf),@INIFile);
+ StrDup(result,@buf);
+ end
+ else
+ result:=nil;
+end;
+
+function tmApiCard.FillParams(wnd:HWND{;item:pAnsiChar};wparam:boolean):pAnsiChar;
+var
+ buf :array [0..2047] of AnsiChar;
+ bufw:array [0..2047] of WideChar;
+ j:integer;
+ p,pp,pc:PAnsiChar;
+ tmp:pWideChar;
+ paramname:pAnsiChar;
+begin
+ if INIFile[0]=#0 then
+ begin
+ result:=nil;
+ exit;
+ end;
+ if wparam then
+ paramname:='wparam'
+ else
+ paramname:='lparam';
+ GetPrivateProfileStringA(@current,paramname,'',buf,SizeOf(buf),@INIFile);
+ StrDup(result,@buf);
+ SendMessage(wnd,CB_RESETCONTENT,0,0);
+ if buf[0]<>#0 then
+ begin
+ p:=@buf;
+ GetMem(tmp,BufSize*SizeOf(WideChar));
+ repeat
+ pc:=StrScan(p,'|');
+ if pc<>nil then
+ pc^:=#0;
+
+ if (p^ in ['0'..'9']) or ((p^='-') and (p[1] in ['0'..'9'])) then
+ begin
+ j:=0;
+ pp:=p;
+ repeat
+ bufw[j]:=WideChar(pp^);
+ inc(j); inc(pp);
+ until (pp^=#0) or (pp^=' ');
+ if pp^<>#0 then
+ begin
+ bufw[j]:=' '; bufw[j+1]:='-'; bufw[j+2]:=' '; inc(j,3);
+ FastAnsitoWideBuf(pp+1,tmp);
+ StrCopyW(bufw+j,TranslateW(tmp));
+ SendMessageW(wnd,CB_ADDSTRING,0,lparam(@bufw));
+ end
+ else
+ SendMessageA(wnd,CB_ADDSTRING,0,lparam(p));
+ end
+ else
+ begin
+ FastAnsitoWideBuf(p,tmp);
+ SendMessageW(wnd,CB_ADDSTRING,0,lparam(TranslateW(tmp)));
+ if (p=@buf) and (lstrcmpia(p,'structure')=0) then
+ break;
+ end;
+ p:=pc+1;
+ until pc=nil;
+ FreeMem(tmp);
+ end;
+ SendMessage(wnd,CB_SETCURSEL,0,0);
+end;
+
+procedure tmApiCard.FillList(combo:hwnd; mode:integer=0);
+var
+ buf:array [0..8191] of AnsiChar;
+ tmpbuf:array [0..127] of AnsiChar;
+ p,pc:PAnsiChar;
+begin
+ if INIFile[0]<>#0 then
+ begin
+ SendMessage(combo,CB_RESETCONTENT,0,0);
+ buf[0]:=#0;
+ GetPrivateProfileSectionNamesA(@buf,SizeOf(buf),@INIFile); // sections
+ p:=@buf;
+ while p^<>#0 do
+ begin
+ case mode of
+ 1: begin // just constant name
+ GetPrivateProfileStringA(p,'alias','',tmpbuf,127,@INIFile);
+ pc:=@tmpbuf;
+ end;
+ 2: begin // value (name)
+ pc:=StrCopyE(tmpbuf,p);
+ pc^:=' '; inc(pc);
+ pc^:='('; inc(pc);
+ GetPrivateProfileStringA(p,'alias','',pc,63,@INIFile);
+ pc:=StrEnd(tmpbuf);
+ pc^:=')'; inc(pc);
+ pc^:=#0;
+ pc:=@tmpbuf;
+ end;
+ 3: begin // name 'value'
+ GetPrivateProfileStringA(p,'alias','',tmpbuf,127,@INIFile);
+ pc:=StrEnd(tmpbuf);
+ pc^:=' '; inc(pc);
+ pc^:=''''; inc(pc);
+ pc:=StrCopyE(pc,p);
+ pc^:=''''; inc(pc);
+ pc^:=#0;
+ pc:=@tmpbuf;
+ end;
+ else // just constant value
+ pc:=p;
+ end;
+ SendMessageA(combo,CB_ADDSTRING,0,lparam(pc));
+ while p^<>#0 do inc(p); inc(p);
+ end;
+ SendMessage(combo,CB_SETCURSEL,-1,0);
+ end;
+end;
+
+function ServiceHelpDlg(Dialog:HWnd;hMessage:uint;wParam:WPARAM;lParam:LPARAM):LRESULT; stdcall;
+var
+ buf,p:PAnsiChar;
+ tmp:PWideChar;
+ card:tmApiCard;
+begin
+ result:=0;
+ case hMessage of
+ WM_CLOSE: begin
+ card:=tmApiCard(GetWindowLongPtr(Dialog,GWLP_USERDATA{DWLP_USER}));
+ card.HelpWindow:=0;
+ DestroyWindow(Dialog); //??
+ end;
+
+ WM_INITDIALOG: begin
+ TranslateDialogDefault(Dialog);
+ result:=1;
+ end;
+
+ WM_COMMAND: begin
+ if (wParam shr 16)=BN_CLICKED then
+ begin
+ case loword(wParam) of
+ IDOK,IDCANCEL: begin
+ card:=tmApiCard(GetWindowLongPtr(Dialog,GWLP_USERDATA{DWLP_USER}));
+ card.HelpWindow:=0;
+ DestroyWindow(Dialog);
+ end;
+ end;
+ end;
+ end;
+
+ WM_UPDATEHELP: begin
+ with tmApiCard(lParam) do
+ begin
+ if (INIFile[0]<>#0) and (lParam<>0) then
+ begin
+ GetMem(buf,BufSize);
+ GetMem(tmp,BufSize*SizeOf(WideChar));
+ SetDlgItemTextA(Dialog,IDC_HLP_SERVICE,@current);
+
+ GetPrivateProfileStringA(@current,'alias','',buf,BufSize,@INIFile);
+ SetDlgItemTextA(Dialog,IDC_HLP_ALIAS,buf);
+
+ GetPrivateProfileStringA(@current,'return','Undefined',buf,BufSize,@INIFile);
+ p:=buf;
+ // skip result type
+ // while p^ in sWordOnly do inc(p); if (p<>@buf) and (p^<>#0) then inc(p);
+ FastAnsiToWideBuf(p,tmp);
+ SetDlgItemTextW(Dialog,IDC_HLP_RETURN,TranslateW(tmp));
+
+ GetPrivateProfileStringA(@current,'descr','Undefined',buf,BufSize,@INIFile);
+ FastAnsiToWideBuf(buf,tmp);
+ SetDlgItemTextW(Dialog,IDC_HLP_EFFECT,TranslateW(tmp));
+
+ GetPrivateProfileStringA(@current,'plugin','',buf,BufSize,@INIFile);
+ FastAnsiToWideBuf(buf,tmp);
+ SetDlgItemTextW(Dialog,IDC_HLP_PLUGIN,TranslateW(tmp));
+ // Parameters
+ GetPrivateProfileStringA(@current,'wparam','0',buf,BufSize,@INIFile);
+ if StrScan(buf,'|')<>nil then
+ begin
+ ShowWindow(GetDlgItem(Dialog,IDC_HLP_WPARAML),SW_SHOW);
+ ShowWindow(GetDlgItem(Dialog,IDC_HLP_WPARAM ),SW_HIDE);
+ FillParams(GetDlgItem(Dialog,IDC_HLP_WPARAML),true);
+ end
+ else
+ begin
+ ShowWindow(GetDlgItem(Dialog,IDC_HLP_WPARAML),SW_HIDE);
+ ShowWindow(GetDlgItem(Dialog,IDC_HLP_WPARAM ),SW_SHOW);
+ FastAnsiToWideBuf(buf,tmp);
+ SetDlgItemTextW(Dialog,IDC_HLP_WPARAM,TranslateW(tmp));
+ end;
+
+ GetPrivateProfileStringA(@current,'lparam','0',buf,BufSize,@INIFile);
+ if StrScan(buf,'|')<>nil then
+ begin
+ ShowWindow(GetDlgItem(Dialog,IDC_HLP_LPARAML),SW_SHOW);
+ ShowWindow(GetDlgItem(Dialog,IDC_HLP_LPARAM ),SW_HIDE);
+ FillParams(GetDlgItem(Dialog,IDC_HLP_LPARAML),false);
+ end
+ else
+ begin
+ ShowWindow(GetDlgItem(Dialog,IDC_HLP_LPARAML),SW_HIDE);
+ ShowWindow(GetDlgItem(Dialog,IDC_HLP_LPARAM ),SW_SHOW);
+ FastAnsiToWideBuf(buf,tmp);
+ SetDlgItemTextW(Dialog,IDC_HLP_LPARAM,TranslateW(tmp));
+ end;
+
+ FreeMem(tmp);
+ FreeMem(buf);
+ end
+ else
+ begin
+ SetDlgItemTextW(Dialog,IDC_HLP_SERVICE,nil);
+ SetDlgItemTextW(Dialog,IDC_HLP_ALIAS ,nil);
+ SetDlgItemTextW(Dialog,IDC_HLP_PLUGIN ,nil);
+ SetDlgItemTextW(Dialog,IDC_HLP_RETURN ,nil);
+ SetDlgItemTextW(Dialog,IDC_HLP_EFFECT ,nil);
+ SetDlgItemTextW(Dialog,IDC_HLP_WPARAM ,nil);
+ SetDlgItemTextW(Dialog,IDC_HLP_LPARAM ,nil);
+ SendDlgItemMessage(Dialog,IDC_HLP_WPARAML,CB_RESETCONTENT,0,0);
+ SendDlgItemMessage(Dialog,IDC_HLP_LPARAML,CB_RESETCONTENT,0,0);
+ ShowWindow(GetDlgItem(Dialog,IDC_HLP_WPARAML),SW_HIDE);
+ ShowWindow(GetDlgItem(Dialog,IDC_HLP_LPARAML),SW_HIDE);
+ end;
+ end;
+ end;
+ end;
+end;
+
+procedure tmApiCard.SetCurrentService(item:pAnsiChar);
+begin
+ StrCopy(@current,item);
+end;
+
+procedure tmApiCard.Update(item:pAnsiChar=nil);
+begin
+ SendMessage(HelpWindow,WM_UPDATEHELP,0,LPARAM(self));
+end;
+
+procedure tmApiCard.Show;
+var
+ note,
+ title:pWideChar;
+begin
+ if HelpWindow=0 then
+ begin
+ HelpWindow:=CreateDialogW(hInstance,'IDD_MAPIHELP',//MAKEINTRESOURCEW(IDD_HELP),
+ parent,@ServiceHelpDlg);
+ if HelpWindow<>0 then
+ begin
+ SetWindowLongPtr(HelpWindow,GWLP_USERDATA{DWLP_USER},LONG_PTR(Self));
+ if isServiceHelp then
+ begin
+ title:='Miranda service help';
+ note :='''<proto>'' in service name will be replaced by protocol name for contact handle in parameter';
+ end
+ else
+ begin
+ title:='Miranda event help';
+ note :='';
+ end;
+ SendMessageW(HelpWindow,WM_SETTEXT,0,LPARAM(title));
+
+ SendMessageW(GetDlgItem(HelpWindow,IDC_HLP_NOTE),WM_SETTEXT,0,LPARAM(TranslateW(Note)));
+ end;
+ end
+ else
+ begin
+{
+ if parent<>GetParent(HelpWindow) then
+ SetParent(HelpWindow,parent);
+}
+ end;
+// if title<>nil then
+// SendMessageW(HelpWindow,WM_SETTEXT,0,TranslateW(title));
+
+ Update(@current);
+end;
+
+constructor tmApiCard.Create(fname:pAnsiChar; lparent:HWND=0);
+begin
+ inherited Create;
+
+ StrCopy(@IniFile,fname);
+ current[0]:=#0;
+ HelpWindow:=0;
+
+ if fname<>nil then
+ begin
+ ConvertFileName(fname,@INIFile);
+ // PluginLink^.CallService(MS_UTILS_PATHTOABSOLUTE,
+ // dword(PAnsiChar(ServiceHlpFile)),dword(INIFile));
+ if GetFSize(pAnsiChar(@INIFile))=0 then
+ begin
+ INIFile[0]:=#0;
+ end;
+ parent:=lparent;
+ end;
+end;
+
+function CreateServiceCard(parent:HWND=0):tmApiCard;
+begin
+ result:=tmApiCard.Create(ServiceHlpFile,parent);
+ result.isServiceHelp:=true;
+end;
+
+function CreateEventCard(parent:HWND=0):tmApiCard;
+begin
+ result:=tmApiCard.Create(EventsHlpFile,parent);
+ result.isServiceHelp:=false;
+end;
+
+
+//initialization
+//finalization
+end.