diff options
Diffstat (limited to 'plugins/Utils.pas/old')
| -rw-r--r-- | plugins/Utils.pas/old/hotkeys.pas | 574 | ||||
| -rw-r--r-- | plugins/Utils.pas/old/ini.pas | 857 | ||||
| -rw-r--r-- | plugins/Utils.pas/old/mApiCardC.pas | 397 |
3 files changed, 0 insertions, 1828 deletions
diff --git a/plugins/Utils.pas/old/hotkeys.pas b/plugins/Utils.pas/old/hotkeys.pas deleted file mode 100644 index 32f6e201e5..0000000000 --- a/plugins/Utils.pas/old/hotkeys.pas +++ /dev/null @@ -1,574 +0,0 @@ -{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 deleted file mode 100644 index 8746b51c53..0000000000 --- a/plugins/Utils.pas/old/ini.pas +++ /dev/null @@ -1,857 +0,0 @@ -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 deleted file mode 100644 index 7c67443087..0000000000 --- a/plugins/Utils.pas/old/mApiCardC.pas +++ /dev/null @@ -1,397 +0,0 @@ -{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);
- 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.
|