diff options
Diffstat (limited to 'plugins/Utils.pas')
34 files changed, 15114 insertions, 0 deletions
diff --git a/plugins/Utils.pas/TextBlock.pas b/plugins/Utils.pas/TextBlock.pas new file mode 100644 index 0000000000..13535b832a --- /dev/null +++ b/plugins/Utils.pas/TextBlock.pas @@ -0,0 +1,335 @@ +unit TextBlock;
+
+interface
+
+uses KOL, windows;
+
+const
+ ppLeft = 0;
+ ppRight = 1;
+ //effects
+ effCut = 0;
+ effWrap = 1;
+ effRoll = 2;
+ effPong = 3;
+ effCenter = $100;
+
+type
+ pChunk = ^tChunk;
+ tChunk = record
+ _type:integer; // type
+ val :integer; // sign value or text length
+ txt :pWideChar; // text value pointer
+ add :integer; // offset for text effect
+ dir :integer; // ping-pong directon
+ end;
+ pChunkArray = ^tChunkArray;
+ tChunkArray = array [0..1000] of tChunk;
+
+type
+ pTextData = ^tTextData;
+ tTextData = record
+ // runtime data
+ UpdTimer :cardinal;
+ TextFont :HFONT;
+ NeedResize :Boolean;
+
+ // working data
+ TextChunk :pChunkArray;
+ Text :pWideChar; // for text chunks
+
+ TextColor :TCOLORREF;
+ BkColor :TCOLORREF;
+ TextLF :TLOGFONTW;
+
+ // options
+ TextEffect :dword;
+ RollStep :integer;
+ RollGap :integer;
+// RollTail :integer;
+ UpdInterval :cardinal;
+ end;
+
+const
+ MaxTxtScrollSpeed = 20;
+ awkTextPad = 4; // text block pad from frame border
+
+const
+ idx_effect = 0;
+ idx_rollstep = 1;
+ idx_rollgap = 2;
+ idx_timer = 3;
+ idx_txtcolor = 4;
+ idx_bkcolor = 5;
+ idx_font = 6;
+type
+ pTextBlock = ^tTextBlock;
+ tTextBlock = object(TControl)
+ private
+ procedure myCtrlResize(Sender: PObj);
+ procedure myTextPaint(Sender: PControl; DC: HDC);
+ procedure myMouseDown(Sender:PControl;var Mouse:TMouseEventData);
+
+ procedure ClearText;
+ function Split(src:pWideChar):pChunkArray;
+
+ procedure DrawChunks(dc:HDC;Chunk:pChunk;rc:TRECT;justpaint:boolean);
+ procedure DrawLines (dc:HDC;Chunk:pChunk;rc:TRECT;justpaint:boolean);
+
+ function GetEffect(idx:integer):integer;
+ procedure SetEffect(idx:integer;value:integer);
+
+ function GetText:pWideChar;
+ procedure SetText(value:pWideChar);
+
+ function GetFontData:TLOGFONTW;
+ procedure SetFontData(const value:TLOGFONTW);
+
+ public
+ procedure DrawText(DC: HDC; justpaint:boolean);
+
+ property Effects :integer index idx_effect read GetEffect write SetEffect;
+ property RollStep :integer index idx_rollstep read GetEffect write SetEffect;
+ property RollGap :integer index idx_rollgap read GetEffect write SetEffect;
+ property UpdateTime:integer index idx_timer read GetEffect write SetEffect;
+ property TextColor :integer index idx_txtcolor read GetEffect write SetEffect;
+ property BkColor :integer index idx_bkcolor read GetEffect write SetEffect;
+ property Font :integer index idx_font read GetEffect write SetEffect;
+
+ property FontData :TLOGFONTW read GetFontData write SetFontData;
+ property BlockText:pWideChar read GetText write SetText;
+ end;
+
+function MakeNewTextBlock(AOwner:PControl;BkColor:TCOLORREF):pTextBlock;
+
+implementation
+
+uses messages,common;
+
+{$include tb_chunk.inc}
+
+function tTextBlock.GetFontData:TLOGFONTW;
+begin
+ result:=pTextData(CustomData).TextLF;
+end;
+
+procedure tTextBlock.SetFontData(const value:TLOGFONTW);
+begin
+ move(value,pTextData(CustomData).TextLF,SizeOf(TLOGFONTW));
+end;
+
+function tTextBlock.GetEffect(idx:integer):integer;
+begin
+ with pTextData(CustomData)^ do
+ case idx of
+ idx_effect : result:=TextEffect;
+ idx_rollstep: result:=RollStep;
+ idx_rollgap : result:=RollGap;
+ idx_txtcolor: result:=TextColor;
+ idx_bkcolor : result:=BkColor;
+ idx_font : result:=0;
+ idx_timer : result:=UpdInterval;
+ else // it can't be really
+ result:=0;
+ end;
+end;
+
+procedure TimerProc(wnd:HWND;uMsg:uint;TB:pTextBlock;dwTime:dword); stdcall;
+var
+ DC:HDC;
+begin
+ DC:=GetDC(wnd);
+ TB.DrawText(DC,false);
+ ReleaseDC(wnd,DC);
+end;
+
+procedure tTextBlock.SetEffect(idx:integer;value:integer);
+var
+ DC:HDC;
+ OldFont:HFONT;
+begin
+ with pTextData(CustomData)^ do
+ case idx of
+ idx_effect : TextEffect :=value;
+ idx_rollstep: RollStep :=value;
+ idx_rollgap : RollGap :=value;
+ idx_txtcolor: TextColor :=value;
+ idx_bkcolor : BkColor :=value;
+ idx_font : begin
+ DC:=GetDC(0);
+ OldFont:=SelectObject(DC,value);
+ GetObject(GetCurrentObject(dc,OBJ_FONT),SizeOf(TLOGFONT),@TextLF);
+ SelectObject(DC,OldFont);
+ ReleaseDC(0,DC);
+ end;
+ idx_timer : begin
+ // stoptimer
+ if UpdTimer<>0 then
+ begin
+ KillTimer(0,UpdTimer);
+ UpdTimer:=0;
+ end;
+
+ UpdInterval:=value;
+ // starttimer
+ if UpdInterval>0 then
+ UpdTimer:=SetTimer(Self.GetWindowHandle,integer(@Self),(MaxTxtScrollSpeed+1-UpdInterval)*100,@TimerProc);
+ end;
+ end;
+end;
+
+procedure tTextBlock.ClearText;
+var
+ D:pTextData;
+begin
+ D:=CustomData;
+ if D.Text<>nil then
+ begin
+ DeleteChunks(D.TextChunk);
+ FreeMem(D.Text);
+ D.Text:=nil;
+ end;
+end;
+
+function tTextBlock.GetText:pWideChar;
+begin
+ result:=pTextData(CustomData)^.Text;
+end;
+
+procedure tTextBlock.SetText(value:pWideChar);
+var
+ D:pTextData;
+begin
+ D:=CustomData;
+ if (D.Text<>value) or
+ (StrCmpW(D.Text, value)<>0) then
+ begin
+ self.ClearText;
+ if (value<>nil) and (value^<>#0) then
+ begin
+ GetMem(D.Text,(StrLenW(value)+1)*SizeOf(WideChar));
+ WStrCopy(D.Text,value);
+ D.TextChunk:=Split(D.Text);
+
+ // start timer if was stopped
+ if (D.UpdTimer=0) and (D.UpdInterval>0) then
+ D.UpdTimer:=SetTimer(Self.GetWindowHandle,integer(@Self),
+ (MaxTxtScrollSpeed+1-D.UpdInterval)*100,@TimerProc);
+ end
+ else // stop timer for empty text
+ begin
+ if D.UpdTimer<>0 then
+ begin
+ KillTimer(0,D.UpdTimer);
+ D.UpdTimer:=0;
+ end;
+ end;
+ Invalidate;
+ end;
+end;
+
+procedure tTextBlock.DrawText(DC:HDC; justpaint:boolean);
+var
+ dst:TRECT;
+ D:pTextData;
+ MemDC:HDC;
+begin
+ D:=CustomData;
+ with D^ do
+ if TextChunk<>nil then
+ begin
+ CopyRect(dst,Self.BoundsRect);
+
+ MemDC:=CreateCompatibleDC(dc);
+ SetTextColor(MemDC,TextColor);
+ SelectObject(MemDC,CreateCompatibleBitmap(DC,dst.right,dst.bottom));
+ DeleteObject(SelectObject(MemDC,CreateFontIndirectW(D.TextLF)));
+
+ BitBlt(MemDC,dst.left,dst.top,dst.right-dst.left,dst.bottom-dst.top,
+ dc,dst.left,dst.top,SRCCOPY);
+
+ InflateRect(dst,-4,-2); // text padding from text block
+ DrawChunks(MemDC,@TextChunk[0],dst,justpaint); // i.e. only paint or roll
+ InflateRect(dst,4,2); // text padding from text block
+
+ BitBlt(dc,dst.left,dst.top,dst.right-dst.left,dst.bottom-dst.top,
+ MemDC,dst.left,dst.top,SRCCOPY);
+ DeleteDC(MemDC);
+ end;
+end;
+
+procedure tTextBlock.myTextPaint(Sender: PControl; DC: HDC);
+begin
+ DrawText(DC,true);
+end;
+
+procedure tTextBlock.myMouseDown(Sender:PControl;var Mouse:TMouseEventData);
+var
+ wnd:HWND;
+begin
+ wnd:=GetParent(GetParent(Sender.GetWindowHandle));
+ SendMessage(wnd,WM_SYSCOMMAND,
+ SC_MOVE or HTCAPTION,MAKELPARAM(Mouse.x,Mouse.y));
+end;
+
+// avoiding anchors problems
+procedure tTextBlock.myCtrlResize(Sender: PObj);
+var
+ tmp:integer;
+ D:pTextData;
+begin
+ D:=CustomData;
+ if D.NeedResize then
+ begin
+ D.NeedResize:=false;
+
+ tmp:=PControl(Sender).Parent.Width-2*awkTextPad;
+
+ if (PControl(Sender)^.Width)>tmp then
+ PControl(Sender)^.Width:=tmp;
+
+ D.NeedResize:=true;
+ end;
+end;
+
+procedure Destroy(dummy:PControl;sender:PObj);
+var
+ D:pTextData;
+begin
+ D:=PTextBlock(sender).CustomData;
+ if D.UpdTimer<>0 then
+ begin
+ KillTimer(0,D.UpdTimer);
+ D.UpdTimer:=0;
+ end;
+ PTextBlock(sender).ClearText;
+end;
+
+function MakeNewTextBlock(AOwner:PControl;BkColor:TCOLORREF):pTextBlock;
+var
+ D:pTextData;
+begin
+ result:=pTextBlock(NewPanel(AOwner,esNone));
+// result:=NewLabel(AOwner,'');
+// result:=NewLabelEffect(AOwner,'',0);
+ GetMem(D,SizeOf(tTextData));
+ FillChar(D^,SizeOf(tTextData),0);
+ result.CustomData :=D;
+ result.Transparent:=true;
+
+ result.SetSize(AOwner.Width-awkTextPad*2,40);
+ result.SetPosition(AOwner.Left+awkTextPad,awkTextPad);
+ result.Anchor(true,true,true,true);
+
+ result.OnResize :=result.myCtrlResize;
+ result.OnPaint :=result.myTextPaint;
+ result.OnMouseDown:=result.myMouseDown;
+ Result.OnDestroy:=TOnEvent(MakeMethod(nil,@Destroy));
+
+// result..InitFrame;
+ D.BkColor :=BkColor;
+ D.TextChunk :=nil;
+ D.NeedResize:=true;
+end;
+
+end.
diff --git a/plugins/Utils.pas/appcmdapi.pas b/plugins/Utils.pas/appcmdapi.pas new file mode 100644 index 0000000000..b316838ba3 --- /dev/null +++ b/plugins/Utils.pas/appcmdapi.pas @@ -0,0 +1,97 @@ +unit appcmdapi;
+interface
+
+uses windows;
+
+const
+ APPCOMMAND_BROWSER_BACKWARD = 1; // Navigate backward.
+ APPCOMMAND_BROWSER_FORWARD = 2; // Navigate forward.
+ APPCOMMAND_BROWSER_REFRESH = 3; // Refresh page.
+ APPCOMMAND_BROWSER_STOP = 4; // Stop download.
+ APPCOMMAND_BROWSER_SEARCH = 5; // Open search.
+ APPCOMMAND_BROWSER_FAVORITES = 6; // Open favorites.
+ APPCOMMAND_BROWSER_HOME = 7; // Navigate home.
+ APPCOMMAND_VOLUME_MUTE = 8; // Mute the volume.
+ APPCOMMAND_VOLUME_DOWN = 9; // Lower the volume.
+ APPCOMMAND_VOLUME_UP = 10; // Raise the volume
+ APPCOMMAND_MEDIA_NEXTTRACK = 11; // Go to next track.
+ APPCOMMAND_MEDIA_PREVIOUSTRACK = 12; // Go to previous track.
+ APPCOMMAND_MEDIA_STOP = 13; // Stop playback.
+ APPCOMMAND_MEDIA_PLAY_PAUSE = 14; // Play or pause playback. If there are discrete Play
+ // and Pause buttons, applications should take action
+ // on this command as well as APPCOMMAND_MEDIA_PLAY and
+ // APPCOMMAND_MEDIA_PAUSE.
+ APPCOMMAND_LAUNCH_MAIL = 15; // Open mail.
+ APPCOMMAND_LAUNCH_MEDIA_SELECT = 16; // Go to Media Select mode
+ APPCOMMAND_MEDIA_SELECT = APPCOMMAND_LAUNCH_MEDIA_SELECT;
+ APPCOMMAND_LAUNCH_APP1 = 17; // Start App1.
+ APPCOMMAND_LAUNCH_APP2 = 18; // Start App2.
+ APPCOMMAND_BASS_DOWN = 19; // Decrease the bass.
+ APPCOMMAND_BASS_BOOST = 20; // Toggle the bass boost on and off.
+ APPCOMMAND_BASS_UP = 21; // Increase the bass.
+ APPCOMMAND_TREBLE_DOWN = 22; // Decrease the treble.
+ APPCOMMAND_TREBLE_UP = 23; // Increase the treble.
+
+ APPCOMMAND_MICROPHONE_VOLUME_MUTE = 24; // Windows XP: Mute the microphone.
+ APPCOMMAND_MICROPHONE_VOLUME_DOWN = 25; // Windows XP: Decrease microphone volume.
+ APPCOMMAND_MICROPHONE_VOLUME_UP = 26; // Windows XP: Increase microphone volume.
+ APPCOMMAND_HELP = 27; // Windows XP: Open the Help dialog.
+ APPCOMMAND_FIND = 28; // Windows XP: Open the Find dialog.
+ APPCOMMAND_NEW = 29; // Windows XP: Create a new window.
+ APPCOMMAND_OPEN = 30; // Windows XP: Open a window.
+ APPCOMMAND_CLOSE = 31; // Windows XP: Close the window (not the application).
+ APPCOMMAND_SAVE = 32; // Windows XP: Save current document.
+ APPCOMMAND_PRINT = 33; // Windows XP: Print current document.
+ APPCOMMAND_UNDO = 34; // Windows XP: Undo last action.
+ APPCOMMAND_REDO = 35; // Windows XP: Redo last action.
+ APPCOMMAND_COPY = 36; // Windows XP: Copy the selection.
+ APPCOMMAND_CUT = 37; // Windows XP: Cut the selection.
+ APPCOMMAND_PASTE = 38; // Windows XP: Paste
+ APPCOMMAND_REPLY_TO_MAIL = 39; // Windows XP: Reply to a mail message.
+ APPCOMMAND_FORWARD_MAIL = 40; // Windows XP: Forward a mail message.
+ APPCOMMAND_SEND_MAIL = 41; // Windows XP: Send a mail message.
+ APPCOMMAND_SPELL_CHECK = 42; // Windows XP: Initiate a spell check.
+ APPCOMMAND_DICTATE_OR_COMMAND_CONTROL_TOGGLE = 43;
+ // Windows XP:Toggles between two modes of speech input: dictation and command/control
+ // (giving commands to an application or accessing menus).
+ APPCOMMAND_MIC_ON_OFF_TOGGLE = 44; // Windows XP: Toggle the microphone.
+ APPCOMMAND_CORRECTION_LIST = 45; // Windows XP: Brings up the correction list when
+ // a word is incorrectly identified during speech input.
+
+ APPCOMMAND_MEDIA_PLAY = 46; // Windows XP SP1: Begin playing at the current position.
+ // If already paused, it will resume. This is a direct
+ // PLAY command that has no state. If there are
+ // discrete Play and Pause buttons, applications should
+ // take action on this command as well as
+ // APPCOMMAND_MEDIA_PLAY_PAUSE.
+ APPCOMMAND_MEDIA_PAUSE = 47; // Windows XP SP1: Pause. If already paused, take no
+ // further action. This is a direct PAUSE command that
+ // has no state. If there are discrete Play and Pause
+ // buttons, applications should take action on this
+ // command as well as APPCOMMAND_MEDIA_PLAY_PAUSE.
+ APPCOMMAND_MEDIA_RECORD = 48; // Windows XP SP1: Begin recording the current stream.
+ APPCOMMAND_MEDIA_FAST_FORWARD = 49; // Windows XP SP1: Increase the speed of stream playback.
+ // This can be implemented in many ways, for example,
+ // using a fixed speed or toggling through a series of
+ // increasing speeds.
+ APPCOMMAND_MEDIA_REWIND = 50; // Windows XP SP1: Go backward in a stream at a higher
+ // rate of speed. This can be implemented in many ways,
+ // for example, using a fixed speed or toggling through
+ // a series of increasing speeds.
+ APPCOMMAND_MEDIA_CHANNEL_UP = 51; // Windows XP SP1: Increment the channel value.
+ APPCOMMAND_MEDIA_CHANNEL_DOWN = 52; // Windows XP SP1: Decrement the channel value.
+
+function SendMMCommand(wnd:HWND; cmd:integer):integer;
+
+implementation
+
+const
+ WM_APPCOMMAND = $0319;
+
+function SendMMCommand(wnd:HWND; cmd:integer):integer;
+begin
+// result:=ord(SendMessageW(wnd,WM_APPCOMMAND,wnd,cmd shl 16));
+ result:=ord(SendnotifyMessageW(wnd,WM_APPCOMMAND,wnd,cmd shl 16));
+end;
+
+end.
diff --git a/plugins/Utils.pas/base64.pas b/plugins/Utils.pas/base64.pas new file mode 100644 index 0000000000..1819efbbd5 --- /dev/null +++ b/plugins/Utils.pas/base64.pas @@ -0,0 +1,108 @@ +unit Base64;
+
+interface
+
+uses windows;
+
+{ Base64 encode and decode a string }
+function BASE64Encode(src:pByte;len:integer):PAnsiChar;
+function BASE64Decode(src:PAnsiChar;var dst:pByte):integer;
+
+{******************************************************************************}
+{******************************************************************************}
+implementation
+
+uses common;
+
+const
+ base64chars{:array [0..63] of AnsiChar}:PAnsiChar =
+ 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
+
+function BASE64Encode(src:pByte;len:integer):PAnsiChar;
+var
+ dst:PAnsiChar;
+begin
+ if (src=nil) or (len<=0) then
+ begin
+ result:=nil;
+ exit;
+ end;
+ mGetMem(result,((len*4+11) div (12*4))+1);
+ dst:=result;
+
+ while len>0 do
+ begin
+ dst^:=base64chars[src^ shr 2]; inc(dst);
+ if len=1 then
+ begin
+ dst^:=base64chars[(src^ and 3) shl 4]; inc(dst);
+ dst^:='='; inc(dst);
+ dst^:='='; inc(dst);
+ break;
+ end;
+ dst^:=base64chars[((src^ and 3) shl 4) or (pbyte(PAnsiChar(src)+1)^ shr 4)]; inc(dst); inc(src);
+ if len=2 then
+ begin
+ dst^:=base64chars[(src^ and $F) shl 2]; inc(dst);
+ dst^:='='; inc(dst);
+ break;
+ end;
+ dst^:=base64chars[((src^ and $F) shl 2) or (pbyte(PAnsiChar(src)+1)^ shr 6)]; inc(dst); inc(src);
+ dst^:=base64chars[src^ and $3F]; inc(dst); inc(src);
+ dec(len,3);
+ end;
+ dst^:=#0;
+end;
+
+function Base64CharToInt(c:AnsiChar):byte;
+begin
+ case c of
+ 'A'..'Z': result:=ord(c)-ord('A');
+ 'a'..'z': result:=ord(c)-ord('a')+26;
+ '0'..'9': result:=ord(c)-ord('0')+52;
+ '+': result:=62;
+ '/': result:=63;
+ '=': result:=64;
+ else
+ result:=255;
+ end;
+end;
+
+function BASE64Decode(src:PAnsiChar;var dst:pByte):integer;
+var
+ slen:integer;
+ ptr:pByte;
+ b1,b2,b3,b4:byte;
+begin
+ if (src=nil) or (src^=#0) then
+ begin
+ result:=0;
+ dst:=nil;
+ exit;
+ end;
+ pAnsiChar(ptr):=src;
+ while ptr^<>0 do inc(ptr);
+ slen:=PAnsiChar(ptr)-src;
+ mGetMem(ptr,(slen*3) div 4);
+ dst:=ptr;
+ result:=0;
+ while slen>0 do
+ begin
+ b1:=Base64CharToInt(src^); inc(src);
+ b2:=Base64CharToInt(src^); inc(src);
+ b3:=Base64CharToInt(src^); inc(src);
+ b4:=Base64CharToInt(src^); inc(src);
+ dec(slen,4);
+ if (b1=255) or (b1=64) or (b2=255) or (b2=64) or (b3=255) or (b4=255) then
+ break;
+ ptr^:=(b1 shl 2) or (b2 shr 4); inc(ptr); inc(result);
+ if b3=64 then
+ break;
+ ptr^:=(b2 shl 4) or (b3 shr 2); inc(ptr); inc(result);
+ if b4=64 then
+ break;
+ ptr^:=b4 or (b3 shl 6); inc(ptr); inc(result);
+ end;
+end;
+
+end.
diff --git a/plugins/Utils.pas/cbex.pas b/plugins/Utils.pas/cbex.pas new file mode 100644 index 0000000000..1c683dd3b8 --- /dev/null +++ b/plugins/Utils.pas/cbex.pas @@ -0,0 +1,79 @@ +unit CBEx;
+interface
+
+uses windows;
+
+// build combobox with xstatus icons and names
+
+function AddCBEx(wnd:HWND;proto:PAnsiChar):HWND;
+
+implementation
+
+uses messages,commctrl,m_api,common;
+
+function AddCBEx(wnd:HWND;proto:PAnsiChar):HWND;
+var
+ cbei:TCOMBOBOXEXITEMW;
+ total,cnt:integer;
+ il:HIMAGELIST;
+ icon:HICON;
+ buf,buf1:array [0..127] of AnsiChar;
+ b:array [0..63] of WideChar;
+ ics:TICQ_CUSTOM_STATUS;
+begin
+ result:=0;
+ SendMessage(wnd,CB_RESETCONTENT,0,0);
+ StrCopy(StrCopyE(buf,proto),PS_ICQ_GETCUSTOMSTATUSICON);
+
+ if ServiceExists(@buf)=0 then
+ exit;
+
+ il:=ImageList_Create(16,16,ILC_COLOR32 or ILC_MASK,0,1);
+ if il=0 then exit;
+
+ cnt:=0;
+ StrCopy(StrCopyE(buf1,proto),PS_ICQ_GETCUSTOMSTATUSEX);
+
+ cbei.mask:=CBEIF_IMAGE or CBEIF_SELECTEDIMAGE or CBEIF_TEXT; //!!
+ ics.cbSize :=SizEOf(ics);
+ ics.flags :=CSSF_STATUSES_COUNT;
+ ics.szName.w:=@b;
+ ics.wParam :=@total;
+ CallService(buf1,0,lParam(@ics));
+ ics.flags :=CSSF_DEFAULT_NAME or CSSF_MASK_NAME or CSSF_UNICODE;
+
+ while cnt<=total do
+ begin
+ if cnt=0 then
+ begin
+ ImageList_AddIcon(il,CallService(MS_SKIN_LOADICON,SKINICON_OTHER_SMALLDOT,0));
+ cbei.pszText:=TranslateW('None');
+ end
+ else
+ begin
+ icon:=CallService(@buf,cnt,LR_SHARED);
+ if icon=0 then break;
+ if ImageList_AddIcon(il,icon)=-1 then break;
+ ics.wParam:=@cnt;
+ CallService(@buf1,0,lparam(@ics));
+ cbei.pszText:=TranslateW(@b);
+ end;
+ cbei.iItem :=cnt;
+ cbei.iImage :=cnt;
+ cbei.iSelectedImage:=cnt;
+ if SendMessageW(wnd,CBEM_INSERTITEMW,0,lparam(@cbei))=-1 then break;
+ inc(cnt);
+// DestroyIcon(icon);
+ end;
+
+ if cnt=0 then
+ ImageList_Destroy(il)
+ else
+ begin
+ ImageList_Destroy(SendMessage(wnd,CBEM_SETIMAGELIST,0,il));
+ SendMessage(wnd,CB_SETCURSEL,0,0);
+ result:=wnd;
+ end;
+end;
+
+end.
diff --git a/plugins/Utils.pas/common.pas b/plugins/Utils.pas/common.pas new file mode 100644 index 0000000000..88df058957 --- /dev/null +++ b/plugins/Utils.pas/common.pas @@ -0,0 +1,2409 @@ +{$INCLUDE compilers.inc}
+{$IFDEF Miranda}
+ {.$DEFINE Use_MMI}
+{$ENDIF}
+unit common;
+
+interface
+
+uses
+windows
+{$IFDEF Miranda}
+,m_api
+{$ENDIF}
+;
+
+procedure ShowDump(ptr:pbyte;len:integer);
+
+Const {- Character sets -}
+ sBinNum = ['0'..'1'];
+ sOctNum = ['0'..'7'];
+ sNum = ['0'..'9'];
+ sHexNum = ['0'..'9','A'..'F','a'..'f'];
+ sWord = ['0'..'9','A'..'Z','a'..'z','_',#128..#255];
+ sIdFirst = ['A'..'Z','a'..'z','_'];
+ sLatWord = ['0'..'9','A'..'Z','a'..'z','_'];
+ sWordOnly = ['A'..'Z','a'..'z'];
+ sSpace = [#9,' '];
+ sEmpty = [#9,#10,#13,' '];
+
+const
+ HexDigitChrLo: array [0..15] of AnsiChar = ('0','1','2','3','4','5','6','7',
+ '8','9','a','b','c','d','e','f');
+
+ HexDigitChr : array [0..15] of AnsiChar = ('0','1','2','3','4','5','6','7',
+ '8','9','A','B','C','D','E','F');
+
+const
+ mimecnt = 5;
+ mimes:array [0..mimecnt-1] of record
+ mime:PAnsiChar;
+ ext:array [0..3] of AnsiChar
+ end = (
+ (mime:'image/gif' ; ext:'GIF'),
+ (mime:'image/jpg' ; ext:'JPG'),
+ (mime:'image/jpeg'; ext:'JPG'),
+ (mime:'image/png' ; ext:'PNG'),
+ (mime:'image/bmp' ; ext:'BMP')
+);
+
+var
+ IsW2K,
+ IsVista,
+ IsAnsi:boolean;
+
+const
+ CP_UNICODE = 1200;
+ CP_REVERSEBOM = 65534;
+const
+ SIGN_UNICODE = $FEFF;
+ SIGN_REVERSEBOM = $FFFE;
+ SIGN_UTF8 = $BFBBEF;
+
+function BSwap(value:dword):dword;
+
+function Hash(s:pointer; len:integer{const Seed: LongWord=$9747b28c}): LongWord;
+
+function Encode(dst,src:pAnsiChar):PAnsiChar;
+function Decode(dst,src:pAnsiChar):PAnsiChar;
+function GetTextFormat(Buffer:pByte;sz:cardinal):integer;
+
+function IIF(cond:bool;ret1,ret2:integer ):integer; overload;
+function IIF(cond:bool;ret1,ret2:PAnsiChar):PAnsiChar; overload;
+function IIF(cond:bool;ret1,ret2:pWideChar):pWideChar; overload;
+function IIF(cond:bool;ret1,ret2:Extended ):Extended; overload;
+function IIF(cond:bool;ret1,ret2:tDateTime):tDateTime; overload;
+function IIF(cond:bool;ret1,ret2:pointer ):pointer; overload;
+function IIF(cond:bool;const ret1,ret2:string):string; overload;
+{$IFNDEF DELPHI_7_UP}
+function IIF(cond:bool;ret1,ret2:variant ):variant; overload;
+{$ENDIF}
+
+function GetImageType (buf:pByte;mime:PAnsiChar=nil):dword;
+function GetImageTypeW(buf:pByte;mime:PWideChar=nil):int64;
+
+procedure CopyToClipboard(txt:pointer; Ansi:bool);
+function PasteFromClipboard(Ansi:boolean;cp:dword=CP_ACP):pointer;
+
+function mGetMem (var dst;size:integer):pointer;
+procedure mFreeMem(var ptr);
+function mReallocMem(var dst; size:integer):pointer;
+
+// String processing
+function WideToCombo(src:PWideChar;var dst;cp:integer=CP_ACP):integer;
+
+function ChangeUnicode(str:PWideChar):PWideChar;
+function UTF8Len(src:PAnsiChar):integer;
+function WideToAnsi(src:PWideChar;var dst:PAnsiChar;cp:dword=CP_ACP):PAnsiChar;
+function AnsiToWide(src:PAnsiChar;var dst:PWideChar;cp:dword=CP_ACP):PWideChar;
+function AnsiToUTF8(src:PAnsiChar;var dst:PAnsiChar;cp:dword=CP_ACP):PAnsiChar;
+function UTF8ToAnsi(src:PAnsiChar;var dst:PAnsiChar;cp:dword=CP_ACP):PAnsiChar;
+function UTF8ToWide(src:PAnsiChar;var dst:PWideChar;len:cardinal=cardinal(-1)):PWideChar;
+function WideToUTF8(src:PWideChar;var dst:PAnsiChar):PAnsiChar;
+
+function CharWideToUTF8(src:WideChar;var dst:pAnsiChar):integer;
+function CharUTF8ToWide(src:pAnsiChar;pin:pinteger=nil):WideChar;
+function CharUTF8Len(src:pAnsiChar):integer;
+
+function FastWideToAnsiBuf(src:PWideChar;dst:PAnsiChar;len:cardinal=cardinal(-1)):PAnsiChar;
+function FastAnsiToWideBuf(src:PAnsiChar;dst:PWideChar;len:cardinal=cardinal(-1)):PWideChar;
+function FastWideToAnsi (src:PWideChar;var dst:PAnsiChar):PAnsiChar;
+function FastAnsiToWide (src:PAnsiChar;var dst:PWideChar):PWideChar;
+
+function UnEscape(buf:PAnsiChar):PAnsiChar;
+function Escape (buf:PAnsiChar):PAnsiChar;
+
+// ----- base strings functions -----
+function StrDup (var dst:PAnsiChar;src:PAnsiChar;len:cardinal=0):PAnsiChar;
+function StrDupW(var dst:PWideChar;src:PWideChar;len:cardinal=0):PWideChar;
+function StrDelete (aStr:PAnsiChar;pos,len:cardinal):PAnsiChar;
+function StrDeleteW(aStr:PWideChar;pos,len:cardinal):PWideChar;
+function StrInsert (substr,src:PAnsiChar;pos:cardinal):PAnsiChar;
+function StrInsertW(substr,src:PWideChar;pos:cardinal):PWideChar;
+function StrReplace (src,SubStr,NewStr:PAnsiChar):PAnsiChar;
+function StrReplaceW(src,SubStr,NewStr:pWideChar):PWideChar;
+function CharReplace (dst:pAnsiChar;old,new:AnsiChar):PAnsiChar;
+function CharReplaceW(dst:pWideChar;old,new:WideChar):PWideChar;
+function StrCmp (a,b:PAnsiChar;n:cardinal=0):integer;
+function StrCmpW(a,b:PWideChar;n:cardinal=0):integer;
+function StrEnd (const a:PAnsiChar):PAnsiChar;
+function StrEndW(const a:PWideChar):PWideChar;
+function StrScan (src:PAnsiChar;c:AnsiChar):PAnsiChar;
+function StrScanW(src:PWideChar;c:WideChar):PWideChar;
+function StrRScan (src:PAnsiChar;c:AnsiChar):PAnsiChar;
+function StrRScanW(src:PWideChar;c:WideChar):PWideChar;
+function StrLen (Str: PAnsiChar): Cardinal;
+function StrLenW(Str: PWideChar): Cardinal;
+function StrCat (Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar;
+function StrCatW(Dest: PWideChar; const Source: PWideChar): PWideChar;
+function StrCatE (Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar;
+function StrCatEW(Dest: PWideChar; const Source: PWideChar): PWideChar;
+function StrCopyE (dst:PAnsiChar;src:PAnsiChar;len:cardinal=0):PAnsiChar;
+function StrCopyEW(dst:PWideChar;src:PWideChar;len:cardinal=0):PWideChar;
+function StrCopy (dst:PAnsiChar;src:PAnsiChar;len:cardinal=0):PAnsiChar;
+function StrCopyW(dst:PWideChar;src:PWideChar;len:cardinal=0):PWideChar;
+function StrPos (const aStr, aSubStr: PAnsiChar): PAnsiChar;
+function StrPosW(const aStr, aSubStr: PWideChar): PWideChar;
+function StrIndex (const aStr, aSubStr: PAnsiChar):integer;
+function StrIndexW(const aStr, aSubStr: PWideChar):integer;
+
+procedure FillWord(var buf;count:cardinal;value:word); register;
+function CompareMem(P1, P2: Pointer; Length: Integer): Boolean;
+
+function Min(a,b:integer):integer;
+function Max(a,b:integer):integer;
+
+function Timestamp(Year,Month,Day:cardinal;Hour:cardinal=0;Minute:cardinal=0;Sec:cardinal=0):dword;
+function GetCurrentTime:dword;
+
+function TimeToInt(stime:PAnsiChar):integer; overload;
+function TimeToInt(stime:PWideChar):integer; overload;
+function IntToTime(dst:pWideChar;time:integer):pWideChar; overload;
+function IntToTime(dst:PAnsiChar;time:integer):PAnsiChar; overload;
+
+{
+ filesize to string conversion
+ value - filelength
+ divider - 1=byte; 1024=kbyte; 1024*1024 - Mbyte
+ prec - numbers after point (1-3)
+ post - 0=none
+ 1=(small)' bytes','kb','mb'
+ 2=(mix) ' Bytes','Kb','Mb'
+ 3=(caps) '' ,'KB','MB'
+ postfix calculated from 'divider' value
+}
+function IntToK(dst:pWideChar;value,divider,prec,post:integer):pWideChar;
+
+// string conversion
+function IntToHex(dst:pWideChar;Value:int64;Digits:integer=0):pWideChar; overload;
+function IntToHex(dst:PAnsiChar;Value:int64;Digits:integer=0):PAnsiChar; overload;
+function IntToStr(dst:pWideChar;Value:int64;Digits:integer=0):pWideChar; overload;
+function IntToStr(dst:PAnsiChar;Value:int64;Digits:integer=0):PAnsiChar; overload;
+function StrToInt(src:pWideChar):int64; overload;
+function StrToInt(src:PAnsiChar):int64; overload;
+function HexToInt(src:pWideChar;len:cardinal=$FFFF):int64; overload;
+function HexToInt(src:PAnsiChar;len:cardinal=$FFFF):int64; overload;
+
+// filename work
+function ChangeExt (src,ext:PAnsiChar):PAnsiChar;
+function ChangeExtW(src,ext:PWideChar):PWideChar;
+function Extract (s:PAnsiChar;name:Boolean=true):PAnsiChar;
+function ExtractW(s:pWideChar;name:Boolean=true):pWideChar;
+function GetExt(fname,dst:pWideChar;maxlen:dword=100):pWideChar; overload;
+function GetExt(fname,dst:PAnsiChar;maxlen:dword=100):PAnsiChar; overload;
+
+procedure UpperCase(src:pWideChar);
+procedure LowerCase(src:pWideChar);
+function GetPairChar(ch:AnsiChar):AnsiChar; overload;
+function GetPairChar(ch:WideChar):WideChar; overload;
+
+type
+ tSortProc = function (First,Second:integer):integer;
+ {0=equ; 1=1st>2nd; -1=1st<2nd }
+procedure ShellSort(size:integer;Compare,Swap:tSortProc);
+
+function isPathAbsolute(path:pWideChar):boolean; overload;
+function isPathAbsolute(path:PAnsiChar):boolean; overload;
+
+implementation
+
+// Murmur 2.0
+function Hash(s:pointer; len:integer{const Seed: LongWord=$9747b28c}): LongWord;
+var
+ hash: LongWord;
+ k: LongWord;
+ tmp,data: pByte;
+const
+ // 'm' and 'r' are mixing constants generated offline.
+ // They're not really 'magic', they just happen to work well.
+ m = $5bd1e995;
+ r = 24;
+begin
+ //The default seed, $9747b28c, is from the original C library
+
+ // Initialize the hash to a 'random' value
+ hash := {seed xor }len;
+
+ // Mix 4 bytes at a time into the hash
+ data := s;
+
+ while(len >= 4) do
+ begin
+ k := PLongWord(data)^;
+
+ k := k*m;
+ k := k xor (k shr r);
+ k := k*m;
+
+ hash := hash*m;
+ hash := hash xor k;
+
+ inc(data,4);
+ dec(len,4);
+ end;
+
+ // Handle the last few bytes of the input array
+ if len = 3 then
+ begin
+ tmp:=data;
+ inc(tmp,2);
+ hash := hash xor (LongWord(tmp^) shl 16);
+ end;
+ if len >= 2 then
+ begin
+ tmp:=data;
+ inc(tmp);
+ hash := hash xor (LongWord(tmp^) shl 8);
+ end;
+ if len >= 1 then
+ begin
+ hash := hash xor (LongWord(data^));
+ hash := hash * m;
+ end;
+
+ // Do a few final mixes of the hash to ensure the last few
+ // bytes are well-incorporated.
+ hash := hash xor (hash shr 13);
+ hash := hash * m;
+ hash := hash xor (hash shr 15);
+
+ Result := hash;
+end;
+
+function BSwap(value:dword):dword;
+ {$IFNDEF WIN64}
+begin
+ asm
+ mov eax,value
+ bswap eax
+ mov result,eax
+ end;
+ {$ELSE}
+begin
+ result:=((value and $000000FF) shl 6) +
+ ((value and $0000FF00) shl 2) +
+ ((value and $00FF0000) shr 2) +
+ ((value and $FF000000) shr 6);
+ {$ENDIF}
+end;
+
+function Encode(dst,src:pAnsiChar):PAnsiChar;
+begin
+ while src^<>#0 do
+ begin
+ if not (src^ in [' ','%','+','&','?',#128..#255]) then
+ dst^:=src^
+ else
+ begin
+ dst^:='%'; inc(dst);
+ dst^:=HexDigitChr[ord(src^) shr 4]; inc(dst);
+ dst^:=HexDigitChr[ord(src^) and $0F];
+ end;
+ inc(src);
+ inc(dst);
+ end;
+ dst^:=#0;
+ result:=dst;
+end;
+
+function Decode(dst,src:pAnsiChar):PAnsiChar;
+begin
+ while (src^<>#0) and (src^<>'&') do
+ begin
+ if (src^='%') and ((src+1)^ in sHexNum) and ((src+2)^ in sHexNum) then
+ begin
+ inc(src);
+ dst^:=AnsiChar(HexToInt(src,2));
+ inc(src);
+ end
+ else
+ dst^:=src^;
+ inc(dst);
+ inc(src);
+ end;
+ dst^:=#0;
+ result:=dst;
+end;
+
+const
+ IS_TEXT_UNICODE_ASCII16 = $1;
+ IS_TEXT_UNICODE_REVERSE_ASCII16 = $10;
+ IS_TEXT_UNICODE_STATISTICS = $2;
+ IS_TEXT_UNICODE_REVERSE_STATISTICS = $20;
+ IS_TEXT_UNICODE_CONTROLS = $4;
+ IS_TEXT_UNICODE_REVERSE_CONTROLS = $40;
+ IS_TEXT_UNICODE_SIGNATURE = $8;
+ IS_TEXT_UNICODE_REVERSE_SIGNATURE = $80;
+ IS_TEXT_UNICODE_ILLEGAL_CHARS = $100;
+ IS_TEXT_UNICODE_ODD_LENGTH = $200;
+ IS_TEXT_UNICODE_DBCS_LEADBYTE = $400;
+ IS_TEXT_UNICODE_NULL_BYTES = $1000;
+ IS_TEXT_UNICODE_UNICODE_MASK = $F;
+ IS_TEXT_UNICODE_REVERSE_MASK = $F0;
+ IS_TEXT_UNICODE_NOT_UNICODE_MASK = $F00;
+ IS_TEXT_UNICODE_NOT_ASCII_MASK = $F000;
+
+function IsTextUTF8(Buffer:pbyte;Length:integer):boolean;
+var
+ Ascii:boolean;
+ Octets:cardinal;
+ c:byte;
+begin
+ Ascii:=true;
+ Octets:=0;
+
+ if Length=0 then
+ Length:=-1;
+ repeat
+ if (Length=0) or (Buffer^=0) then
+ break;
+ dec(Length);
+ c:=Buffer^;
+ if (c and $80)<>0 then
+ Ascii:=false;
+ if Octets<>0 then
+ begin
+ if (c and $C0)<>$80 then
+ begin
+ result:=false;
+ exit;
+ end;
+ dec(Octets);
+ end
+ else
+ begin
+ if (c and $80)<>0 then
+ begin
+ while (c and $80)<>0 do
+ begin
+ c:=c shl 1;
+ inc(Octets);
+ end;
+ dec(Octets);
+ if Octets=0 then
+ begin
+ result:=false;
+ exit;
+ end;
+ end
+ end;
+ inc(Buffer);
+ until false;
+ result:= not ((Octets>0) or Ascii);
+end;
+
+function GetTextFormat(Buffer:pByte;sz:cardinal):integer;
+var
+ test:integer;
+begin
+ result:=-1;
+
+ if sz>=2 then
+ begin
+ if pword (Buffer)^ =SIGN_UNICODE then result := CP_UNICODE
+ else if pword (Buffer)^ =SIGN_REVERSEBOM then result := CP_REVERSEBOM
+ else if (sz>=4) and
+ ((pdword(Buffer)^ and $00FFFFFF)=SIGN_UTF8) then result := CP_UTF8;
+ end;
+
+ if result<0 then
+ begin
+ test:=
+ IS_TEXT_UNICODE_STATISTICS or
+ IS_TEXT_UNICODE_REVERSE_STATISTICS or
+ IS_TEXT_UNICODE_CONTROLS or
+ IS_TEXT_UNICODE_REVERSE_CONTROLS or
+ IS_TEXT_UNICODE_ILLEGAL_CHARS or
+ IS_TEXT_UNICODE_ODD_LENGTH or
+ IS_TEXT_UNICODE_NULL_BYTES;
+
+ if not odd(sz) and IsTextUnicode(Buffer,sz,@test) then
+ begin
+ if (test and (IS_TEXT_UNICODE_ODD_LENGTH or IS_TEXT_UNICODE_ILLEGAL_CHARS))=0 then
+ begin
+ if (test and (IS_TEXT_UNICODE_NULL_BYTES or
+ IS_TEXT_UNICODE_CONTROLS or
+ IS_TEXT_UNICODE_REVERSE_CONTROLS))<>0 then
+ begin
+ if (test and (IS_TEXT_UNICODE_CONTROLS or
+ IS_TEXT_UNICODE_STATISTICS))<>0 then
+ result:=CP_UNICODE
+ else if (test and (IS_TEXT_UNICODE_REVERSE_CONTROLS or
+ IS_TEXT_UNICODE_REVERSE_STATISTICS))<>0 then
+ result:=CP_REVERSEBOM;
+ end
+ end
+ end
+ else if IsTextUTF8(Buffer,sz) then
+ result:=CP_UTF8
+ else
+ result:=CP_ACP;
+ end;
+end;
+
+function IIF(cond:bool;ret1,ret2:integer):integer; overload;
+begin
+ if cond then result:=ret1 else result:=ret2;
+end;
+function IIF(cond:bool;ret1,ret2:PAnsiChar):PAnsiChar; overload;
+begin
+ if cond then result:=ret1 else result:=ret2;
+end;
+function IIF(cond:bool;ret1,ret2:pWideChar):pWideChar; overload;
+begin
+ if cond then result:=ret1 else result:=ret2;
+end;
+function IIF(cond:bool;ret1,ret2:Extended):Extended; overload;
+begin
+ if cond then result:=ret1 else result:=ret2;
+end;
+function IIF(cond:bool;ret1,ret2:tDateTime):tDateTime; overload;
+begin
+ if cond then result:=ret1 else result:=ret2;
+end;
+function IIF(cond:bool;ret1,ret2:pointer):pointer; overload;
+begin
+ if cond then result:=ret1 else result:=ret2;
+end;
+function IIF(cond:bool;const ret1,ret2:string):string; overload;
+begin
+ if cond then result:=ret1 else result:=ret2;
+end;
+{$IFNDEF DELPHI_7_UP}
+function IIF(cond:bool;ret1,ret2:variant):variant; overload;
+begin
+ if cond then result:=ret1 else result:=ret2;
+end;
+{$ENDIF}
+
+function GetImageType(buf:pByte;mime:PAnsiChar=nil):dword;
+var
+ i:integer;
+begin
+ result:=0;
+ if (mime<>nil) and (mime^<>#0) then
+ begin
+ for i:=0 to mimecnt-1 do
+ begin
+ if {lstrcmpia}StrCmp(mime,mimes[i].mime)=0 then
+ begin
+ result:=dword(mimes[i].ext);
+ exit;
+ end;
+ end;
+ end
+ else if buf<>nil then
+ begin
+ if (pdword(buf)^ and $F0FFFFFF)=$E0FFD8FF then result:=$0047504A // 'JPG'
+ else if pdword(buf)^=$38464947 then result:=$00464947 // 'GIF'
+ else if pdword(buf)^=$474E5089 then result:=$00474E50 // 'PNG'
+ else if pword (buf)^=$4D42 then result:=$00504D42 // 'BMP'
+ end;
+end;
+
+function GetImageTypeW(buf:pByte;mime:PWideChar=nil):int64;
+var
+ i:integer;
+ lmime:array [0..63] of AnsiChar;
+begin
+ result:=0;
+ if (mime<>nil) and (mime^<>#0) then
+ begin
+ FastWideToAnsiBuf(mime,lmime);
+ for i:=0 to mimecnt-1 do
+ begin
+ if {lstrcmpia}StrCmp(lmime,mimes[i].mime)=0 then
+ begin
+// result:=dword(mimes[i].ext);
+ FastAnsiToWideBuf(mimes[i].ext,PWideChar(@result));
+ exit;
+ end;
+ end;
+ end
+ else if buf<>nil then
+ begin
+ if (pdword(buf)^ and $F0FFFFFF)=$E0FFD8FF then result:=$000000470050004A // 'JPG'
+ else if pdword(buf)^=$38464947 then result:=$0000004600490047 // 'GIF'
+ else if pdword(buf)^=$474E5089 then result:=$00000047004E0050 // 'PNG'
+ else if pword (buf)^=$4D42 then result:=$00000050004D0042 // 'BMP'
+ end;
+end;
+
+procedure CopyToClipboard(txt:pointer; Ansi:bool);
+var
+ s:pointer;
+ fh:THANDLE;
+begin
+ if pointer(txt)=nil then
+ exit;
+ if Ansi then
+ begin
+ if PAnsiChar(txt)^=#0 then exit
+ end
+ else
+ if PWideChar(txt)^=#0 then exit;
+
+ if OpenClipboard(0) then
+ begin
+ if Ansi then
+ begin
+ fh:=GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE,(StrLen(PAnsiChar(txt))+1));
+ s:=GlobalLock(fh);
+ StrCopy(s,PAnsiChar(txt));
+ end
+ else
+ begin
+ fh:=GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE,
+ (StrLenW(PWideChar(txt))+1)*SizeOf(WideChar));
+ s:=GlobalLock(fh);
+ StrCopyW(s,PWideChar(txt));
+ end;
+ GlobalUnlock(fh);
+ EmptyClipboard;
+ if Ansi then
+ SetClipboardData(CF_TEXT,fh)
+ else
+ SetClipboardData(CF_UNICODETEXT,fh);
+ CloseClipboard;
+ end;
+end;
+
+function PasteFromClipboard(Ansi:boolean;cp:dword=CP_ACP):pointer;
+var
+ p:pWideChar;
+ fh:tHandle;
+begin
+ result:=nil;
+ if OpenClipboard(0) then
+ begin
+ if not Ansi then
+ begin
+ fh:=GetClipboardData(CF_UNICODETEXT);
+ if fh<>0 then
+ begin
+ p:=GlobalLock(fh);
+ StrDupW(pWideChar(result),p);
+ end
+ else
+ begin
+ fh:=GetClipboardData(CF_TEXT);
+ if fh<>0 then
+ begin
+ p:=GlobalLock(fh);
+ AnsiToWide(PAnsiChar(p),pWideChar(result),cp);
+ end;
+ end;
+ end
+ else
+ begin
+ fh:=GetClipboardData(CF_TEXT);
+ if fh<>0 then
+ begin
+ p:=GlobalLock(fh);
+ StrDup(PAnsiChar(result),PAnsiChar(p));
+ end;
+ end;
+ if fh<>0 then
+ GlobalUnlock(fh);
+ CloseClipboard;
+ end
+end;
+
+procedure CheckSystem;
+var
+ ovi:TOSVersionInfo;
+begin
+ ovi.dwOSVersionInfoSize:=SizeOf(TOSVersionInfo);
+ GetVersionEx(ovi);
+//VER_PLATFORM_WIN32_NT for 2KXP
+ with ovi do
+ begin
+ IsAnsi :=dwPlatformId=VER_PLATFORM_WIN32_WINDOWS;
+ IsW2K :=(dwMajorVersion=5) and (dwMinorVersion=0);
+ IsVista:=(dwMajorVersion=6) and (dwMinorVersion=0);
+ end;
+end;
+
+// --------- string conversion ----------
+
+function WideToCombo(src:PWideChar;var dst;cp:integer=CP_ACP):integer;
+var
+ pc:PAnsiChar;
+ i,j:Cardinal;
+begin
+ WideToAnsi(src,pc,cp);
+ j:=StrLen(pc)+1;
+ i:=j+(StrLenW(src)+1)*SizeOf(WideChar);
+ mGetMem(PAnsiChar(dst),i);
+ StrCopy(PAnsiChar(dst),pc);
+ mFreeMem(pc);
+ StrCopyW(pWideChar(PAnsiChar(dst)+j),src);
+ result:=i;
+end;
+
+function ChangeUnicode(str:PWideChar):PWideChar;
+var
+ i,len:integer;
+begin
+ result:=str;
+ if (str=nil) or (str^=#0) then
+ exit;
+ if (word(str^)=$FFFE) or (word(str^)=$FEFF) then
+ begin
+ len:=StrLenW(str);
+ if word(str^)=$FFFE then
+ begin
+ i:=len-1;
+ while i>0 do // str^<>#0
+ begin
+ pword(str)^:=swap(pword(str)^);
+ inc(str);
+ dec(i);
+ end;
+ end;
+ move((result+1)^,result^,len*SizeOf(WideChar));
+ end;
+end;
+
+function WideToAnsi(src:PWideChar;var dst:PAnsiChar; cp:dword=CP_ACP):PAnsiChar;
+var
+ len,l:integer;
+begin
+ if (src=nil) or (src^=#0) then
+ begin
+ mGetMem(result,SizeOf(AnsiChar));
+ result^:=#0;
+ end
+ else
+ begin
+ l:=StrLenW(src);
+ len:=WideCharToMultiByte(cp,0,src,l,NIL,0,NIL,NIL)+1;
+ mGetMem(result,len);
+ FillChar(result^,len,0);
+ WideCharToMultiByte(cp,0,src,l,result,len,NIL,NIL);
+ end;
+ dst:=result;
+end;
+
+function AnsiToWide(src:PAnsiChar;var dst:PWideChar; cp:dword=CP_ACP):PWideChar;
+var
+ len,l:integer;
+begin
+ if (src=nil) or (src^=#0) then
+ begin
+ mGetMem(result,SizeOf(WideChar));
+ result^:=#0;
+ end
+ else
+ begin
+ l:=StrLen(src);
+ len:=MultiByteToWideChar(cp,0,src,l,NIL,0)+1;
+ mGetMem(result,len*SizeOf(WideChar));
+ FillChar(result^,len*SizeOf(WideChar),0);
+ MultiByteToWideChar(cp,0,src,l,result,len);
+ end;
+ dst:=result;
+end;
+
+function AnsiToUTF8(src:PAnsiChar;var dst:PAnsiChar;cp:dword=CP_ACP):PAnsiChar;
+var
+ tmp:PWideChar;
+begin
+ AnsiToWide(src,tmp,cp);
+ result:=WideToUTF8(tmp,dst);
+ mFreeMem(tmp);
+end;
+
+function UTF8Len(src:PAnsiChar):integer; // w/o zero
+begin
+ result:=0;
+ if src<>nil then
+ begin
+ if (pdword(src)^ and $00FFFFFF)=SIGN_UTF8 then
+ inc(src,3);
+ while src^<>#0 do
+ begin
+ if (ord(src^) and $80)=0 then
+ else if (ord(src^) and $E0)=$E0 then
+ inc(src,2)
+ else
+ inc(src);
+ inc(result);
+ inc(src);
+ end;
+ end;
+end;
+
+function CalcUTF8Len(src:pWideChar):integer;
+begin
+ result:=0;
+ if src<>nil then
+ begin
+ while src^<>#0 do
+ begin
+ if src^<#$0080 then
+ else if src^<#$0800 then
+ inc(result)
+ else
+ inc(result,2);
+ inc(src);
+ inc(result);
+ end;
+ end;
+end;
+
+function CharWideToUTF8(src:WideChar;var dst:pAnsiChar):integer;
+begin
+ if src<#$0080 then
+ begin
+ dst^:=AnsiChar(src);
+ result:=1;
+ end
+ else if src<#$0800 then
+ begin
+ dst^:=AnsiChar($C0 or (ord(src) shr 6));
+ inc(dst);
+ dst^:=AnsiChar($80 or (ord(src) and $3F));
+ result:=2;
+ end
+ else
+ begin
+ dst^:=AnsiChar($E0 or (ord(src) shr 12));
+ inc(dst);
+ dst^:=AnsiChar($80 or ((ord(src) shr 6) and $3F));
+ inc(dst);
+ dst^:=AnsiChar($80 or (ord(src) and $3F));
+ result:=3;
+ end;
+ inc(dst); dst^:=#0;
+end;
+
+function CharUTF8ToWide(src:pAnsiChar;pin:pinteger=nil):WideChar;
+var
+ cnt:integer;
+ w:word;
+begin
+ if ord(src^)<$80 then
+ begin
+ w:=ord(src^);
+ cnt:=1;
+ end
+ else if (ord(src^) and $E0)=$E0 then
+ begin
+ w:=(ord(src^) and $1F) shl 12;
+ inc(src);
+ w:=w or (((ord(src^))and $3F) shl 6);
+ inc(src);
+ w:=w or (ord(src^) and $3F);
+ cnt:=3;
+ end
+ else
+ begin
+ w:=(ord(src^) and $3F) shl 6;
+ inc(src);
+ w:=w or (ord(src^) and $3F);
+ cnt:=2;
+ end;
+ if pin<>nil then
+ pin^:=cnt;
+ result:=WideChar(w);
+end;
+
+function CharUTF8Len(src:pAnsiChar):integer;
+begin
+{!!}
+ if (ord(src^) and $80)=0 then
+ result:=1
+ else if (ord(src^) and $E0)=$E0 then
+ result:=3
+ else
+ result:=2;
+{}
+end;
+
+function UTF8ToWide(src:PAnsiChar; var dst:PWideChar; len:cardinal=cardinal(-1)):PWideChar;
+var
+ w:word;
+ p:PWideChar;
+begin
+ mGetMem(dst,(UTF8Len(src)+1)*SizeOf(WideChar));
+ p:=dst;
+ if src<>nil then
+ begin
+ if (pdword(src)^ and $00FFFFFF)=SIGN_UTF8 then
+ inc(src,3);
+ while (src^<>#0) and (len>0) do
+ begin
+ if ord(src^)<$80 then
+ w:=ord(src^)
+ else if (ord(src^) and $E0)=$E0 then
+ begin
+ w:=(ord(src^) and $1F) shl 12;
+ inc(src); dec(len);
+ w:=w or (((ord(src^))and $3F) shl 6);
+ inc(src); dec(len);
+ w:=w or (ord(src^) and $3F);
+ end
+ else
+ begin
+ w:=(ord(src^) and $3F) shl 6;
+ inc(src); dec(len);
+ w:=w or (ord(src^) and $3F);
+ end;
+ p^:=WideChar(w);
+ inc(p);
+ inc(src); dec(len);
+ end;
+ end;
+ p^:=#0;
+ result:=dst;
+end;
+
+function UTF8ToAnsi(src:PAnsiChar;var dst:PAnsiChar;cp:dword=CP_ACP):PAnsiChar;
+var
+ tmp:pWideChar;
+begin
+ UTF8ToWide(src,tmp);
+ result:=WideToAnsi(tmp,dst,cp);
+ mFreeMem(tmp);
+end;
+
+function WidetoUTF8(src:PWideChar; var dst:PAnsiChar):PAnsiChar;
+var
+ p:PAnsiChar;
+begin
+ mGetMem(dst,CalcUTF8Len(src)+1);
+ p:=dst;
+ if src<>nil then
+ begin
+ while src^<>#0 do
+ begin
+ if src^<#$0080 then
+ p^:=AnsiChar(src^)
+ else if src^<#$0800 then
+ begin
+ p^:=AnsiChar($C0 or (ord(src^) shr 6));
+ inc(p);
+ p^:=AnsiChar($80 or (ord(src^) and $3F));
+ end
+ else
+ begin
+ p^:=AnsiChar($E0 or (ord(src^) shr 12));
+ inc(p);
+ p^:=AnsiChar($80 or ((ord(src^) shr 6) and $3F));
+ inc(p);
+ p^:=AnsiChar($80 or (ord(src^) and $3F));
+ end;
+ inc(p);
+ inc(src);
+ end;
+ end;
+ p^:=#0;
+ result:=dst;
+end;
+
+procedure FillWord(var buf;count:cardinal;value:word); register;
+{$IFNDEF WIN64}assembler;
+{
+ PUSH EDI
+ MOV EDI, ECX // Move Value To Write
+ MOV ECX, EDX // Move Number to ECX for countdown
+ MOV EDX, EAX // Move over buffer
+ MOV EAX, EDI // Value to Write needs to be here
+ MOV EDI, EDX // Pointer to Buffer[0]
+ REP STOSW
+ POP EDI
+}
+asm
+ push edi
+ mov edi,buf // destination
+ mov ax,value // value
+ mov ecx,count // count
+ rep stosw
+ pop edi
+{
+ push edi
+ mov edi,eax // destination
+ mov ax,cx // value
+ mov ecx,edx // count
+ rep stosw
+ pop edi
+}
+end;
+{$ELSE}
+var
+ ptr:pword;
+ i:integer;
+begin
+ ptr:=pword(@buf);
+ for i:=0 to count-1 do
+ begin
+ ptr^:=value;
+ inc(ptr);
+ end;
+end;
+{$ENDIF}
+// from SysUtils
+{ Delphi 7.0
+function CompareMem(P1, P2: Pointer; Length: Integer): Boolean; assembler;
+asm
+ PUSH ESI
+ PUSH EDI
+ MOV ESI,P1
+ MOV EDI,P2
+ MOV EDX,ECX
+ XOR EAX,EAX
+ AND EDX,3
+ SAR ECX,2
+ JS @@1 // Negative Length implies identity.
+ REPE CMPSD
+ JNE @@2
+ MOV ECX,EDX
+ REPE CMPSB
+ JNE @@2
+@@1: INC EAX
+@@2: POP EDI
+ POP ESI
+end;
+}
+{$IFNDEF WIN64}
+// Delphi 2009 realization
+function CompareMem(P1, P2: Pointer; Length: Integer): Boolean; assembler;
+asm
+ add eax, ecx
+ add edx, ecx
+ xor ecx, -1
+ add eax, -8
+ add edx, -8
+ add ecx, 9
+ push ebx
+ jg @Dword
+ mov ebx, [eax+ecx]
+ cmp ebx, [edx+ecx]
+ jne @Ret0
+ lea ebx, [eax+ecx]
+ add ecx, 4
+ and ebx, 3
+ sub ecx, ebx
+ jg @Dword
+@DwordLoop:
+ mov ebx, [eax+ecx]
+ cmp ebx, [edx+ecx]
+ jne @Ret0
+ mov ebx, [eax+ecx+4]
+ cmp ebx, [edx+ecx+4]
+ jne @Ret0
+ add ecx, 8
+ jg @Dword
+ mov ebx, [eax+ecx]
+ cmp ebx, [edx+ecx]
+ jne @Ret0
+ mov ebx, [eax+ecx+4]
+ cmp ebx, [edx+ecx+4]
+ jne @Ret0
+ add ecx, 8
+ jle @DwordLoop
+@Dword:
+ cmp ecx, 4
+ jg @Word
+ mov ebx, [eax+ecx]
+ cmp ebx, [edx+ecx]
+ jne @Ret0
+ add ecx, 4
+@Word:
+ cmp ecx, 6
+ jg @Byte
+ movzx ebx, word ptr [eax+ecx]
+ cmp bx, [edx+ecx]
+ jne @Ret0
+ add ecx, 2
+@Byte:
+ cmp ecx, 7
+ jg @Ret1
+ movzx ebx, byte ptr [eax+7]
+ cmp bl, [edx+7]
+ jne @Ret0
+@Ret1:
+ mov eax, 1
+ pop ebx
+ ret
+@Ret0:
+ xor eax, eax
+ pop ebx
+end;
+{$ELSE}
+function CompareMem(P1, P2: Pointer; Length: Integer): Boolean;
+ {$IFNDEF COMPILER_16_UP}
+begin
+ result:=CompareByte(P1,P2,Length)=0;
+ {$ELSE}
+var
+ i:integer;
+begin
+ for i:=0 to Length-1 do
+ begin
+ if pByte(p1)^<>pbyte(p2)^ then
+ begin
+ result:=false;
+ exit;
+ end;
+ inc(pbyte(p1));
+ inc(pbyte(p2));
+ end;
+ result:=true;
+ {$ENDIF}
+end;
+{$ENDIF}
+
+function Min(a,b:integer):integer;
+begin
+ if a>b then
+ result:=b
+ else
+ result:=a;
+end;
+
+function Max(a,b:integer):integer;
+begin
+ if a<b then
+ result:=b
+ else
+ result:=a;
+end;
+
+function mGetMem(var dst;size:integer):pointer;
+begin
+{$IFDEF Use_MMI}
+ pointer(dst):=mir_alloc(size)
+{$ELSE}
+ GetMem(pointer(dst),size);
+{$ENDIF}
+ result:=pointer(dst);
+end;
+
+procedure mFreeMem(var ptr);
+begin
+ if pointer(ptr)<>nil then
+ begin
+{$IFDEF UseMMI}
+ mir_free(pointer(ptr))
+{$ELSE}
+ FreeMem(pointer(ptr));
+{$ENDIF}
+ Pointer(ptr):=nil;
+ end;
+end;
+
+function mReallocMem(var dst; size:integer):pointer;
+begin
+{$IFDEF Use_MMI}
+ pointer(dst):=mir_realloc(pointer(dst),size)
+{$ELSE}
+ ReallocMem(pointer(dst),size);
+{$ENDIF}
+ result:=pointer(dst);
+end;
+
+function UnEscape(buf:PAnsiChar):PAnsiChar;
+begin
+ if (buf<>nil) and (buf^<>#0) then
+ begin
+ StrReplace(buf,PAnsiChar(#$7F'n'),PAnsiChar(#$0D#$0A));
+ StrReplace(buf,PAnsiChar(#$7F't'),PAnsiChar(#$09));
+ end;
+ result:=buf;
+end;
+
+function Escape(buf:PAnsiChar):PAnsiChar;
+var
+ i:integer;
+begin
+ i:=StrLen(buf);
+ if i<>0 then
+ begin
+ Move(buf^,(buf+1)^,i+1);
+ buf^:=#39;
+ (buf+i+1)^:=#39;
+ (buf+i+2)^:=#0;
+ StrReplace(buf,#$0D#$0A,#$7F'n');
+ StrReplace(buf,#$09,#$7F't');
+ end;
+ result:=buf;
+end;
+
+procedure ShellSort(size:integer;Compare,Swap:tSortProc);
+var
+ i,j,gap:longint;
+begin
+ gap:=size shr 1;
+ while gap>0 do
+ begin
+ for i:=gap to size-1 do
+ begin
+ j:=i-gap;
+ while (j>=0) and (Compare(j,UInt(j+gap))>0) do
+ begin
+ Swap(j,UInt(j+gap));
+ dec(j,gap);
+ end;
+ end;
+ gap:=gap shr 1;
+ end;
+end;
+
+const
+ Posts:array [0..8] of PWideChar =
+ (' bytes',' Bytes','','kb','Kb','KB','mb','Mb','MB');
+
+function IntToK(dst:pWidechar;value,divider,prec,post:integer):pWidechar;
+var
+ tmp:integer;
+ p:pWideChar;
+ ls:array [0..4] of WideChar;
+begin
+ result:=dst;
+ IntToStr(dst,value div divider);
+ if divider=1 then prec:=0;
+ while dst^<>#0 do inc(dst);
+ if prec<>0 then
+ begin
+ if prec=1 then prec:=10
+ else if prec=2 then prec:=100
+ else {if prec=3 then} prec:=1000;
+ tmp:=round(frac(value*1.0/divider)*prec);
+ dst^:='.'; inc(dst);
+ IntToStr(ls,tmp);
+ p:=ls;
+ while p^<>#0 do
+ begin
+ dst^:=p^; inc(dst); inc(p);
+ end;
+ dst^:=#0;
+ end;
+ if post<>0 then
+ begin
+ if divider=1 then
+ StrCatW(dst,Posts[post-1])
+ else
+ begin
+ if divider=1024 then tmp:=1
+ else {if divider=1024*1024 then} tmp:=2;
+ p:=Posts[tmp*3+post-1];
+ dst^:=p[0]; inc(dst);
+ dst^:=p[1]; inc(dst);
+ dst^:=#0;
+ end;
+ end;
+end;
+
+// ----- base string functions -----
+function StrDup(var dst:PAnsiChar;src:PAnsiChar;len:cardinal=0):PAnsiChar;
+var
+ l:cardinal;
+ p:pAnsiChar;
+begin
+ if (src=nil) or (src^=#0) then
+ dst:=nil
+ else
+ begin
+ if len=0 then
+ len:=high(cardinal);
+ p:=src;
+ l:=len;
+ while (p^<>#0) and (l>0) do
+ begin
+ inc(p); dec(l);
+ end;
+ l:=p-src;
+
+ mGetMem(dst,l+1);
+ move(src^, dst^,l);
+ dst[l]:=#0;
+ end;
+ result:=dst;
+end;
+
+function StrDupW(var dst:PWideChar;src:PWideChar;len:cardinal=0):PWideChar;
+var
+ l:cardinal;
+ p:pWideChar;
+begin
+ if (src=nil) or (src^=#0) then
+ dst:=nil
+ else
+ begin
+ if len=0 then
+ len:=high(cardinal);
+ p:=src;
+ l:=len;
+ while (p^<>#0) and (l>0) do
+ begin
+ inc(p); dec(l);
+ end;
+ l:=p-src;
+ mGetMem(dst,(l+1)*SizeOf(WideChar));
+ move(src^, dst^,l*SizeOf(WideChar));
+ dst[l]:=#0;
+ end;
+ result:=dst;
+end;
+
+function StrCopyE(dst:PAnsiChar;src:PAnsiChar;len:cardinal=0):PAnsiChar;
+var
+ l:cardinal;
+ p:pAnsiChar;
+begin
+ if dst<>nil then
+ begin
+ if (src=nil) or (src^=#0) then
+ dst^:=#0
+ else
+ begin
+ if len=0 then
+ len:=high(cardinal);
+ p:=src;
+ l:=len;
+ while (p^<>#0) and (l>0) do
+ begin
+ inc(p); dec(l);
+ end;
+ l:=p-src;
+ move(src^, dst^,l);
+ inc(dst,l);
+ dst^:=#0;
+ end;
+ end;
+ result:=dst;
+end;
+
+function StrCopyEW(dst:PWideChar;src:PWideChar;len:cardinal=0):PWideChar;
+var
+ l:cardinal;
+ p:pWideChar;
+begin
+ if dst<>nil then
+ begin
+ if (src=nil) or (src^=#0) then
+ dst^:=#0
+ else
+ begin
+ if len=0 then
+ len:=high(cardinal);
+ p:=src;
+ l:=len;
+ while (p^<>#0) and (l>0) do
+ begin
+ inc(p); dec(l);
+ end;
+ l:=p-src;
+ move(src^, dst^,l*SizeOf(WideChar));
+ inc(dst,l);
+ dst^:=#0;
+ end;
+ end;
+ result:=dst;
+end;
+
+function StrCopy(dst:PAnsiChar;src:PAnsiChar;len:cardinal=0):PAnsiChar;
+var
+ l:cardinal;
+ p:pAnsiChar;
+begin
+ if dst<>nil then
+ begin
+ if (src=nil) or (src^=#0) then
+ dst^:=#0
+ else
+ begin
+ if len=0 then
+ len:=high(cardinal);
+ p:=src;
+ l:=len;
+ while (p^<>#0) and (l>0) do
+ begin
+ inc(p); dec(l);
+ end;
+ l:=p-src;
+ move(src^, dst^,l);
+ dst[l]:=#0;
+ end;
+ end;
+ result:=dst;
+end;
+
+function StrCopyW(dst:PWideChar;src:PWideChar;len:cardinal=0):PWideChar;
+var
+ l:cardinal;
+ p:pWideChar;
+begin
+ if dst<>nil then
+ begin
+ if (src=nil) or (src^=#0) then
+ dst^:=#0
+ else
+ begin
+ if len=0 then
+ len:=high(cardinal);
+ p:=src;
+ l:=len;
+ while (p^<>#0) and (l>0) do
+ begin
+ inc(p); dec(l);
+ end;
+ l:=p-src;
+ move(src^, dst^,l*SizeOf(WideChar));
+ dst[l]:=#0;
+ end;
+ end;
+ result:=dst;
+end;
+
+function StrDelete(aStr:PAnsiChar;pos,len:cardinal):PAnsiChar;
+var
+ i:cardinal;
+begin
+ if len>0 then
+ begin
+ i:=StrLen(aStr);
+ if pos<i then
+ begin
+ if (pos+len)>i then
+ len:=i-pos;
+ StrCopy(aStr+pos,aStr+pos+len);
+ end;
+ end;
+ result:=aStr;
+end;
+
+function StrDeleteW(aStr:PWideChar;pos,len:cardinal):PWideChar;
+var
+ i:cardinal;
+begin
+ if len>0 then
+ begin
+ i:=StrLenW(aStr);
+ if pos<i then
+ begin
+ if (pos+len)>i then
+ len:=i-pos;
+ StrCopyW(aStr+pos,aStr+pos+len);
+ end;
+ end;
+ result:=aStr;
+end;
+
+function StrInsert(substr,src:PAnsiChar;pos:cardinal):PAnsiChar;
+var
+ i:cardinal;
+ p:PAnsiChar;
+begin
+ i:=StrLen(substr);
+ if i<>0 then
+ begin
+ p:=src+pos;
+ move(p^,(p+i)^,StrLen(src)-pos+1);
+ move(substr^,p^,i);
+ end;
+ result:=src;
+end;
+
+function StrInsertW(substr,src:PWideChar;pos:cardinal):PWideChar;
+var
+ i:cardinal;
+ p:PWideChar;
+begin
+ i:=StrLenW(substr);
+ if i<>0 then
+ begin
+ p:=src+pos;
+ move(p^,(p+i)^,(StrLenW(src)-pos+1)*SizeOf(PWideChar));
+ move(substr^,p^,i*SizeOf(WideChar));
+ end;
+ result:=src;
+end;
+
+function StrReplace(src,SubStr,NewStr:PAnsiChar):PAnsiChar;
+var
+ i,j,l:integer;
+ k:integer;
+ p:PAnsiChar;
+begin
+ result:=src;
+ p:=StrPos(src,SubStr);
+ if p=nil then exit;
+ i:=StrLen(SubStr);
+ j:=StrLen(NewStr);
+ l:=i-j;
+ repeat
+ if j=0 then
+ StrCopy(p,p+i)
+ else
+ begin
+ k:=StrLen(p)+1;
+ if l>0 then
+ move((p+l)^,p^,k-l)
+ else if l<>0 then
+ move(p^,(p-l)^,k);
+ move(NewStr^,p^,j); {new characters}
+ inc(p,j);
+ end;
+ p:=StrPos(p,SubStr);
+ if p=nil then break;
+ until false;
+end;
+
+function StrReplaceW(src,SubStr,NewStr:pWideChar):PWideChar;
+var
+ i,j,l:integer;
+ k:integer;
+ p:PWideChar;
+begin
+ result:=src;
+ p:=StrPosW(src,SubStr);
+ if p=nil then exit;
+ i:=StrLenW(SubStr);
+ j:=StrLenW(NewStr);
+ l:=i-j;
+ repeat
+ if j=0 then
+ StrCopyW(p,p+i)
+ else
+ begin
+ k:=(StrLenW(p)+1)*SizeOf(WideChar);
+ if l>0 then
+ move((p+l)^,p^,k-l*SizeOf(WideChar))
+ else if l<>0 then
+ move(p^,(p-l)^,k);
+ move(NewStr^,p^,j*SizeOf(WideChar)); {new characters}
+ inc(p,j);
+ end;
+ p:=StrPosW(p,SubStr);
+ if p=nil then break;
+ until false;
+end;
+
+function CharReplace(dst:pAnsiChar;old,new:AnsiChar):PAnsiChar;
+begin
+ result:=dst;
+ if dst<>nil then
+ begin
+ while dst^<>#0 do
+ begin
+ if dst^=old then dst^:=new;
+ inc(dst);
+ end;
+ end;
+end;
+
+function CharReplaceW(dst:pWideChar;old,new:WideChar):PWideChar;
+begin
+ result:=dst;
+ if dst<>nil then
+ begin
+ while dst^<>#0 do
+ begin
+ if dst^=old then dst^:=new;
+ inc(dst);
+ end;
+ end;
+end;
+
+function StrCmp(a,b:PAnsiChar;n:cardinal=0):integer; // CompareString
+begin
+ result:=0;
+ if (a=nil) and (b=nil) then
+ exit;
+ if (a=nil) or (b=nil) then
+ begin
+ result:=-1;
+ exit;
+ end;
+ repeat
+ result:=ord(a^)-ord(b^);
+ if (result<>0) or (a^=#0) then
+ break;
+ inc(a);
+ inc(b);
+ dec(n);
+ until n=0;
+end;
+
+function StrCmpW(a,b:PWideChar;n:cardinal=0):integer;
+begin
+ result:=0;
+ if (a=nil) and (b=nil) then
+ exit;
+ if (a=nil) or (b=nil) then
+ begin
+ result:=-1;
+ exit;
+ end;
+ repeat
+ result:=ord(a^)-ord(b^);
+ if (result<>0) or (a^=#0) then
+ break;
+ inc(a);
+ inc(b);
+ dec(n);
+ until n=0;
+end;
+
+function StrEnd(const a:PAnsiChar):PAnsiChar;
+begin
+ result:=a;
+ if result<>nil then
+ while result^<>#0 do inc(result);
+end;
+
+function StrEndW(const a:PWideChar):PWideChar;
+begin
+ result:=a;
+ if result<>nil then
+ while result^<>#0 do inc(result);
+end;
+
+function StrScan(src:PAnsiChar;c:AnsiChar):PAnsiChar;
+begin
+ if src<>nil then
+ begin
+ while (src^<>#0) and (src^<>c) do inc(src);
+ if src^<>#0 then
+ begin
+ result:=src;
+ exit;
+ end;
+ end;
+ result:=nil;
+end;
+
+function StrRScan(src:PAnsiChar;c:AnsiChar):PAnsiChar;
+begin
+ if src<>nil then
+ begin
+ result:=StrEnd(src);
+ while (result>=src) and (result^<>c) do dec(result);
+ if result<src then
+ result:=nil;
+ end
+ else
+ result:=nil;
+end;
+
+function StrScanW(src:PWideChar;c:WideChar):PWideChar;
+begin
+ if src<>nil then
+ begin
+ while (src^<>#0) and (src^<>c) do inc(src);
+ if src^<>#0 then
+ begin
+ result:=src;
+ exit;
+ end;
+ end;
+ result:=nil;
+end;
+
+function StrRScanW(src:PWideChar;c:WideChar):PWideChar;
+begin
+ if src<>nil then
+ begin
+ result:=StrEndW(src);
+ while (result>=src) and (result^<>c) do dec(result);
+ if result<src then
+ result:=nil;
+ end
+ else
+ result:=nil;
+end;
+
+function StrLen(Str: PAnsiChar): Cardinal;
+var
+ P : PAnsiChar;
+begin
+ P := Str;
+ if P<>nil then
+ while (P^ <> #0) do Inc(P);
+ Result := (P - Str);
+end;
+
+function StrLenW(Str: PWideChar): Cardinal;
+var
+ P : PWideChar;
+begin
+ P := Str;
+ if P<>nil then
+ while (P^ <> #0) do Inc(P);
+ Result := (P - Str);
+end;
+
+function StrCat(Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar;
+begin
+ if Dest<>nil then
+ StrCopy(StrEnd(Dest), Source);
+ Result := Dest;
+end;
+
+function StrCatW(Dest: PWideChar; const Source: PWideChar): PWideChar;
+begin
+ if Dest<>nil then
+ StrCopyW(StrEndW(Dest), Source);
+ Result := Dest;
+end;
+
+function StrCatE(Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar;
+begin
+ if Dest<>nil then
+ result:=StrCopyE(StrEnd(Dest), Source)
+ else
+ result:=nil;
+end;
+
+function StrCatEW(Dest: PWideChar; const Source: PWideChar): PWideChar;
+begin
+ if Dest<>nil then
+ result:=StrCopyEW(StrEndW(Dest), Source)
+ else
+ result:=nil;
+end;
+
+function StrPos(const aStr, aSubStr: PAnsiChar): PAnsiChar;
+var
+ Str, SubStr: PAnsiChar;
+ Ch: AnsiChar;
+begin
+ if (aStr = nil) or (aStr^ = #0) or (aSubStr = nil) or (aSubStr^ = #0) then
+ begin
+ Result := nil;
+ Exit;
+ end;
+ Result := aStr;
+ Ch := aSubStr^;
+ repeat
+ if Result^ = Ch then
+ begin
+ Str := Result;
+ SubStr := aSubStr;
+ repeat
+ Inc(Str);
+ Inc(SubStr);
+ if SubStr^ = #0 then exit;
+ if Str^ = #0 then
+ begin
+ Result := nil;
+ exit;
+ end;
+ if Str^ <> SubStr^ then break;
+ until (FALSE);
+ end;
+ Inc(Result);
+ until (Result^ = #0);
+ Result := nil;
+end;
+
+function StrIndex(const aStr, aSubStr: PAnsiChar):integer;
+var
+ p:pAnsiChar;
+begin
+ p:=StrPos(aStr,aSubStr);
+ if p=nil then
+ result:=0
+ else
+ result:=p-aStr+1;
+end;
+
+function StrPosW(const aStr, aSubStr: PWideChar): PWideChar;
+var
+ Str, SubStr: PWideChar;
+ Ch: WideChar;
+begin
+ if (aStr = nil) or (aStr^ = #0) or (aSubStr = nil) or (aSubStr^ = #0) then
+ begin
+ Result := nil;
+ Exit;
+ end;
+ Result := aStr;
+ Ch := aSubStr^;
+ repeat
+ if Result^ = Ch then
+ begin
+ Str := Result;
+ SubStr := aSubStr;
+ repeat
+ Inc(Str);
+ Inc(SubStr);
+ if SubStr^ = #0 then exit;
+ if Str^ = #0 then
+ begin
+ Result := nil;
+ exit;
+ end;
+ if Str^ <> SubStr^ then break;
+ until (FALSE);
+ end;
+ Inc(Result);
+ until (Result^ = #0);
+ Result := nil;
+end;
+
+function StrIndexW(const aStr, aSubStr: PWideChar):integer;
+var
+ p:pWideChar;
+begin
+ p:=StrPosW(aStr,aSubStr);
+ if p=nil then
+ result:=0
+ else
+ result:=(p-aStr)+1; //!!!!
+end;
+
+// ----- filenames -----
+
+function ChangeExt(src,ext:PAnsiChar):PAnsiChar;
+var
+ i,j:integer;
+begin
+ i:=StrLen(src);
+ j:=i;
+ while (i>0) and (src[i]<>'\') and (src[i]<>':') and (src[i]<>'.') do dec(i);
+ if src[i]<>'.' then
+ begin
+ i:=j;
+ src[i]:='.';
+ end;
+ if ext=nil then
+ ext:='';
+ StrCopy(src+i+1,ext);
+ result:=src;
+end;
+
+function ChangeExtW(src,ext:PWideChar):PWideChar;
+var
+ i,j:integer;
+begin
+ i:=StrLenW(src);
+ j:=i;
+ while (i>0) and (src[i]<>'\') and (src[i]<>':') and (src[i]<>'.') do dec(i);
+ if src[i]<>'.' then
+ begin
+ i:=j;
+ src[i]:='.';
+ end;
+ if ext=nil then
+ ext:='';
+ StrCopyW(src+i+1,ext);
+ result:=src;
+end;
+
+function Extract(s:PAnsiChar;name:Boolean=true):PAnsiChar;
+var
+ i:integer;
+begin
+ i:=StrLen(s)-1;
+// j:=i;
+ while (i>=0) and ((s[i]<>'\') and (s[i]<>'/')) do dec(i);
+ if name then
+ begin
+ StrDup(result,s+i+1);
+// mGetMem(result,(j-i+1));
+// StrCopy(result,s+i+1);
+ end
+ else
+ begin
+ StrDup(result,s,i+1);
+ end;
+end;
+
+function ExtractW(s:pWideChar;name:Boolean=true):pWideChar;
+var
+ i:integer;
+begin
+ i:=StrLenW(s)-1;
+// j:=i;
+ while (i>=0) and ((s[i]<>'\') and (s[i]<>'/')) do dec(i);
+ if name then
+ begin
+ StrDupW(result,s+i+1);
+// mGetMem(result,(j-i+1)*SizeOf(WideChar));
+// StrCopyW(result,s+i+1);
+ end
+ else
+ begin
+ StrDupW(result,s,i+1);
+ end;
+end;
+
+function GetExt(fname,dst:pWideChar;maxlen:dword=100):pWideChar;
+var
+ ppc,pc:PWideChar;
+begin
+ result:=dst;
+ dst^:=#0;
+ if fname<>nil then
+ begin
+ pc:=StrEndW(fname)-1;
+ while (pc>fname) and ((pc^='"') or (pc^=' ')) do dec(pc);
+ ppc:=pc+1;
+ while (pc>fname) and (pc^<>'.') do
+ begin
+ if maxlen=0 then exit;
+ if not (AnsiChar(pc^) in ['0'..'9','A'..'Z','_','a'..'z']) then exit;
+ dec(maxlen);
+ dec(pc); //empty name not allowed!
+ end;
+ if pc>fname then
+ begin
+ repeat
+ inc(pc);
+ if pc=ppc then
+ begin
+ dst^:=#0;
+ break;
+ end;
+ if (pc^>='a') and (pc^<='z') then
+ dst^:=WideChar(ord(pc^)-$20)
+ else
+ dst^:=pc^;
+ inc(dst);
+ until false;
+ end;
+ end;
+end;
+
+function GetExt(fname,dst:PAnsiChar;maxlen:dword=100):PAnsiChar;
+var
+ ppc,pc:PAnsiChar;
+begin
+ result:=dst;
+ dst^:=#0;
+ if fname<>nil then
+ begin
+ pc:=StrEnd(fname)-1;
+ while (pc>fname) and ((pc^='"') or (pc^=' ')) do dec(pc);
+ ppc:=pc+1;
+ while (pc>fname) and (pc^<>'.') do
+ begin
+ if maxlen=0 then exit;
+ if not (AnsiChar(pc^) in ['0'..'9','A'..'Z','_','a'..'z']) then exit;
+ dec(maxlen);
+ dec(pc); //empty name not allowed!
+ end;
+ if pc>fname then
+ begin
+ repeat
+ inc(pc);
+ if pc=ppc then
+ begin
+ dst^:=#0;
+ break;
+ end;
+ if (pc^>='a') and (pc^<='z') then
+ dst^:=AnsiChar(ord(pc^)-$20)
+ else
+ dst^:=pc^;
+ inc(dst);
+ until false;
+ end;
+ end;
+end;
+
+type
+ PDayTable = ^TDayTable;
+ TDayTable = array [0..11] of cardinal;
+
+const
+ MonthDays: array [Boolean] of TDayTable =
+ ((31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31),
+ (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31));
+
+const
+ DateDelta = 693594;
+{ Days between TDateTime basis (12/31/1899) and Unix time_t basis (1/1/1970) }
+ UnixDateDelta = 25569;
+
+function IsLeapYear(Year:Word):Boolean;
+begin
+ Result:=(Year mod 4=0) and ((Year mod 100<>0) or (Year mod 400=0));
+end;
+
+function EncodeTime(Hour, Minute, Sec: cardinal): TDateTime;
+begin
+ result := (Hour*3600 + Minute*60 + Sec) / 86400;
+end;
+
+function EncodeDate(Year, Month, Day: cardinal):TDateTime;
+var
+ DayTable: PDayTable;
+begin
+ DayTable := @MonthDays[IsLeapYear(Year)];
+ dec(Month);
+ while Month>0 do
+ begin
+ dec(Month);
+ inc(Day,DayTable^[Month]);
+ end;
+
+ dec(Year);
+ result := Year * 365 + Year div 4 - Year div 100 + Year div 400 + Day - DateDelta;
+end;
+
+function Timestamp(Year,Month,Day:cardinal;Hour:cardinal=0;Minute:cardinal=0;Sec:cardinal=0):dword;
+var
+ t:tDateTime;
+begin
+ t := EncodeDate(Year, Month, Day);
+ if t >= 0 then
+ t := t + EncodeTime(Hour, Minute, Sec)
+ else
+ t := t - EncodeTime(Hour, Minute, Sec);
+ result:=Round((t - UnixDateDelta) * 86400)
+end;
+
+function GetCurrentTime:dword;
+var
+ st:tSystemTime;
+begin
+ GetSystemTime(st);
+ result:=Timestamp(st.wYear,st.wMonth,st.wDay,st.wHour,st.wMinute,st.wSecond);
+end;
+
+function TimeToInt(stime:PAnsiChar):integer;
+var
+ hour,minute,sec,len,i:integer;
+begin
+ len:=StrLen(stime);
+ i:=0;
+ sec :=0;
+ minute:=0;
+ hour :=0;
+ while i<len do
+ begin
+ if (stime[i]<'0') or (stime[i]>'9') then
+ begin
+ if minute>0 then
+ hour:=minute;
+ minute:=sec;
+ sec:=0;
+ end
+ else
+ sec:=sec*10+ord(stime[i])-ord('0');
+ inc(i);
+ end;
+ result:=hour*3600+minute*60+sec;
+end;
+
+function TimeToInt(stime:PWideChar):integer;
+var
+ buf:array [0..63] of AnsiChar;
+begin
+ result:=TimeToInt(FastWideToAnsiBuf(stime,buf));
+end;
+
+function IntToTime(dst:PAnsiChar;time:integer):PAnsiChar;
+var
+ day,hour,minute,sec:array [0..7] of AnsiChar;
+ d,h:integer;
+begin
+ result:=dst;
+ h:=time div 3600;
+ dec(time,h*3600);
+ IntToStr(sec,(time mod 60),2);
+ d:=h div 24;
+ if d>0 then
+ begin
+ h:=h mod 24;
+ IntToStr(day,d);
+ dst^:=day[0]; inc(dst);
+ if day[1]<>#0 then // now only 99 days max
+ begin
+ dst^:=day[1]; inc(dst);
+ end;
+ dst^:=' '; inc(dst);
+ end;
+ if h>0 then
+ begin
+ IntToStr(hour,h);
+ IntToStr(minute,(time div 60),2);
+ dst^:=hour[0]; inc(dst);
+ if hour[1]<>#0 then
+ begin
+ dst^:=hour[1]; inc(dst);
+ end;
+ dst^:=':'; inc(dst);
+ dst^:=minute[0]; inc(dst);
+ dst^:=minute[1]; inc(dst);
+ end
+ else
+ begin
+ IntToStr(minute,time div 60);
+ dst^:=minute[0]; inc(dst);
+ if minute[1]<>#0 then
+ begin
+ dst^:=minute[1]; inc(dst);
+ end;
+ end;
+ dst^:=':'; inc(dst);
+ dst^:=sec[0]; inc(dst);
+ dst^:=sec[1]; inc(dst);
+ dst^:=#0;
+end;
+
+function IntToTime(dst:pWideChar;time:integer):pWideChar;
+var
+ buf:array [0..63] of AnsiChar;
+begin
+ result:=FastAnsiToWideBuf(IntToTime(buf,time),dst);
+end;
+
+function StrToInt(src:pWideChar):int64;
+var
+ sign:boolean;
+begin
+ result:=0;
+ if src<>nil then
+ begin
+ sign:=src^='-';
+ if sign then inc(src);
+ while src^<>#0 do
+ begin
+ if (src^>='0') and (src^<='9') then
+ result:=result*10+ord(src^)-ord('0')
+ else
+ break;
+ inc(src);
+ end;
+ if sign then result:=-result;
+ end;
+end;
+
+function StrToInt(src:PAnsiChar):int64;
+var
+ sign:boolean;
+begin
+ result:=0;
+ if src<>nil then
+ begin
+ sign:=src^='-';
+ if sign then inc(src);
+ while src^<>#0 do
+ begin
+ if (src^>='0') and (src^<='9') then
+ result:=result*10+ord(src^)-ord('0')
+ else
+ break;
+ inc(src);
+ end;
+ if sign then result:=-result;
+ end;
+end;
+
+function IntToStr(dst:PAnsiChar;Value:int64;Digits:integer=0):PAnsiChar;
+var
+ i:dword;
+begin
+ if Digits<=0 then
+ begin
+ if Value<0 then
+ Digits:=1
+ else
+ Digits:=0;
+ i:=ABS(Value);
+ repeat
+ i:=i div 10;
+ inc(Digits);
+ until i=0;
+ end;
+ dst[Digits]:=#0;
+ i:=ABS(Value);
+ repeat
+ dec(Digits);
+ dst[Digits]:=AnsiChar(ord('0')+(i mod 10));
+ i:=i div 10;
+ if (Value<0) and (Digits=1) then
+ begin
+ dst[0]:='-';
+ break;
+ end;
+ until Digits=0;
+ result:=dst;
+end;
+
+function IntToStr(dst:pWideChar;Value:int64;Digits:integer=0):pWideChar;
+var
+ i:dword;
+begin
+ if Digits<=0 then
+ begin
+ if Value<0 then
+ Digits:=1
+ else
+ Digits:=0;
+ i:=ABS(Value);
+ repeat
+ i:=i div 10;
+ inc(Digits);
+ until i=0;
+ end;
+ dst[Digits]:=#0;
+ i:=ABS(Value);
+ repeat
+ dec(Digits);
+ dst[Digits]:=WideChar(ord('0')+(i mod 10));
+ i:=i div 10;
+ if (Value<0) and (Digits=1) then
+ begin
+ dst[0]:='-';
+ break;
+ end;
+ until Digits=0;
+ result:=dst;
+end;
+
+function HexToInt(src:pWideChar;len:cardinal=$FFFF):int64;
+begin
+ result:=0;
+ while (src^<>#0) and (len>0) do
+ begin
+ if (src^>='0') and (src^<='9') then
+ result:=result*16+ord(src^)-ord('0')
+ else if ((src^>='A') and (src^<='F')) then
+ result:=result*16+ord(src^)-ord('A')+10
+ else if ((src^>='a') and (src^<='f')) then
+ result:=result*16+ord(src^)-ord('a')+10
+ else
+ break;
+ inc(src);
+ dec(len);
+ end;
+end;
+
+function HexToInt(src:PAnsiChar;len:cardinal=$FFFF):int64;
+begin
+ result:=0;
+ while (src^<>#0) and (len>0) do
+ begin
+ if (src^>='0') and (src^<='9') then
+ result:=result*16+ord(src^)-ord('0')
+ else if ((src^>='A') and (src^<='F')) then
+ result:=result*16+ord(src^)-ord('A')+10
+ else if ((src^>='a') and (src^<='f')) then
+ result:=result*16+ord(src^)-ord('a')+10
+ else
+ break;
+ inc(src);
+ dec(len);
+ end;
+end;
+
+function IntToHex(dst:pWidechar;Value:int64;Digits:integer=0):pWideChar;
+var
+ i:dword;
+begin
+ if Digits<=0 then
+ begin
+ Digits:=0;
+ i:=Value;
+ repeat
+ i:=i shr 4;
+ inc(Digits);
+ until i=0;
+ end;
+ dst[Digits]:=#0;
+ repeat
+ Dec(Digits);
+ dst[Digits]:=WideChar(HexDigitChr[Value and $F]);
+ Value:=Value shr 4;
+ until Digits=0;
+ result:=dst;
+end;
+
+function IntToHex(dst:PAnsiChar;Value:int64;Digits:integer=0):PAnsiChar;
+var
+ i:dword;
+begin
+ if Digits<=0 then
+ begin
+ Digits:=0;
+ i:=Value;
+ repeat
+ i:=i shr 4;
+ inc(Digits);
+ until i=0;
+ end;
+ dst[Digits]:=#0;
+ repeat
+ Dec(Digits);
+ dst[Digits]:=HexDigitChr[Value and $F];
+ Value:=Value shr 4;
+ until Digits=0;
+ result:=dst;
+end;
+
+procedure UpperCase(src:pWideChar);
+var
+ c:WideChar;
+begin
+ if src<>nil then
+ begin
+ while src^<>#0 do
+ begin
+ c:=src^;
+ if (c>='a') and (c<='z') then
+ src^:=WideChar(ord(c)-$20);
+ inc(src);
+ end;
+ end;
+end;
+
+procedure LowerCase(src:pWideChar);
+var
+ c:WideChar;
+begin
+ if src<>nil then
+ begin
+ while src^<>#0 do
+ begin
+ c:=src^;
+ if (c>='A') and (c<='Z') then
+ src^:=WideChar(ord(c)+$20);
+ inc(src);
+ end;
+ end;
+end;
+
+function GetPairChar(ch:AnsiChar):AnsiChar;
+begin
+ case ch of
+ '[': result:=']';
+ '<': result:='>';
+ '(': result:=')';
+ '{': result:='}';
+ else // ' and " too
+ result:=ch;
+ end;
+end;
+
+function GetPairChar(ch:WideChar):WideChar;
+begin
+ case ch of
+ '[': result:=']';
+ '<': result:='>';
+ '(': result:=')';
+ '{': result:='}';
+ else // ' and " too
+ result:=ch;
+ end;
+end;
+
+function FastWideToAnsiBuf(src:PWideChar;dst:PAnsiChar;len:cardinal=cardinal(-1)):PAnsiChar;
+begin
+ result:=dst;
+ if src<>nil then
+ begin
+ repeat
+ dst^:=AnsiChar(src^);
+ if src^=#0 then
+ break;
+ dec(len);
+ if len=0 then
+ begin
+ (dst+1)^:=#0;
+ break;
+ end;
+ inc(src);
+ inc(dst);
+ until false;
+ end
+ else
+ dst^:=#0;
+end;
+
+function FastWideToAnsi(src:PWideChar;var dst:PAnsiChar):PAnsiChar;
+begin
+ if src=nil then
+ dst:=nil
+ else
+ begin
+ mGetMem(dst,StrLenW(src)+1);
+ FastWideToAnsiBuf(src,dst);
+ end;
+ result:=dst;
+end;
+
+function FastAnsiToWideBuf(src:PAnsiChar;dst:PWideChar;len:cardinal=cardinal(-1)):PWideChar;
+begin
+ result:=dst;
+ if src<>nil then
+ begin
+ repeat
+ dst^:=WideChar(src^);
+ if src^=#0 then
+ break;
+ dec(len);
+ if len=0 then
+ begin
+ (dst+1)^:=#0;
+ break;
+ end;
+ inc(src);
+ inc(dst);
+ until false;
+ end
+ else
+ dst^:=#0;
+end;
+
+function FastAnsiToWide(src:PAnsiChar;var dst:PWideChar):PWideChar;
+begin
+ if src=nil then
+ dst:=nil
+ else
+ begin
+ mGetMem(dst,(StrLen(src)+1)*SizeOf(WideChar));
+ FastAnsiToWideBuf(src,dst);
+ end;
+ result:=dst;
+end;
+
+function isPathAbsolute(path:pWideChar):boolean;
+begin
+ result:=((path[1]=':') and (path[2]='\')) or ((path[0]='\') {and (path[1]='\')}) or
+ (StrPosW(path,'://')<>nil);
+end;
+
+function isPathAbsolute(path:pAnsiChar):boolean;
+begin
+ result:=((path[1]=':') and (path[2]='\')) or ((path[0]='\') {and (path[1]='\')}) or
+ (StrPos(path,'://')<>nil);
+end;
+
+procedure ShowDump(ptr:pbyte;len:integer);
+var
+ buf: array of Ansichar;
+ i:integer;
+ p:pAnsiChar;
+ p1:pByte;
+ cnt:integer;
+begin
+ SetLength(buf,len*4+1);
+ p:=@buf[0];
+ p1:=ptr;
+ cnt:=0;
+ for i:=0 to len-1 do
+ begin
+ IntToHex(p,p1^,2);
+ inc(p,2);
+ inc(p1);
+ inc(cnt);
+ if cnt=4 then
+ begin
+ cnt:=0;
+ p^:='.';
+ inc(p);
+ end;
+ end;
+ p^:=#0;
+ messageboxa(0,@buf[0],'',0);
+end;
+begin
+ CheckSystem;
+end.
diff --git a/plugins/Utils.pas/compilers.inc b/plugins/Utils.pas/compilers.inc new file mode 100644 index 0000000000..95940246e1 --- /dev/null +++ b/plugins/Utils.pas/compilers.inc @@ -0,0 +1,778 @@ +//----------------------------------------------------------------------------------------------------------------------
+// Include file to determine which compiler is currently being used to build the project/component.
+// This file uses ideas from Brad Stowers DFS.inc file.
+//
+// Portions created by Mike Lischke are
+// Copyright (C) 1999-2005 Mike Lischke. All Rights Reserved.
+// Portions created by Jim Kueneman are
+// Copyright (C) 2005 Jim Kueneman. All Rights Reserved.
+//
+//----------------------------------------------------------------------------------------------------------------------
+//
+// This unit is released under the MIT license:
+// Copyright (c) 1999-2005 Mike Lischke (support@soft-gems.net, www.soft-gems.net).
+//
+// Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated
+// documentation files (the "Software"), to deal in the Software without restriction, including without limitation the
+// rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to
+// permit persons to whom the Software is furnished to do so, subject to the following conditions:
+//
+// The above copyright notice and this permission notice shall be included in all copies or substantial portions of the
+// Software.
+//
+// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE
+// WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS
+// OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
+// OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+//
+// You are asked to give the author(s) the due credit. This means that you acknowledge the work of the author(s)
+// in the product documentation, about box, help or wherever a prominent place is.
+//
+//----------------------------------------------------------------------------------------------------------------------
+//
+// The following symbols are defined:
+//
+// - COMPILER_1 : Kylix/Delphi/BCB 1.x is the compiler.
+// - COMPILER_1_UP : Kylix/Delphi/BCB 1.x or higher is the compiler.
+// - COMPILER_2 : Kylix/Delphi 2.x or BCB 1.x is the compiler.
+// - COMPILER_2_UP : Kylix/Delphi 2.x or higher, or BCB 1.x or higher is the compiler.
+// - COMPILER_3 : Kylix/Delphi/BCB 3.x is the compiler.
+// - COMPILER_3_UP : Kylix/Delphi/BCB 3.x or higher is the compiler.
+// - COMPILER_4 : Kylix/Delphi/BCB 4.x is the compiler.
+// - COMPILER_4_UP : Kylix/Delphi/BCB 4.x or higher is the compiler.
+// - COMPILER_5 : Kylix/Delphi/BCB 5.x is the compiler.
+// - COMPILER_5_UP : Kylix/Delphi/BCB 5.x or higher is the compiler.
+// - COMPILER_6 : Kylix/Delphi/BCB 6.x is the compiler.
+// - COMPILER_6_UP : Kylix/Delphi/BCB 6.x or higher is the compiler.
+// - COMPILER_7 : Kylix/Delphi/BCB 7.x is the compiler.
+// - COMPILER_7_UP : Kylix/Delphi/BCB 7.x or higher is the compiler.
+// - COMPILER_8 : Kylix/Delphi/BCB 8.x is the compiler.
+// - COMPILER_8_UP : Kylix/Delphi/BCB 8.x or higher is the compiler.
+// - COMPILER_9 : Kylix/Delphi/BCB 9.x is the compiler.
+// - COMPILER_9_UP : Kylix/Delphi/BCB 9.x or higher is the compiler.
+// - COMPILER_10 : Kylix/Delphi/BCB 10.x is the compiler.
+// - COMPILER_10_UP : Kylix/Delphi/BCB 10.x or higher is the compiler.
+// - COMPILER_11 : Kylix/Delphi/BCB 11.x is the compiler.
+// - COMPILER_11_UP : Kylix/Delphi/BCB 11.x or higher is the compiler.
+// - COMPILER_12 : Kylix/Delphi/BCB 12.x is the compiler.
+// - COMPILER_12_UP : Kylix/Delphi/BCB 12.x or higher is the compiler.
+// - COMPILER_14 : Delphi/BCB 14.x is the compiler.
+// - COMPILER_14_UP : Delphi/BCB 14.x or higher is the compiler.
+// - COMPILER_15 : Delphi/BCB 15.x is the compiler. [XE]
+// - COMPILER_15_UP : Delphi/BCB 15.x or higher is the compiler. [XE]
+// - COMPILER_16 : Delphi/BCB 16.x is the compiler. [XE2]
+// - COMPILER_16_UP : Delphi/BCB 16.x or higher is the compiler. [XE2]
+//
+// Only defined if Windows is the target:
+// - CPPB : Any version of BCB is being used.
+// - CPPB_1 : BCB v1.x is being used.
+// - CPPB_3 : BCB v3.x is being used.
+// - CPPB_3_UP : BCB v3.x or higher is being used.
+// - CPPB_4 : BCB v4.x is being used.
+// - CPPB_4_UP : BCB v4.x or higher is being used.
+// - CPPB_5 : BCB v5.x is being used.
+// - CPPB_5_UP : BCB v5.x or higher is being used.
+// - CPPB_6 : BCB v6.x is being used.
+// - CPPB_6_UP : BCB v6.x or higher is being used.
+// - CPPB_XXX is not used any more, use the COMPILER_XXX defines
+//
+// Only defined if Windows is the target:
+// - DELPHI : Any version of Delphi is being used.
+// - DELPHI_1 : Delphi v1.x is being used.
+// - DELPHI_2 : Delphi v2.x is being used.
+// - DELPHI_2_UP : Delphi v2.x or higher is being used.
+// - DELPHI_3 : Delphi v3.x is being used.
+// - DELPHI_3_UP : Delphi v3.x or higher is being used.
+// - DELPHI_4 : Delphi v4.x is being used.
+// - DELPHI_4_UP : Delphi v4.x or higher is being used.
+// - DELPHI_5 : Delphi v5.x is being used.
+// - DELPHI_5_UP : Delphi v5.x or higher is being used.
+// - DELPHI_6 : Delphi v6.x is being used.
+// - DELPHI_6_UP : Delphi v6.x or higher is being used.
+// - DELPHI_7 : Delphi v7.x is being used.
+// - DELPHI_7_UP : Delphi v7.x or higher is being used.
+// - DELPHI_8 : Delphi v8.x is being used.
+// - DELPHI_8_UP : Delphi v8.x or higher is being used.
+// - DELPHI_9 : Delphi v9.x is being used.
+// - DELPHI_9_UP : Delphi v9.x or higher is being used.
+// - DELPHI_XXX is not used any more, use the COMPILER_XXX defines
+//
+// Only defined if Linux is the target:
+// - KYLIX : Any version of Kylix is being used.
+// - KYLIX_1 : Kylix 1.x is being used.
+// - KYLIX_1_UP : Kylix 1.x or higher is being used.
+// - KYLIX_2 : Kylix 2.x is being used.
+// - KYLIX_2_UP : Kylix 2.x or higher is being used.
+// - KYLIX_3 : Kylix 3.x is being used.
+// - KYLIX_3_UP : Kylix 3.x or higher is being used.
+//
+// Only defined if Linux is the target:
+// - QT_CLX : Trolltech's QT library is being used.
+//
+// Only defined if Delphi.NET is the target:
+// - DELPHI.NET : Any version of Delphi.NET is being used.
+// - DELPHI.NET_1 : Delphi.NET version 1.x is being used.
+// - DELPHI.NET_1_UP : Delphi.NET version 1.x is being used.
+//----------------------------------------------------------------------------------------------------------------------
+
+
+{$ifdef CLR} // The common language runtime symbol is only defined for the .NET platform.
+ {$define DELPHI.NET}
+ {$ifdef VER160}
+ {$define DELPHI.NET_1}
+ {$endif VER160}
+
+
+ // Compiler defines common to all .NET versions.
+ {$ifdef DELPHI.NET_1}
+ {$define DELHI.NET_1_UP}
+ {$endif DELPHI.NET_1}
+{$endif CLR}
+
+
+{$ifdef Win64}
+
+
+ // BDS XE2 (BDS 9.0) DELPHI and BCB are no longer defined, only COMPILER
+ {$ifdef VER230}
+ {$define COMPILER_16}
+ {$endif VER230}
+
+
+ {$ifdef COMPILER_16}
+ {$define COMPILER_16_UP}
+ {$endif}
+
+
+ {$ifdef BCB}
+ {$define CPPB}
+ {$else}
+ {$define DELPHI}
+ {$endif}
+
+
+{$endif}
+
+
+{$ifdef Win32}
+
+
+// Compiler defines not specific to a particlular platform.
+
+
+ // BDS XE2 (BDS 9.0) DELPHI and BCB are no longer defined, only COMPILER
+ {$ifdef VER230}
+ {$define COMPILER_16}
+ {$endif VER230}
+
+
+ // BDS XE (BDS 8.0) DELPHI and BCB are no longer defined, only COMPILER
+ {$ifdef VER220}
+ {$define COMPILER_15}
+ {$endif VER220}
+
+
+ // BDS 2010 (BDS 7.0) DELPHI and BCB are no longer defined, only COMPILER
+ {$ifdef VER210}
+ {$define COMPILER_14}
+ {$endif VER210}
+
+
+// No Compiler 13
+
+
+ // BDS 2009 (BDS 6.0) DELPHI and BCB are no longer defined, only COMPILER
+ {$ifdef VER200}
+ {$define COMPILER_12}
+ {$endif VER200}
+
+
+ // BDS 2007 (BDS 5.0) DELPHI and BCB are no longer defined, only COMPILER
+ {$ifdef VER190}
+ {$define COMPILER_11}
+ {$endif VER190}
+
+
+ // DELPHI and BCB are no longer defined, only COMPILER
+ {$ifdef VER180}
+ {$define COMPILER_10}
+ {$endif VER180}
+
+
+ {$ifdef VER170}
+ {$define COMPILER_9}
+ {$define DELPHI}
+ {$define DELPHI_9}
+ {$endif VER170}
+
+ {$ifdef VER160}
+ {$define COMPILER_8}
+ {$define DELPHI}
+ {$define DELPHI_8}
+ {$endif VER160}
+
+
+ {$ifdef VER150}
+ {$define COMPILER_7}
+ {$define DELPHI}
+ {$define DELPHI_7}
+ {$endif}
+
+
+ {$ifdef VER140}
+ {$define COMPILER_6}
+ {$ifdef BCB}
+ {$define CPPB}
+ {$define CPPB_6}
+ {$else}
+ {$define DELPHI}
+ {$define DELPHI_6}
+ {$endif}
+ {$endif}
+
+
+ {$ifdef VER130}
+ {$define COMPILER_5}
+ {$ifdef BCB}
+ {$define CPPB}
+ {$define CPPB_5}
+ {$else}
+ {$define DELPHI}
+ {$define DELPHI_5}
+ {$endif}
+ {$endif}
+
+
+ {$ifdef VER125}
+ {$define COMPILER_4}
+ {$define CPPB}
+ {$define CPPB_4}
+ {$endif}
+
+
+ {$ifdef VER120}
+ {$define COMPILER_4}
+ {$define DELPHI}
+ {$define DELPHI_4}
+ {$endif}
+
+
+ {$ifdef VER110}
+ {$define COMPILER_3}
+ {$define CPPB}
+ {$define CPPB_3}
+ {$endif}
+
+
+ {$ifdef VER100}
+ {$define COMPILER_3}
+ {$define DELPHI}
+ {$define DELPHI_3}
+ {$endif}
+
+
+ {$ifdef VER93}
+ {$define COMPILER_2} // C++ Builder v1 compiler is really v2
+ {$define CPPB}
+ {$define CPPB_1}
+ {$endif}
+
+
+ {$ifdef VER90}
+ {$define COMPILER_2}
+ {$define DELPHI}
+ {$define DELPHI_2}
+ {$endif}
+
+
+ {$ifdef VER80}
+ {$define COMPILER_1}
+ {$define DELPHI}
+ {$define DELPHI_1}
+ {$endif}
+
+
+ {$ifdef DELPHI_2}
+ {$define DELPHI_2_UP}
+ {$endif}
+
+
+ {$ifdef DELPHI_3}
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$endif}
+
+
+ {$ifdef DELPHI_4}
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$define DELPHI_4_UP}
+ {$endif}
+
+
+ {$ifdef DELPHI_5}
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$define DELPHI_4_UP}
+ {$define DELPHI_5_UP}
+ {$endif}
+
+
+ {$ifdef DELPHI_6}
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$define DELPHI_4_UP}
+ {$define DELPHI_5_UP}
+ {$define DELPHI_6_UP}
+ {$endif}
+
+
+ {$ifdef DELPHI_7}
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$define DELPHI_4_UP}
+ {$define DELPHI_5_UP}
+ {$define DELPHI_6_UP}
+ {$define DELPHI_7_UP}
+ {$endif}
+
+
+ {$ifdef DELPHI_8}
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$define DELPHI_4_UP}
+ {$define DELPHI_5_UP}
+ {$define DELPHI_6_UP}
+ {$define DELPHI_7_UP}
+ {$define DELPHI_8_UP}
+ {$endif}
+
+
+ {$ifdef DELPHI_9}
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$define DELPHI_4_UP}
+ {$define DELPHI_5_UP}
+ {$define DELPHI_6_UP}
+ {$define DELPHI_7_UP}
+ {$define DELPHI_8_UP}
+ {$define DELPHI_9_UP}
+ {$endif}
+
+
+ {$ifdef CPPB_3}
+ {$define CPPB_3_UP}
+ {$endif}
+
+
+ {$ifdef CPPB_4}
+ {$define CPPB_3_UP}
+ {$define CPPB_4_UP}
+ {$endif}
+
+
+ {$ifdef CPPB_5}
+ {$define CPPB_3_UP}
+ {$define CPPB_4_UP}
+ {$define CPPB_5_UP}
+ {$endif}
+
+
+ {$ifdef CPPB_6}
+ {$define CPPB_3_UP}
+ {$define CPPB_4_UP}
+ {$define CPPB_5_UP}
+ {$define CPPB_6_UP}
+ {$endif}
+
+
+ {$ifdef CPPB_3_UP}
+ // C++ Builder requires this if you use Delphi components in run-time packages.
+ {$ObjExportAll On}
+ {$endif}
+
+
+{$else (not Windows)}
+ // Linux is the target
+ {$define QT_CLX}
+
+
+ {$define KYLIX}
+
+
+ {$ifdef VER140}
+ {$define COMPILER_6}
+ {$ifdef conditionalexpressions}
+ {$if Declared(RTLVersion) and (RTLVersion = 14)}
+ {$define KYLIX_1}
+ {$ifend}
+
+
+ {$if Declared(RTLVersion) and (RTLVersion = 14.2)}
+ {$define KYLIX_2}
+ {$ifend}
+
+
+ {$if Declared(RTLVersion) and (RTLVersion = 14.5)}
+ {$define KYLIX_3}
+ {$ifend}
+ {$endif}
+ {$endif}
+
+
+ {$ifdef VER150}
+ {$define COMPILER_7}
+ {$define KYLIX_3}
+ {$endif}
+
+
+ {$ifdef VER140}
+ {$define COMPILER_6}
+ {$define KYLIX_2}
+ {$endif}
+
+
+ {$ifdef KYLIX_1}
+ {$define KYLIX_1_UP}
+ {$endif}
+
+
+ {$ifdef KYLIX_2}
+ {$define KYLIX_2_UP}
+ {$endif}
+
+
+ {$ifdef KYLIX_3}
+ {$define KYLIX_2_UP}
+ {$define KYLIX_3_UP}
+ {$endif}
+
+
+{$endif Win32}
+
+
+
+
+{$ifdef COMPILER_1}
+ {$define COMPILER_1_UP}
+{$endif}
+
+
+{$ifdef COMPILER_2}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+{$endif}
+
+
+{$ifdef COMPILER_3}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+{$endif}
+
+
+{$ifdef COMPILER_4}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+ {$define COMPILER_4_UP}
+{$endif}
+
+
+{$ifdef COMPILER_5}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+ {$define COMPILER_4_UP}
+ {$define COMPILER_5_UP}
+{$endif}
+
+
+{$ifdef COMPILER_6}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+ {$define COMPILER_4_UP}
+ {$define COMPILER_5_UP}
+ {$define COMPILER_6_UP}
+{$endif}
+
+
+{$ifdef COMPILER_7}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+ {$define COMPILER_4_UP}
+ {$define COMPILER_5_UP}
+ {$define COMPILER_6_UP}
+ {$define COMPILER_7_UP}
+{$endif}
+
+
+{$ifdef COMPILER_8}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+ {$define COMPILER_4_UP}
+ {$define COMPILER_5_UP}
+ {$define COMPILER_6_UP}
+ {$define COMPILER_7_UP}
+ {$define COMPILER_8_UP}
+{$endif}
+
+
+{$ifdef COMPILER_9}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+ {$define COMPILER_4_UP}
+ {$define COMPILER_5_UP}
+ {$define COMPILER_6_UP}
+ {$define COMPILER_7_UP}
+ {$define COMPILER_8_UP}
+ {$define COMPILER_9_UP}
+{$endif}
+
+
+{$ifdef COMPILER_10}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+ {$define COMPILER_4_UP}
+ {$define COMPILER_5_UP}
+ {$define COMPILER_6_UP}
+ {$define COMPILER_7_UP}
+ {$define COMPILER_8_UP}
+ {$define COMPILER_9_UP}
+ {$define COMPILER_10_UP}
+ // Backwards compatibility
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$define DELPHI_4_UP}
+ {$define DELPHI_5_UP}
+ {$define DELPHI_6_UP}
+ {$define DELPHI_7_UP}
+ {$define DELPHI_8_UP}
+ {$define DELPHI_9_UP}
+ {$define CPPB_3_UP}
+ {$define CPPB_4_UP}
+ {$define CPPB_5_UP}
+ {$define CPPB_6_UP}
+
+
+ {$ifdef BCB}
+ {$define CPPB}
+ {$else}
+ {$define DELPHI}
+ {$endif}
+
+
+{$endif}
+
+
+{$ifdef COMPILER_11}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+ {$define COMPILER_4_UP}
+ {$define COMPILER_5_UP}
+ {$define COMPILER_6_UP}
+ {$define COMPILER_7_UP}
+ {$define COMPILER_8_UP}
+ {$define COMPILER_9_UP}
+ {$define COMPILER_10_UP}
+ {$define COMPILER_11_UP}
+ // Backwards compatibility
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$define DELPHI_4_UP}
+ {$define DELPHI_5_UP}
+ {$define DELPHI_6_UP}
+ {$define DELPHI_7_UP}
+ {$define DELPHI_8_UP}
+ {$define DELPHI_9_UP}
+ {$define CPPB_3_UP}
+ {$define CPPB_4_UP}
+ {$define CPPB_5_UP}
+ {$define CPPB_6_UP}
+
+
+ {$ifdef BCB}
+ {$define CPPB}
+ {$else}
+ {$define DELPHI}
+ {$endif}
+
+
+{$endif}
+
+
+
+
+{$ifdef COMPILER_12}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+ {$define COMPILER_4_UP}
+ {$define COMPILER_5_UP}
+ {$define COMPILER_6_UP}
+ {$define COMPILER_7_UP}
+ {$define COMPILER_8_UP}
+ {$define COMPILER_9_UP}
+ {$define COMPILER_10_UP}
+ {$define COMPILER_11_UP}
+ {$define COMPILER_12_UP}
+ // Backwards compatibility
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$define DELPHI_4_UP}
+ {$define DELPHI_5_UP}
+ {$define DELPHI_6_UP}
+ {$define DELPHI_7_UP}
+ {$define DELPHI_8_UP}
+ {$define DELPHI_9_UP}
+ {$define CPPB_3_UP}
+ {$define CPPB_4_UP}
+ {$define CPPB_5_UP}
+ {$define CPPB_6_UP}
+
+
+ {$ifdef BCB}
+ {$define CPPB}
+ {$else}
+ {$define DELPHI}
+ {$endif}
+
+
+{$endif}
+
+
+
+
+{$ifdef COMPILER_14}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+ {$define COMPILER_4_UP}
+ {$define COMPILER_5_UP}
+ {$define COMPILER_6_UP}
+ {$define COMPILER_7_UP}
+ {$define COMPILER_8_UP}
+ {$define COMPILER_9_UP}
+ {$define COMPILER_10_UP}
+ {$define COMPILER_11_UP}
+ {$define COMPILER_12_UP}
+ {$define COMPILER_14_UP}
+ // Backwards compatibility
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$define DELPHI_4_UP}
+ {$define DELPHI_5_UP}
+ {$define DELPHI_6_UP}
+ {$define DELPHI_7_UP}
+ {$define DELPHI_8_UP}
+ {$define DELPHI_9_UP}
+ {$define CPPB_3_UP}
+ {$define CPPB_4_UP}
+ {$define CPPB_5_UP}
+ {$define CPPB_6_UP}
+
+
+ {$ifdef BCB}
+ {$define CPPB}
+ {$else}
+ {$define DELPHI}
+ {$endif}
+
+
+{$endif}
+
+
+{$ifdef COMPILER_15}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+ {$define COMPILER_4_UP}
+ {$define COMPILER_5_UP}
+ {$define COMPILER_6_UP}
+ {$define COMPILER_7_UP}
+ {$define COMPILER_8_UP}
+ {$define COMPILER_9_UP}
+ {$define COMPILER_10_UP}
+ {$define COMPILER_11_UP}
+ {$define COMPILER_12_UP}
+ {$define COMPILER_14_UP}
+ {$define COMPILER_15_UP}
+ // Backwards compatibility
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$define DELPHI_4_UP}
+ {$define DELPHI_5_UP}
+ {$define DELPHI_6_UP}
+ {$define DELPHI_7_UP}
+ {$define DELPHI_8_UP}
+ {$define DELPHI_9_UP}
+ {$define CPPB_3_UP}
+ {$define CPPB_4_UP}
+ {$define CPPB_5_UP}
+ {$define CPPB_6_UP}
+
+
+ {$ifdef BCB}
+ {$define CPPB}
+ {$else}
+ {$define DELPHI}
+ {$endif}
+
+
+{$endif}
+
+
+{$ifdef COMPILER_16}
+ {$define COMPILER_1_UP}
+ {$define COMPILER_2_UP}
+ {$define COMPILER_3_UP}
+ {$define COMPILER_4_UP}
+ {$define COMPILER_5_UP}
+ {$define COMPILER_6_UP}
+ {$define COMPILER_7_UP}
+ {$define COMPILER_8_UP}
+ {$define COMPILER_9_UP}
+ {$define COMPILER_10_UP}
+ {$define COMPILER_11_UP}
+ {$define COMPILER_12_UP}
+ {$define COMPILER_14_UP}
+ {$define COMPILER_15_UP}
+ {$define COMPILER_16_UP}
+ // Backwards compatibility
+ {$define DELPHI_2_UP}
+ {$define DELPHI_3_UP}
+ {$define DELPHI_4_UP}
+ {$define DELPHI_5_UP}
+ {$define DELPHI_6_UP}
+ {$define DELPHI_7_UP}
+ {$define DELPHI_8_UP}
+ {$define DELPHI_9_UP}
+ {$define CPPB_3_UP}
+ {$define CPPB_4_UP}
+ {$define CPPB_5_UP}
+ {$define CPPB_6_UP}
+
+
+ {$ifdef BCB}
+ {$define CPPB}
+ {$else}
+ {$define DELPHI}
+ {$endif}
+
+
+{$endif}
+
+{$UNDEF AllowInline}
+{$IFDEF FPC}
+ {$DEFINE AllowInline}
+{$ELSE}
+ {$IFDEF COMPILER_15_UP}
+ {$DEFINE AllowInline}
+ {$ENDIF}
+{$ENDIF}
diff --git a/plugins/Utils.pas/dbsettings.pas b/plugins/Utils.pas/dbsettings.pas new file mode 100644 index 0000000000..9c8578b225 --- /dev/null +++ b/plugins/Utils.pas/dbsettings.pas @@ -0,0 +1,481 @@ +{$DEFINE UseCore}
+{$INCLUDE compilers.inc}
+unit dbsettings;
+interface
+
+uses windows,m_api;
+
+function DBReadByte (hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;default:byte =0):byte;
+function DBReadWord (hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;default:word =0):word;
+function DBReadDWord(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;default:dword=0):dword;
+
+function DBReadSetting (hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;dbv:PDBVARIANT):int_ptr;
+function DBReadSettingStr(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;dbv:PDBVARIANT):int_ptr;
+
+function DBReadStringLength(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar):integer;
+function DBReadString (hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;
+ default:PAnsiChar=nil;enc:integer=DBVT_ASCIIZ):PAnsiChar;
+function DBReadUTF8 (hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;default:PAnsiChar=nil):PAnsiChar;
+function DBReadUnicode(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;default:PWideChar=nil):PWideChar;
+
+function DBReadStruct (hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;
+ ptr:pointer;size:dword):Integer;
+function DBWriteStruct(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;
+ ptr:pointer;size:dword):Integer;
+
+function DBWriteSetting(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;dbv:PDBVARIANT):int_ptr;
+function DBWriteByte (hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;val:Byte ):int_ptr;
+function DBWriteWord (hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;val:Word ):int_ptr;
+function DBWriteDWord(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;val:dword):int_ptr;
+
+function DBWriteString (hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;
+ val:PAnsiChar;enc:integer=DBVT_ASCIIZ):int_ptr;
+function DBWriteUTF8 (hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;val:PAnsiChar):int_ptr;
+function DBWriteUnicode(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;val:PWideChar):int_ptr;
+
+function DBFreeVariant(dbv:PDBVARIANT):int_ptr;
+function DBDeleteSetting(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar):int_ptr;
+
+function DBDeleteGroup(hContact:THANDLE;szModule:PAnsiChar;prefix:pAnsiChar=nil):int_ptr;
+
+function DBDeleteModule(szModule:PAnsiChar):integer; // 0.8.0+
+
+function DBGetSettingType(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar):integer;
+
+implementation
+
+uses common;
+
+function DBReadByte(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;default:byte=0):byte;
+{$IFDEF UseCore}
+ {$IFDEF AllowInline}inline;{$ENDIF}
+begin
+ result:=db_get_b(hContact, szModule, szSetting, default);
+end;
+{$ELSE}
+var
+ dbv:TDBVARIANT;
+ cgs:TDBCONTACTGETSETTING;
+begin
+ cgs.szModule :=szModule;
+ cgs.szSetting:=szSetting;
+ cgs.pValue :=@dbv;
+ If CallService(MS_DB_CONTACT_GETSETTING,hContact,lParam(@cgs))<>0 then
+ Result:=default
+ else
+ Result:=dbv.bVal;
+end;
+{$ENDIF}
+
+function DBReadWord(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;default:word=0):word;
+{$IFDEF UseCore}
+ {$IFDEF AllowInline}inline;{$ENDIF}
+begin
+ result:=db_get_w(hContact, szModule, szSetting, default);
+end;
+{$ELSE}
+var
+ dbv:TDBVARIANT;
+ cgs:TDBCONTACTGETSETTING;
+begin
+ cgs.szModule :=szModule;
+ cgs.szSetting:=szSetting;
+ cgs.pValue :=@dbv;
+ If CallService(MS_DB_CONTACT_GETSETTING,hContact,lParam(@cgs))<>0 then
+ Result:=default
+ else
+ Result:=dbv.wVal;
+end;
+{$ENDIF}
+
+function DBReadDWord(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;default:dword=0):dword;
+{$IFDEF UseCore}
+ {$IFDEF AllowInline}inline;{$ENDIF}
+begin
+ result:=db_get_dw(hContact, szModule, szSetting, default);
+end;
+{$ELSE}
+var
+ dbv:TDBVARIANT;
+ cgs:TDBCONTACTGETSETTING;
+begin
+ cgs.szModule :=szModule;
+ cgs.szSetting:=szSetting;
+ cgs.pValue :=@dbv;
+ If CallService(MS_DB_CONTACT_GETSETTING,hContact,lParam(@cgs))<>0 then
+ Result:=default
+ else
+ Result:=dbv.dVal;
+end;
+{$ENDIF}
+
+function DBReadSetting(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;dbv:PDBVARIANT):int_ptr;
+{$IFDEF UseCore}
+ {$IFDEF AllowInline}inline;{$ENDIF}
+begin
+ result:=db_get(hContact, szModule, szSetting, dbv);
+end;
+{$ELSE}
+var
+ cgs:TDBCONTACTGETSETTING;
+begin
+ cgs.szModule :=szModule;
+ cgs.szSetting:=szSetting;
+ cgs.pValue :=dbv;
+ Result:=CallService(MS_DB_CONTACT_GETSETTING,hContact,lParam(@cgs));
+end;
+{$ENDIF}
+
+function DBReadSettingStr(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;dbv:PDBVARIANT):int_ptr;
+var
+ cgs:TDBCONTACTGETSETTING;
+begin
+ cgs.szModule :=szModule;
+ cgs.szSetting:=szSetting;
+ cgs.pValue :=dbv;
+ Result:=CallService(MS_DB_CONTACT_GETSETTING_STR,hContact,lParam(@cgs));
+end;
+
+function DBReadStringLength(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar):integer;
+var
+ cgs:TDBCONTACTGETSETTING;
+ dbv:TDBVARIANT;
+ i:int_ptr;
+begin
+ FillChar(dbv,SizeOf(dbv),0);
+ cgs.szModule :=szModule;
+ cgs.szSetting:=szSetting;
+ cgs.pValue :=@dbv;
+ i:=CallService(MS_DB_CONTACT_GETSETTING_STR,hContact,lParam(@cgs));
+ if (i<>0) or (dbv.szVal.a=nil) or (dbv.szVal.a^=#0) then
+ result:=0
+ else
+ result:=lstrlena(dbv.szVal.a);
+//!! if i=0 then
+ DBFreeVariant(@dbv);
+end;
+
+function DBReadString(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;
+ default:PAnsiChar=nil;enc:integer=DBVT_ASCIIZ):PAnsiChar;
+var
+ cgs:TDBCONTACTGETSETTING;
+ dbv:TDBVARIANT;
+ i:int_ptr;
+begin
+ FillChar(dbv,SizeOf(dbv),0);
+ cgs.szModule :=szModule;
+ cgs.szSetting:=szSetting;
+ cgs.pValue :=@dbv;
+ dbv._type :=enc;
+ i:=CallService(MS_DB_CONTACT_GETSETTING_STR,hContact,lParam(@cgs));
+ if i=0 then
+ default:=dbv.szVal.a;
+
+ if (default=nil) or (default^=#0) then
+ result:=nil
+ else
+ StrDup(result,default);
+
+//!! if i=0 then
+ DBFreeVariant(@dbv);
+end;
+
+function DBReadUTF8(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;default:PAnsiChar=nil):PAnsiChar;
+begin
+ result:=DBReadString(hContact,szModule,szSetting,default,DBVT_UTF8);
+end;
+
+function DBReadUnicode(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;default:PWideChar=nil):PWideChar;
+var
+ cgs:TDBCONTACTGETSETTING;
+ dbv:TDBVARIANT;
+ i:int_ptr;
+begin
+ FillChar(dbv,SizeOf(dbv),0);
+ cgs.szModule :=szModule;
+ cgs.szSetting:=szSetting;
+ cgs.pValue :=@dbv;
+ dbv._type :=DBVT_WCHAR;
+ i:=CallService(MS_DB_CONTACT_GETSETTING_STR,hContact,lParam(@cgs));
+ if i=0 then
+ default:=dbv.szVal.w;
+
+ if (default=nil) or (default^=#0) then
+ result:=nil
+ else
+ StrDupW(result,default);
+
+//!! if i=0 then
+ DBFreeVariant(@dbv);
+end;
+
+function DBReadStruct(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;
+ ptr:pointer;size:dword):Integer;
+var
+ dbv:TDBVariant;
+begin
+ FillChar(dbv,SizeOf(dbv),0);
+ dbv._type:=DBVT_BLOB;
+ dbv.pbVal:=nil;
+ if (DBReadSetting(0,szModule,szSetting,@dbv)=0) and
+ (dbv.pbVal<>nil) and (dbv.cpbVal=size) then
+ begin
+ move(dbv.pbVal^,ptr^,size);
+ DBFreeVariant(@dbv);
+ result:=1;
+ end
+ else
+ result:=0;
+end;
+
+function DBWriteStruct(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;
+ ptr:pointer;size:dword):Integer;
+{$IFDEF UseCore}
+ {$IFDEF AllowInline}inline;{$ENDIF}
+begin
+ result:=db_set_blob(hContact, szModule, szSetting, ptr, size);
+end;
+{$ELSE}
+var
+ cws:TDBCONTACTWRITESETTING;
+begin
+ cws.szModule :=szModule;
+ cws.szSetting :=szSetting;
+ cws.value._type :=DBVT_BLOB;
+ cws.value.pbVal :=ptr;
+ cws.value.cpbVal:=size;
+ result:=CallService(MS_DB_CONTACT_WRITESETTING,0,lParam(@cws));
+end;
+{$ENDIF}
+
+function DBWriteSetting(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;dbv:PDBVARIANT):int_ptr;
+var
+ cws: TDBCONTACTWRITESETTING;
+begin
+ cws.szModule :=szModule;
+ cws.szSetting :=szSetting;
+ move(dbv^,cws.value,SizeOf(TDBVARIANT));
+ Result := CallService(MS_DB_CONTACT_WRITESETTING, hContact, lParam(@cws));
+end;
+
+function DBWriteByte(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;val:Byte):int_ptr;
+{$IFDEF UseCore}
+ {$IFDEF AllowInline}inline;{$ENDIF}
+begin
+ result:=db_set_b(hContact, szModule, szSetting, val);
+end;
+{$ELSE}
+var
+ cws:TDBCONTACTWRITESETTING;
+begin
+ cws.szModule :=szModule;
+ cws.szSetting :=szSetting;
+ cws.value._type:=DBVT_BYTE;
+ cws.value.bVal :=val;
+ Result:=CallService(MS_DB_CONTACT_WRITESETTING,hContact,lParam(@cws));
+end;
+{$ENDIF}
+
+function DBWriteWord(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;val:Word):int_ptr;
+{$IFDEF UseCore}
+ {$IFDEF AllowInline}inline;{$ENDIF}
+begin
+ result:=db_set_w(hContact, szModule, szSetting, val);
+end;
+{$ELSE}
+var
+ cws:TDBCONTACTWRITESETTING;
+begin
+ cws.szModule :=szModule;
+ cws.szSetting :=szSetting;
+ cws.value._type:=DBVT_WORD;
+ cws.value.wVal :=val;
+ Result:=CallService(MS_DB_CONTACT_WRITESETTING,hContact,lParam(@cws));
+end;
+{$ENDIF}
+
+function DBWriteDWord(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;val:dword):int_ptr;
+{$IFDEF UseCore}
+ {$IFDEF AllowInline}inline;{$ENDIF}
+begin
+ result:=db_set_dw(hContact, szModule, szSetting, val);
+end;
+{$ELSE}
+var
+ cws:TDBCONTACTWRITESETTING;
+begin
+ cws.szModule :=szModule;
+ cws.szSetting :=szSetting;
+ cws.value._type:=DBVT_DWORD;
+ cws.value.dVal :=val;
+ Result:=CallService(MS_DB_CONTACT_WRITESETTING,hContact,lParam(@cws));
+end;
+{$ENDIF}
+
+function DBWriteString(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;
+ val:PAnsiChar;enc:integer=DBVT_ASCIIZ):int_ptr;
+{$IFDEF UseCore}
+ {$IFDEF AllowInline}inline;{$ENDIF}
+begin
+ result:=db_set_s(hContact, szModule, szSetting, val);
+end;
+{$ELSE}
+var
+ cws:TDBCONTACTWRITESETTING;
+ p:dword;
+begin
+ cws.szModule :=szModule;
+ cws.szSetting :=szSetting;
+ cws.value._type :=enc;
+ if val=nil then
+ begin
+ p:=0;
+ val:=@p;
+ end;
+ cws.value.szVal.a:=val;
+ Result:=CallService(MS_DB_CONTACT_WRITESETTING,hContact,lParam(@cws));
+end;
+{$ENDIF}
+
+function DBWriteUTF8(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;val:PAnsiChar):int_ptr;
+{$IFDEF UseCore}
+ {$IFDEF AllowInline}inline;{$ENDIF}
+begin
+ result:=db_set_utf(hContact, szModule, szSetting, val);
+end;
+{$ELSE}
+begin
+ result:=DBWriteString(hContact,szModule,szSetting,val,DBVT_UTF8);
+end;
+{$ENDIF}
+
+function DBWriteUnicode(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;val:PWideChar):int_ptr;
+{$IFDEF UseCore}
+ {$IFDEF AllowInline}inline;{$ENDIF}
+begin
+ result:=db_set_ws(hContact, szModule, szSetting, val);
+end;
+{$ELSE}
+begin
+ result:=DBWriteString(hContact,szModule,szSetting,PAnsiChar(val),DBVT_WCHAR);
+{
+var
+ cws:TDBCONTACTWRITESETTING;
+begin
+ cws.szModule :=szModule;
+ cws.szSetting :=szSetting;
+ cws.value._type :=DBVT_WCHAR;
+ cws.value.szVal.w:=Val;
+ Result:=CallService(MS_DB_CONTACT_WRITESETTING,hContact,lParam(@cws));
+}
+end;
+{$ENDIF}
+
+function DBFreeVariant(dbv:PDBVARIANT):int_ptr;
+{$IFDEF UseCore}
+ {$IFDEF AllowInline}inline;{$ENDIF}
+begin
+ result:=db_free(dbv);
+end;
+{$ELSE}
+begin
+ Result:=CallService(MS_DB_CONTACT_FREEVARIANT,0,lParam(dbv));
+end;
+{$ENDIF}
+
+function DBDeleteSetting(hContact:THandle;szModule:PAnsiChar;szSetting:PAnsiChar):int_ptr;
+{$IFDEF UseCore}
+ {$IFDEF AllowInline}inline;{$ENDIF}
+begin
+ result:=db_unset(hContact, szModule, szSetting);
+end;
+{$ELSE}
+var
+ cgs:TDBCONTACTGETSETTING;
+begin
+ cgs.szModule :=szModule;
+ cgs.szSetting:=szSetting;
+ Result:=CallService(MS_DB_CONTACT_DELETESETTING,hContact,lParam(@cgs));
+end;
+{$ENDIF}
+
+type
+ ppchar = ^pAnsiChar;
+
+function EnumSettingsProc(const szSetting:PAnsiChar;lParam:LPARAM):int; cdecl;
+begin
+ lstrcpya(ppchar(lParam)^,szSetting);
+ while ppchar(lParam)^^<>#0 do inc(ppchar(lParam)^);
+ inc(ppchar(lParam)^);
+ result:=0;
+end;
+function EnumSettingsProcCalc(const szSetting:PAnsiChar;lParam:LPARAM):int; cdecl;
+begin
+ inc(pint_ptr(lParam)^,lstrlena(szSetting)+1);
+ result:=0;
+end;
+
+function DBDeleteGroup(hContact:THANDLE;szModule:PAnsiChar;prefix:pAnsiChar=nil):int_ptr;
+var
+ ces:TDBCONTACTENUMSETTINGS;
+ cgs:TDBCONTACTGETSETTING;
+ p:PAnsiChar;
+ num,len:integer;
+ ptr:pAnsiChar;
+begin
+ ces.szModule:=szModule;
+ num:=0;
+
+ ces.pfnEnumProc:=@EnumSettingsProcCalc;
+ ces.lParam :=lParam(@num);
+ ces.ofsSettings:=0;
+ CallService(MS_DB_CONTACT_ENUMSETTINGS,hContact,lparam(@ces));
+
+ GetMem(p,num+1);
+ ptr:=p;
+ ces.pfnEnumProc:=@EnumSettingsProc;
+ ces.lParam :=lparam(@ptr);
+ ces.ofsSettings:=0;
+ result:=CallService(MS_DB_CONTACT_ENUMSETTINGS,hContact,lparam(@ces));
+ ptr^:=#0;
+
+ cgs.szModule:=szModule;
+ ptr:=p;
+ if (prefix<>nil) and (prefix^<>#0) then
+ len:=StrLen(prefix)
+ else
+ len:=0;
+ while ptr^<>#0 do
+ begin
+ if (len=0) or (StrCmp(prefix,ptr,len)=0) then
+ begin
+ cgs.szSetting:=ptr;
+ CallService(MS_DB_CONTACT_DELETESETTING,hContact,lParam(@cgs));
+ end;
+ while ptr^<>#0 do inc(ptr);
+ inc(ptr);
+ end;
+ FreeMem(p);
+end;
+
+function DBDeleteModule(szModule:PAnsiChar):integer; // 0.8.0+
+begin
+ result:=0;
+ CallService(MS_DB_MODULE_DELETE,0,lParam(szModule));
+end;
+
+function DBGetSettingType(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar):integer;
+var
+ ldbv:TDBVARIANT;
+begin
+ if DBReadSetting(hContact,szModule,szSetting,@ldbv)=0 then
+ begin
+ result:=ldbv._type;
+ DBFreeVariant(@ldbv);
+ end
+ else
+ result:=DBVT_DELETED;
+end;
+
+begin
+end.
diff --git a/plugins/Utils.pas/i_card_const.inc b/plugins/Utils.pas/i_card_const.inc new file mode 100644 index 0000000000..ee0e153a28 --- /dev/null +++ b/plugins/Utils.pas/i_card_const.inc @@ -0,0 +1,16 @@ +{resource constants}
+const
+ // dialogs
+// IDD_HELP = 1126;
+
+// Help dialog
+ IDC_HLP_SERVICE = 1025;
+ IDC_HLP_ALIAS = 1026;
+ IDC_HLP_PLUGIN = 1027;
+ IDC_HLP_WPARAM = 1028;
+ IDC_HLP_WPARAML = 1128;
+ IDC_HLP_LPARAM = 1029;
+ IDC_HLP_LPARAML = 1129;
+ IDC_HLP_RETURN = 1030;
+ IDC_HLP_EFFECT = 1031;
+ IDC_HLP_NOTE = 1040;
diff --git a/plugins/Utils.pas/i_struct_const.inc b/plugins/Utils.pas/i_struct_const.inc new file mode 100644 index 0000000000..00e0b9324e --- /dev/null +++ b/plugins/Utils.pas/i_struct_const.inc @@ -0,0 +1,44 @@ +{resource constants}
+const
+ // dialogs
+// IDD_STRUCTURE = 1027;
+// IDD_HELP = 1028;
+
+ // icons
+// IDI_NEW = 1125;
+// IDI_UP = 1126;
+// IDI_DOWN = 1127;
+// IDI_DELETE = 1128;
+
+ // Structure editor
+ IDC_DATA_FULL = 2001;
+ IDC_DATA_TYPE = 2002;
+ IDC_DATA_EDIT = 2005;
+ IDC_DATA_LEN = 2006;
+ IDC_DATA_HELP = 2007;
+
+ IDC_DATA_NEW = 2008;
+ IDC_DATA_DELETE = 2009;
+ IDC_DATA_UP = 2010;
+ IDC_DATA_DOWN = 2011;
+ IDC_DATA_CHANGE = 2012;
+ IDC_DATA_VARS = 2013;
+ IDC_DATA_ALIGN = 2014;
+ IDC_DATA_MMI = 2015;
+
+ IDC_DATA_SALGN = 2016;
+ IDC_DATA_SEP = 2017;
+ IDC_DATA_EDTN = 2018;
+
+ IDC_DATA_TMPL = 2019;
+ IDC_DATA_INFO = 2020;
+ IDC_DATA_PASTE = 2021;
+
+ IDC_DATA_SLEN = 2022;
+ IDC_VAR_HELP = 2023;
+
+ // Structure helper
+ IDC_HLP_NAME = 2030;
+ IDC_HLP_PLUGIN = 2031;
+ IDC_HLP_DESCR = 2032;
+ IDC_HLP_STRUCT = 2033;
diff --git a/plugins/Utils.pas/icobuttons.pas b/plugins/Utils.pas/icobuttons.pas new file mode 100644 index 0000000000..fdac39e69e --- /dev/null +++ b/plugins/Utils.pas/icobuttons.pas @@ -0,0 +1,392 @@ +unit IcoButtons;
+
+interface
+
+uses windows, KOL;
+
+const
+ AST_NORMAL = 0;
+ AST_HOVERED = 1;
+ AST_PRESSED = 2;
+
+type
+ tGetIconProc = function(action:integer;stat:integer=AST_NORMAL):cardinal;
+ tActionProc = function(action:integer):integer;
+
+type
+ pIcoButton = ^tIcoButton;
+ tIcoButton = object(TControl)
+ private
+ function GetGetIconProc:tGetIconProc;
+ procedure SetGetIconProc (val:tGetIconProc);
+ procedure SetDoActionProc(val:tActionProc);
+ procedure SetCheckFlag(val:boolean);
+ function GetCheckFlag:boolean;
+ procedure SetAction(val:integer);
+ function GetAction:integer;
+ function GetState:integer;
+ procedure myPaint(Sender: PControl; DC: HDC);
+ procedure myMouseDown (Sender:PControl; var Mouse:TMouseEventData);
+ procedure myMouseUp (Sender:PControl; var Mouse:TMouseEventData);
+ procedure myMouseEnter(Sender: PObj);
+ procedure myMouseLeave(Sender: PObj);
+ procedure myCtrlBtnClick(Sender: PObj);
+ public
+
+ procedure RefreshIcon;
+ property GetIconProc : tGetIconProc read GetGetIconProc write SetGetIconProc;
+ property DoActionProc: tActionProc write SetDoActionProc;
+
+ property AsCheckbox: boolean read GetCheckFlag write SetCheckFlag;
+ property Action : integer read GetAction write SetAction;
+ property State : integer read GetState;
+ end;
+
+function CreateIcoButton(AOwner: PControl; pGetIconProc:tGetIconProc;
+ pActionProc:tActionProc; action:integer=0; repeattime:integer=0):pIcoButton;
+
+function CreateIcoButtonHandle(AOwner: PControl; pActionProc:tActionProc;
+ ico_normal:HICON; ico_hovered:HICON=0; ico_pressed:HICON=0;
+ action:integer=0; repeattime:integer=0):pIcoButton;
+
+implementation
+
+uses messages;
+
+type
+ pIcoBtnData = ^tIcoBtnData;
+ tIcoBtnData = record
+ rptvalue:cardinal;
+ rpttimer:cardinal;
+ checking: boolean;
+
+ ico_normal :PIcon;
+ ico_hovered:PIcon;
+ ico_pressed:PIcon;
+ active :PIcon; // one of ico_*
+
+ Action:integer;
+
+ GetIcon : tGetIconProc;
+ DoAction: tActionProc;
+ end;
+
+function tIcoButton.GetGetIconProc:tGetIconProc;
+begin
+ result:=pIcoBtnData(CustomData).GetIcon;
+end;
+
+procedure tIcoButton.SetGetIconProc(val:tGetIconProc);
+begin
+ pIcoBtnData(CustomData).GetIcon:=val;
+end;
+
+procedure tIcoButton.SetDoActionProc(val:tActionProc);
+begin
+ pIcoBtnData(CustomData).DoAction:=val;
+end;
+
+procedure tIcoButton.SetCheckFlag(val:boolean);
+begin
+ pIcoBtnData(CustomData).checking:=val;
+end;
+
+function tIcoButton.GetCheckFlag:boolean;
+begin
+ result:=pIcoBtnData(CustomData).checking;
+end;
+
+procedure tIcoButton.SetAction(val:integer);
+begin
+ pIcoBtnData(CustomData).Action:=val;
+end;
+
+function tIcoButton.GetAction:integer;
+begin
+ result:=pIcoBtnData(CustomData).Action;
+end;
+
+function tIcoButton.GetState:integer;
+begin
+ with pIcoBtnData(CustomData)^ do
+ if active=ico_pressed then result:=AST_PRESSED
+ else if active=ico_hovered then result:=AST_HOVERED
+ else {if active=ico_normal then}result:=AST_NORMAL;
+end;
+
+procedure tIcoButton.myCtrlBtnClick(Sender: PObj);
+var
+ D: PIcoBtnData;
+begin
+ D:=PControl(Sender).CustomData;
+ if @D.DoAction<>nil then
+ D.DoAction(D.action);
+end;
+
+procedure tIcoButton.myMouseEnter(Sender: PObj);
+var
+ D: PIcoBtnData;
+begin
+ D:=PControl(Sender).CustomData;
+ if D.ico_hovered<>nil then
+ begin
+ D.active:=D.ico_hovered;
+ PControl(Sender).Update;
+// PControl(Sender).Parent.Update; //??
+ end;
+end;
+
+procedure tIcoButton.myMouseLeave(Sender: PObj);
+var
+ D: PIcoBtnData;
+begin
+ D:=PControl(Sender).CustomData;
+ if D.active=D.ico_hovered then //!!!! for case when mouse button pressed and mouse moved
+ D.active:=D.ico_normal;
+ PControl(Sender).Update;
+// PControl(Sender).Parent.Update; //??
+end;
+
+procedure TimerProc(wnd:HWND;uMsg:uint;idEvent:uint_ptr;dwTime:dword); stdcall;
+begin
+ PControl(IdEvent).OnClick(PControl(IdEvent));
+end;
+
+procedure tIcoButton.myMouseDown(Sender:PControl; var Mouse:TMouseEventData);
+var
+ D: PIcoBtnData;
+begin
+ if Mouse.Button<>mbLeft then exit;
+ D:=Sender.CustomData;
+ if D.checking then
+ begin
+ if D.active=D.ico_pressed then
+ D.active:=D.ico_normal
+ else
+ D.active:=D.ico_pressed;
+ end
+ else
+ begin
+ if D.ico_pressed<>nil then
+ D.active:=D.ico_pressed
+ else
+ Sender.SetPosition(Sender.Position.X-2,Sender.Position.Y-2);
+
+ if D.rptvalue<>0 then
+ begin
+ D.rpttimer:=SetTimer(Sender.Handle,dword(Sender),D.rptvalue,@TimerProc);
+// D.rpttimer:=SetTimer(Sender.GetWindowHandle,1,D.rptvalue,nil);
+ end;
+ end;
+ Sender.Update;
+end;
+
+procedure tIcoButton.myMouseUp(Sender:PControl; var Mouse:TMouseEventData);
+var
+ D: PIcoBtnData;
+ tp:TPOINT;
+begin
+ if Mouse.Button<>mbLeft then exit;
+ D:=Sender.CustomData;
+ if not D.checking then
+ begin
+ if D.rpttimer<>0 then
+ begin
+ KillTimer(Sender.Handle,D.rpttimer);
+ D.rpttimer:=0;
+ end;
+
+ if D.ico_pressed<>nil then
+ begin
+ tp.X:=Mouse.X;
+ tp.Y:=Mouse.Y;
+ // mouse still above button?
+ if (D.ico_hovered<>nil) and PtInRect(Sender.BoundsRect,tp) then
+ D.active:=D.ico_hovered
+ else
+ D.active:=D.ico_normal;
+ end
+ else
+ Sender.SetPosition(Sender.Position.X+2,Sender.Position.Y+2);
+ Sender.Update;
+ end;
+end;
+
+procedure Destroy(dummy:PControl;sender:PObj);
+var
+ D: PIcoBtnData;
+begin
+ D:=pIcoButton(sender).CustomData;
+ D.ico_normal.Free;
+ if D.ico_hovered<>nil then D.ico_hovered.Free;
+ if D.ico_pressed<>nil then D.ico_pressed.Free;
+
+ if D.rpttimer<>0 then
+ begin
+ KillTimer(0,D.rpttimer);
+ D.rpttimer:=0;
+ end;
+end;
+
+procedure tIcoButton.RefreshIcon;
+var
+ D: PIcoBtnData;
+begin
+ D:=CustomData;
+ if @D.GetIcon=nil then exit;
+
+ D.ico_normal.Handle:=D.GetIcon(D.action,AST_NORMAL);
+ D.ico_normal.ShareIcon:=true;
+ if D.ico_hovered<>nil then
+ begin
+ D.ico_hovered.Handle:=D.GetIcon(D.action,AST_HOVERED);
+ D.ico_hovered.ShareIcon:=true;
+ end;
+ if D.ico_pressed<>nil then
+ begin
+ D.ico_pressed.Handle:=D.GetIcon(D.action,AST_PRESSED);
+ D.ico_pressed.ShareIcon:=true;
+ end;
+end;
+
+procedure tIcoButton.myPaint(Sender: PControl; DC: HDC);
+var
+ D: PIcoBtnData;
+begin
+ D:=Sender.CustomData;
+ D.active.Draw(DC,0,0);
+end;
+
+function CreateIcoButton(AOwner: PControl; pGetIconProc:tGetIconProc;
+ pActionProc:tActionProc; action:integer=0; repeattime:integer=0):pIcoButton;
+var
+ ico:HICON;
+ D: PIcoBtnData;
+begin
+ // first, checking what icons are available
+ ico:=pGetIconProc(action,AST_NORMAL);
+ if ico=0 then
+ begin
+ result:=nil;
+ exit;
+ end;
+
+ Result:=pIcoButton(NewBitBtn(AOwner,'',[bboNoBorder,bboNoCaption],glyphOver,0,0));
+ if result=nil then exit;
+
+ Result.LikeSpeedButton.Flat:=true;
+ Result.Transparent:=true;
+
+ GetMem(D,SizeOf(TIcoBtnData));
+ Result.CustomData:=D;
+
+ Result.OnMouseDown :=Result.myMouseDown;
+ Result.OnMouseUp :=Result.myMouseUp;
+ Result.OnMouseEnter:=Result.myMouseEnter;
+ Result.OnMouseLeave:=Result.myMouseLeave;
+ Result.OnClick :=Result.myCtrlBtnClick;
+ Result.OnPaint :=Result.myPaint;
+
+ Result.AsCheckbox:=false;
+ Result.action:=action;
+
+ D.rptvalue:=repeattime;
+ D.rpttimer:=0;
+
+ Result.DoActionProc:=pActionProc;
+ Result.GetIconProc :=pGetIconProc;
+
+ D.ico_normal:=NewIcon;
+ D.ico_normal.Handle :=ico;
+ D.ico_normal.ShareIcon:=true;
+ D.active:=D.ico_normal;
+
+ ico:=D.GetIcon(action,AST_HOVERED);
+ if ico<>0 then
+ begin
+ D.ico_hovered:=NewIcon;
+ D.ico_hovered.Handle :=ico;
+ D.ico_hovered.ShareIcon:=true;
+ end
+ else
+ D.ico_hovered:=nil;
+ ico:=D.GetIcon(action,AST_PRESSED);
+ if ico<>0 then
+ begin
+ D.ico_pressed:=NewIcon;
+ D.ico_pressed.Handle :=ico;
+ D.ico_pressed.ShareIcon:=true;
+ end
+ else
+ D.ico_pressed:=nil;
+
+ Result.SetSize(16,16);
+ Result.SetPosition(0,0);
+ Result.OnDestroy:=TOnEvent(MakeMethod(nil,@DEstroy));
+end;
+
+function CreateIcoButtonHandle(AOwner: PControl; pActionProc:tActionProc;
+ ico_normal:HICON; ico_hovered:HICON=0; ico_pressed:HICON=0;
+ action:integer=0; repeattime:integer=0):pIcoButton;
+var
+ D: PIcoBtnData;
+begin
+ if ico_normal=0 then
+ begin
+ result:=nil;
+ exit;
+ end;
+
+ Result:=pIcoButton(NewBitBtn(AOwner,'',[bboNoBorder,bboNoCaption],glyphOver,0,0));
+ if result=nil then exit;
+ Result.LikeSpeedButton.Flat:=true;
+ Result.Transparent:=true;
+
+ GetMem(D,SizeOf(TIcoBtnData));
+ Result.CustomData:=D;
+
+ Result.OnMouseDown :=Result.myMouseDown;
+ Result.OnMouseUp :=Result.myMouseUp;
+ Result.OnMouseEnter:=Result.myMouseEnter;
+ Result.OnMouseLeave:=Result.myMouseLeave;
+ Result.OnClick :=Result.myCtrlBtnClick;
+ Result.OnPaint :=Result.myPaint;
+
+ Result.AsCheckbox:=false;
+ Result.action:=action;
+
+ D.rptvalue:=repeattime;
+ D.rpttimer:=0;
+
+ Result.GetIconProc :=nil;
+ Result.DoActionProc:=pActionProc;
+
+ D.ico_normal:=NewIcon;
+ D.ico_normal.Handle :=ico_normal;
+ D.ico_normal.ShareIcon:=true;
+ D.active:=D.ico_normal;
+
+ if ico_hovered<>0 then
+ begin
+ D.ico_hovered:=NewIcon;
+ D.ico_hovered.Handle :=ico_hovered;
+ D.ico_hovered.ShareIcon:=true;
+ end
+ else
+ D.ico_hovered:=nil;
+
+ if ico_pressed<>0 then
+ begin
+ D.ico_pressed:=NewIcon;
+ D.ico_pressed.Handle :=ico_pressed;
+ D.ico_pressed.ShareIcon:=true;
+ end
+ else
+ D.ico_pressed:=nil;
+
+ Result.SetSize(16,16);
+ Result.SetPosition(0,0);
+ Result.OnDestroy:=TOnEvent(MakeMethod(nil,@Destroy));
+end;
+
+end.
diff --git a/plugins/Utils.pas/io.pas b/plugins/Utils.pas/io.pas new file mode 100644 index 0000000000..9a587c660f --- /dev/null +++ b/plugins/Utils.pas/io.pas @@ -0,0 +1,249 @@ +unit io;
+
+interface
+uses windows;
+
+function Reset (fname:PWideChar):THANDLE; overload;
+function Reset (fname:PAnsiChar):THANDLE; overload;
+function ReWrite(fname:PWideChar):THANDLE; overload;
+function ReWrite(fname:PAnsiChar):THANDLE; overload;
+function Append (fname:PWideChar):THANDLE; overload;
+function Append (fname:PAnsiChar):THANDLE; overload;
+
+function GetFSize(name:PWideChar):dword; overload;
+function GetFSize(name:PAnsiChar):dword; overload;
+function FileExists(fname:PAnsiChar):Boolean; overload;
+function FileExists(fname:PWideChar):Boolean; overload;
+
+function Skip(f:THANDLE;count:integer):integer;
+function Seek(f:THANDLE;pos:integer):integer;
+function FilePos(f:THANDLE):dword;
+function FileSize(f:THANDLE):dword;
+function Eof(f:THANDLE):boolean;
+
+function BlockRead (f:THANDLE;var buf;size:integer):dword;
+function BlockWrite(f:THANDLE;var buf;size:integer):dword;
+
+function ForceDirectories(path:PAnsiChar):boolean; overload;
+function ForceDirectories(path:PWideChar):boolean; overload;
+function DirectoryExists(Directory:PAnsiChar):Boolean; overload;
+function DirectoryExists(Directory:PWideChar):Boolean; overload;
+
+implementation
+
+function Reset(fname:PWideChar):THANDLE;
+begin
+ result:=CreateFileW(fname,GENERIC_READ,FILE_SHARE_READ+FILE_SHARE_WRITE,nil,OPEN_EXISTING,0,0);
+end;
+
+function Reset(fname:PAnsiChar):THANDLE;
+begin
+ result:=CreateFileA(fname,GENERIC_READ,FILE_SHARE_READ+FILE_SHARE_WRITE,nil,OPEN_EXISTING,0,0);
+end;
+
+function Append(fname:PWideChar):THANDLE;
+begin
+ result:=CreateFileW(fname,GENERIC_WRITE,FILE_SHARE_READ,nil,OPEN_ALWAYS,0,0);
+ SetFilePointer(result,0,nil,FILE_END);
+end;
+
+function Append(fname:PAnsiChar):THANDLE;
+begin
+ result:=CreateFileA(fname,GENERIC_WRITE,FILE_SHARE_READ,nil,OPEN_ALWAYS,0,0);
+ SetFilePointer(result,0,nil,FILE_END);
+end;
+
+function ReWrite(fname:PWideChar):THANDLE; overload;
+begin
+ result:=CreateFileW(fname,GENERIC_WRITE,FILE_SHARE_READ,nil,CREATE_ALWAYS,0,0);
+end;
+
+function ReWrite(fname:PAnsiChar):THANDLE; overload;
+begin
+ result:=CreateFileA(fname,GENERIC_WRITE,FILE_SHARE_READ,nil,CREATE_ALWAYS,0,0);
+end;
+
+function Skip(f:THANDLE;count:integer):integer;
+begin
+ result:=SetFilePointer(f,count,nil,FILE_CURRENT);
+end;
+
+function Eof(f:THANDLE):boolean;
+begin
+ result:=FilePos(f)>=FileSize(f);
+end;
+
+function Seek(f:THANDLE;pos:integer):integer;
+begin
+ result:=SetFilePointer(f,pos,nil,FILE_BEGIN);
+end;
+
+function FilePos(f:THANDLE):dword;
+begin
+ result:=SetFilePointer(f,0,nil,FILE_CURRENT);
+end;
+
+function FileSize(f:THANDLE):dword;
+begin
+ result:=GetFileSize(f,nil);
+end;
+
+function BlockRead(f:THANDLE;var buf;size:integer):dword;
+begin
+ ReadFile(f,buf,size,result,nil);
+end;
+
+function BlockWrite(f:THANDLE;var buf;size:integer):dword;
+begin
+ WriteFile(f,buf,size,result,nil);
+end;
+
+function GetFSize(name:PWideChar):dword;
+var
+ lRec:WIN32_FIND_DATAW;
+ h:THANDLE;
+begin
+ h:=FindFirstFileW(name,lRec);
+ if h=THANDLE(INVALID_HANDLE_VALUE) then
+ result:=0
+ else
+ begin
+ result:=lRec.nFileSizeLow;
+ FindClose(h);
+ end;
+end;
+
+function GetFSize(name:PAnsiChar):dword;
+var
+ lRec:TWin32FindDataA;
+ h:THANDLE;
+begin
+ h:=FindFirstFileA(name,lRec);
+ if h=THANDLE(INVALID_HANDLE_VALUE) then
+ result:=0
+ else
+ begin
+ result:=lRec.nFileSizeLow;
+ FindClose(h);
+ end;
+end;
+
+function ForceDirectories(path:PAnsiChar):boolean;
+var
+ p,pc:PAnsiChar;
+ i:cardinal;
+ c:AnsiChar;
+begin
+ result:=true;
+ if DirectoryExists(path) then exit;
+ if (path<>nil) and (path^<>#0) then
+ begin
+ i:=lstrlena(path)+1;
+ GetMem(pc,i);
+ move(path^,pc^,i);
+ p:=pc;
+ if (p^ in ['A'..'Z','a'..'z']) and (p[1]=':') then inc(p,2);
+ if p^ in ['/','\'] then inc(p);
+ c:=#0;
+ while p^<>#0 do
+ begin
+ c:=' ';
+ if (p^ in ['/','\']) and (p[1]<>#0) then
+ begin
+ c:=p^;
+ p^:=#0;
+ if not CreateDirectoryA(pc,nil) then
+ begin
+ if GetLastError<>ERROR_ALREADY_EXISTS then
+ begin
+ result:=false;
+ FreeMem(pc);
+ exit;
+ end;
+ end;
+ p^:=c;
+ end;
+ inc(p);
+ end;
+ if (c<>#0) and (c=' ') then
+ if not CreateDirectoryA(pc,nil) then
+ result:=false;
+ FreeMem(pc);
+ end;
+end;
+
+function ForceDirectories(path:PWideChar):boolean;
+var
+ p,pc:PWideChar;
+ i:cardinal;
+ c:WideChar;
+begin
+ result:=true;
+ if DirectoryExists(path) then exit;
+ if (path<>nil) and (path^<>#0) then
+ begin
+ i:=(lstrlenw(path)+1)*SizeOf(WideChar);
+ GetMem(pc,i);
+ move(path^,pc^,i);
+ p:=pc;
+ if (((p^>='A') and (p^<='Z')) or ((p^>='a') and (p^<='z'))) and (p[1]=':') then inc(p,2);
+ if (p^='/') or (p^='\') then inc(p);
+ c:=#0;
+ while p^<>#0 do
+ begin
+ c:=' ';
+ if ((p^='/') or (p^='\')) and (p[1]<>#0) then
+ begin
+ c:=p^;
+ p^:=#0;
+ if not CreateDirectoryW(pc,nil) then
+ if GetLastError<>ERROR_ALREADY_EXISTS then
+ begin
+ result:=false;
+ FreeMem(pc);
+ exit;
+ end;
+ p^:=c;
+ end;
+ inc(p);
+ end;
+ if (c<>#0) and (c=' ') then
+ if not CreateDirectoryW(pc,nil) then
+ result:=false;
+ FreeMem(pc);
+ end;
+end;
+
+function DirectoryExists(Directory:PAnsiChar):Boolean;
+var
+ Code: Integer;
+begin
+ Code := GetFileAttributesA(Directory);
+ Result := (Code<>-1) and ((Code and FILE_ATTRIBUTE_DIRECTORY)<>0);
+end;
+
+function DirectoryExists(Directory:PWideChar):Boolean;
+var
+ Code: Integer;
+begin
+ Code := GetFileAttributesW(Directory);
+ Result := (Code<>-1) and ((Code and FILE_ATTRIBUTE_DIRECTORY)<>0);
+end;
+
+function FileExists(fname:PAnsiChar):Boolean;
+var
+ Code: Integer;
+begin
+ Code := GetFileAttributesA(fname);
+ Result := (Code<>-1) and ((Code and FILE_ATTRIBUTE_DIRECTORY)=0);
+end;
+
+function FileExists(fname:PWideChar):Boolean;
+var
+ Code: Integer;
+begin
+ Code := GetFileAttributesW(fname);
+ Result := (Code<>-1) and ((Code and FILE_ATTRIBUTE_DIRECTORY)=0);
+end;
+
+end.
diff --git a/plugins/Utils.pas/kolsizer.pas b/plugins/Utils.pas/kolsizer.pas new file mode 100644 index 0000000000..28361a4585 --- /dev/null +++ b/plugins/Utils.pas/kolsizer.pas @@ -0,0 +1,538 @@ +unit KOLSizer;
+//
+// purpose: KOL control sizercontrol and design grid
+// author: © 2004, Thaddy de Koning
+// Remarks: Tnx in part to Marco Cantu for the sizer idea in DDH3
+// copyrighted freeware.
+//
+interface
+
+uses
+ Windows, Messages, Kol;
+
+const
+ DESIGNER_NORESIZE = 1;
+
+type
+ PDesigner=^TDesigner;
+ TDesigner=object(TStrlistEx)
+ private
+ fOwner:pControl;
+ fSpacing:Cardinal;
+ FOldPaint:TOnPaint;
+ fActive: boolean;
+ fSizer:PControl;
+ FOnControlChange: TonEvent;
+// FOnDblClick:TOnEvent;
+// FOnMouseDown:TOnMouse;
+ fCurrent: pControl;
+// FAction:integer;
+
+ procedure setactive(const Value: boolean);
+ function PrepareClassname(aControl: PControl): KOLString;
+ function UniqueName(aName: KOLString; flags:cardinal): KOLString;
+ procedure SetCurrent(const Value: pControl);
+ procedure InternalControlChange(sender:pObj);
+ procedure Setspacing(Space:cardinal = 8);
+ function GetFlags(aControl:pControl):cardinal;
+ protected
+ procedure init;virtual;
+ procedure DoKeyUp( Sender: PControl; var Key: Longint; Shift: DWORD);
+ procedure DoChar( Sender: PControl; var Key: KOLChar; Shift: DWORD);
+ public
+ destructor destroy;virtual;
+ procedure Connect(aName: KOLString; aControl: pControl; flags:cardinal=0);
+ procedure DisConnect(aControl: pControl);
+ procedure Paintgrid(sender:pControl;DC:HDC);
+
+ property Spacing:cardinal read fSpacing write setspacing;
+ property Active:boolean read fActive write setactive;
+// property Action:integer read FAction write Faction;
+ property Current:pControl read fCurrent write SetCurrent;
+ property OnControlChange:TOnEvent Read FOnControlChange write FOnControlChange;
+// property OnDblClick:TonEvent read fOnDblClick write FOnDblClick;
+// property OnMouseDown:TOnMouse read FOnMouseDown write FOnMouseDown;
+ end;
+
+function NewSizerControl(AControl: PControl;aDesigner:PDesigner;flags:cardinal=0):PControl;
+function NewDesigner(aOwner:pControl):pDesigner;
+
+implementation
+
+const
+ FlagDelimeterChar='@';
+
+const
+ // Size and move commands for SysCommand
+ SZ_LEFT = $F001;
+ SZ_RIGHT = $F002;
+ SZ_TOP = $F003;
+ SZ_TOPLEFT = $F004;
+ SZ_TOPRIGHT = $F005;
+ SZ_BOTTOM = $F006;
+ SZ_BOTTOMLEFT = $F007;
+ SZ_BOTTOMRIGHT = $F008;
+ SZ_MOVE = $F012;
+
+type
+ TPosInfo = record
+ Rect :Trect;
+ Pos :integer;
+ Direction:integer;
+ end;
+
+ PSizerdata=^ TSizerdata;
+ TSizerdata= object(Tobj)
+ FControl :PControl;
+ FPosInfo :array [0..7] of TPosInfo;
+ Szflags :cardinal;
+ Direction:longint;
+
+ procedure DoPaint(sender:pControl;DC:HDC);
+ end;
+
+ PHack =^ THack;
+ THack = object(Tcontrol)
+ end;
+
+var
+ LocalDesigner:PDesigner=nil;
+
+function DesignHandlerProc(Sender: PControl; var Msg: TMsg; var Rslt: Integer): Boolean;
+//var MouseData:TMouseEventData;
+begin
+ Result:=false;
+ case msg.message of
+{
+ WM_KEYUP,WM_SYSCHAR,WM_SYSKEYUP,
+ WM_CHAR: begin
+// if loword(msg.wParam)=VK_TAB then
+ Messagebox(0,'222','',0);
+ end;
+} WM_LBUTTONDOWN: begin
+ if LocalDesigner.fOwner<>Sender then LocalDesigner.Current:=Sender;
+ Result:=true;
+ {
+ if assigned(Localdesigner.OnMousedown) then
+ // Borrowed from KOL.pas
+ // enables us to pass on KOL mouse events back to the designer
+ // without having to connect to true KOL eventproperties.
+ with MouseData do
+ begin
+ Shift := Msg.wParam;
+ if GetKeyState(VK_MENU) < 0 then
+ Shift := Shift or MK_ALT;
+ X := LoWord(Msg.lParam);
+ Y := HiWord(Msg.lParam);
+ Button := mbNone;
+ StopHandling := true;
+ Rslt := 0; // needed ?
+ LocalDesigner.OnMousedown(sender,Mousedata);
+ Result:=true
+ end;
+ }
+ end
+ end;
+end;
+
+// TSizerControl methods
+function WndProcSizer( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
+var
+ Pt: TPoint;
+ i: Integer;
+ R:Trect;
+ Data:PSizerData;
+begin
+ Data:=PSizerData(Sender.CustomObj);
+ Result:=True;
+ with Sender^, Data^ do
+ begin
+ case msg.message of
+{
+ WM_KEYUP,WM_SYSCHAR,WM_SYSKEYUP,
+ WM_CHAR: begin
+// if loword(msg.wParam)=VK_TAB then
+ Messagebox(0,'111','',0);
+ end;
+}
+ WM_NCHITTEST: begin
+ Pt := MakePoint(loword(Msg.lparam), hiword(Msg.lparam));
+ Pt := Screen2Client (Pt);
+ Rslt:=0;
+ for i := 0 to 7 do
+ if PtInRect (FPosInfo [i].rect, Pt) then
+ begin
+ // The value of rslt is passed on and makes
+ // the system select the correct cursor
+ // without us having to do anything more.
+ Rslt :=FPosInfo[i].pos;
+ Direction:=FPosInfo[i].direction;
+ break;
+ end;
+ if Rslt = 0 then
+ Result:=False;
+ end;
+
+ WM_SIZE: begin
+ R := BoundsRect;
+ InflateRect (R, -2, -2);
+ Fcontrol.BoundsRect := R;
+ FPosInfo[0].rect:=MakeRect (0 ,0 ,5 ,5);
+ FPosInfo[1].rect:=MakeRect (Width div 2-3,0 ,Width div 2+2,5);
+ FPosInfo[2].rect:=MakeRect (Width-5 ,0 ,Width ,5);
+ FPosInfo[3].rect:=MakeRect (Width-5 ,Height div 2-3,Width ,Height div 2+2);
+ FPosInfo[4].rect:=MakeRect (Width-5 ,Height-5 ,Width ,Height);
+ FPosInfo[5].rect:=MakeRect (Width div 2-3,Height-5 ,Width div 2+2,Height);
+ FPosInfo[6].rect:=MakeRect (0 ,Height-5 ,5 ,Height);
+ FPosInfo[7].rect:=MakeRect (0 ,Height div 2-3,5 ,Height div 2+2);
+ end;
+
+ WM_NCLBUTTONDOWN: if (Szflags and DESIGNER_NORESIZE)=0 then
+ Perform (WM_SYSCOMMAND, Direction, 0);
+
+ WM_LBUTTONDOWN: Perform (WM_SYSCOMMAND, SZ_MOVE, 0);
+
+ WM_MOVE: begin
+ R := BoundsRect;
+ InflateRect (R, -2, -2);
+ fControl.Invalidate;
+ fControl.BoundsRect := R;
+ end;
+
+ else
+ Result:=false;
+ end;
+ end;
+end;
+
+function NewSizerControl(AControl: PControl;aDesigner:PDesigner;flags:cardinal):PControl;
+var
+ R: TRect;
+ Data:PSizerData;
+begin
+ New(Data,Create);
+ Result:={NewPanel(aControl,esNone);//}NewPaintBox(aControl);
+ Result.ExStyle:=Result.ExStyle or WS_EX_TRANSPARENT;
+// Result.TabStop:=true;
+// Result.OnChar:=aDesigner.DoChar;
+// Result.OnKeyDown:=aDesigner.DoKeyUp;
+// Result.OnKeyUp:=aDesigner.DoKeyUp;
+ if aDesigner.fowner<>aControl then
+ With result^, Data^ do
+ begin
+ Szflags := flags;
+ FControl := AControl;
+ // set the size and position
+ R := aControl.BoundsRect;
+ InflateRect (R, 2, 2);
+ BoundsRect := R;
+ // set the parent
+ Parent := aControl.Parent;
+ // create the list of positions
+ FPosInfo [0].pos := htTopLeft ; FPosInfo [0].direction := SZ_TOPLEFT;
+ FPosInfo [1].pos := htTop ; FPosInfo [1].direction := SZ_TOP;
+ FPosInfo [2].pos := htTopRight ; FPosInfo [2].direction := SZ_TOPRIGHT;
+ FPosInfo [3].pos := htRight ; FPosInfo [3].direction := SZ_RIGHT;
+ FPosInfo [4].pos := htBottomRight; FPosInfo [4].direction := SZ_BOTTOMRIGHT;
+ FPosInfo [5].pos := htBottom ; FPosInfo [5].direction := SZ_BOTTOM;
+ FPosInfo [6].pos := htBottomLeft ; FPosInfo [6].direction := SZ_BOTTOMLEFT;
+ FPosInfo [7].pos := htLeft ; FPosInfo [7].direction := SZ_LEFT;
+ CustomObj:=Data;
+ OnPaint:=DoPaint;
+ AttachProc(WndProcSizer);
+ Bringtofront;
+ Focused:=true
+ end;
+end;
+
+procedure TSizerData.DoPaint(sender:pControl;DC:HDC);
+var
+ i: Integer;
+begin
+ // I simply use the current pen and brush
+ for i := 0 to 7 do
+ with pSizerdata(sender.Customobj).FPosInfo[i].Rect do
+ Rectangle(DC, Left, Top, Right, Bottom);
+end;
+
+{ TDesigner }
+function NewDesigner(aOwner:pControl):pDesigner;
+begin
+ if Assigned(LocalDesigner) then
+ begin
+ result:=LocalDesigner;
+ end
+ else
+ begin
+ New(Result,Create);
+ with result^ do
+ begin
+ Fowner:=aOwner;
+ Connect('',Fowner);
+ FOldPaint:=Fowner.OnPaint;
+ LocalDesigner:=Result;
+ //Result.Current:=aOwner;
+ end
+ end
+end;
+
+procedure TDesigner.init;
+begin
+ inherited;
+ Fspacing:=8;
+end;
+
+procedure TDesigner.PaintGrid(Sender: pControl; DC: HDC);
+var
+ i, j: Integer;
+begin
+ i := 0;
+ j := 0;
+ Sender.Canvas.FillRect(Sender.Canvas.ClipRect);
+ if Assigned(FOldPaint) then FOldPaint(Sender,DC);
+ repeat
+ repeat
+ MoveToEx(Dc,i, j,nil);
+ LineTo(Dc,i + 1,j);
+ inc(i, fSpacing);
+ until i > Sender.ClientWidth;
+ i := 0;
+ inc(j, fSpacing);
+ until j > Sender.ClientHeight;
+end;
+
+procedure TDesigner.SetSpacing(Space: cardinal);
+begin
+ fSpacing:=Space;
+ fOwner.invalidate;
+end;
+
+destructor TDesigner.destroy;
+begin
+ SetActive(false);
+ FOwner.OnPaint:=FOldPaint;
+ inherited;
+end;
+
+//Note: Make shure that whatever happens, all pointers are nil or valid!
+// Took a long time to debug spurious crashes.
+// So this is not excessively safe.
+procedure TDesigner.SetActive(const Value: boolean);
+var
+ i:integer;
+begin
+ FActive := Value;
+ if FActive then
+ begin
+ fOwner.OnPaint:=PaintGrid;
+ if count > 1 then
+ begin
+ if Assigned(fCurrent) then
+ fSizer:=NewSizerControl(fCurrent,@self,GetFlags(fCurrent));
+ for i:=0 to count -1 do
+ if not PControl(Objects[i]).IsprocAttached(DesignHandlerProc) then
+ PControl(Objects[i]).AttachProc(DesignHandlerProc);
+ end;
+ end
+ else
+ begin
+ if count > 0 then // always coz Owner is first
+ for i:=0 to count -1 do
+ PControl(Objects[i]).DetachProc(DesignHandlerProc);
+ if Assigned(fSizer) then
+ begin
+ fSizer.free;
+ fSizer:=nil;
+ end;
+ fCurrent:=nil;
+ fOwner.OnPaint:=FOldPaint;
+ end;
+ fOwner.Invalidate;
+end;
+
+procedure TDesigner.Connect(aName: KOLString; aControl: pControl; flags:cardinal=0);
+begin
+ if (IndexOfObj(aControl) = -1) then
+ begin
+ if aName = '' then
+ aName := PrepareClassName(aControl);
+ AddObject(UniqueName(aName,flags), Cardinal(aControl));
+ InternalControlChange(aControl);
+ SetCurrent(aControl);
+ if Active then
+ if not aControl.IsprocAttached(DesignHandlerProc) then
+ aControl.AttachProc(DesignHandlerProc);
+ end;
+end;
+
+procedure TDesigner.DisConnect(aControl: pControl);
+var
+ index: Integer;
+begin
+ index := IndexOfObj(aControl);
+ if index = -1 then
+ exit;
+ Delete(index);
+
+ InternalControlChange(nil);
+end;
+
+function TDesigner.GetFlags(aControl:pControl):cardinal;
+var
+ idx,dummy:integer;
+ tmpstr:KOLString;
+begin
+ idx:=IndexOfObj(aControl);
+ tmpstr:=Items[idx];
+ idx:=IndexOfChar(tmpstr,FlagDelimeterChar);
+ if idx<0 then result:=0
+ else
+ begin
+ val(copy(tmpstr,idx+1,15),result,dummy);
+ end;
+end;
+
+procedure TDesigner.SetCurrent(const Value: pControl);
+begin
+ if Assigned(fSizer) then
+ begin
+ fSizer.free;
+ fsizer:=nil;
+ end;
+ if Value <> nil then
+ begin
+
+ fCurrent := Value;
+ if fActive and (fCurrent<>nil) and (fCurrent<>fOwner) then
+ fSizer:=NewSizerControl(Value,@self,GetFlags(Value));
+
+ InternalControlChange(Value);
+ end;
+end;
+
+procedure TDesigner.InternalControlChange(sender: pObj);
+begin
+ if fActive then
+ if Assigned(OnControlChange)then
+ FOnControlChange(sender);
+end;
+
+procedure TDesigner.DoChar( Sender: PControl; var Key: KOLChar; Shift: DWORD);
+begin
+// messagebox(0,'444','',0);
+end;
+
+procedure TDesigner.DoKeyUp(Sender: PControl; var Key: Integer; Shift: DWORD);
+
+ procedure DeleteControl(Index:integer);
+ var
+ i: Integer;
+ C:PControl;
+ begin
+ C:=PControl(Objects[index]);
+ // delete children, not owner
+ if C.ChildCount>0 then
+ for i:=C.ChildCount-1 downto 0 do
+ if C<>fOwner then DeleteControl(i);
+
+ if C<>fOwner then
+ begin
+ C.free;
+ Delete(0);
+ end;
+ end;
+
+var
+ i:integer;
+begin
+// if Key = VK_TAB then
+// messagebox(0,'333','',0);
+
+ if Key = VK_DELETE then
+ begin
+ i:=IndexOfObj(LocalDesigner.Current);
+ if i<>-1 then
+ begin
+ DeleteControl(i);
+ InternalControlChange(nil);
+ PostMessage(Sender.Handle,WM_CLOSE,0,0); //???
+ end;
+ end;
+end;
+
+ // Converts an object name to a Delphi compatible control name that
+ // is unique for the designer, i.e 'Button' becomes 'Button1',
+ // the next button becomes 'Button2', always unless the
+ // control is already named by the user in which case the name is preserved
+ // unless there are conficts. In that case the control is silently
+ // renamed with a digit suffix without raising exceptions.
+ // Deleted names are re-used.
+ // It's not a beauty but it works.
+ // (A severe case of programming 48 hours without sleep)
+
+function TDesigner.UniqueName(aName: KOLString; flags:cardinal): KOLString;
+var
+ I, J: Integer;
+ T: KOLString;
+begin
+ // Strip obj_ prefix and all other prefix+underscores from
+ // subclassname property: 'obj_BUTTON' becomes 'Button'
+ T := LowerCase(aName);
+ while T <> '' do aName := Parse(T, '_');
+
+// aName[1]:=UpCase(aName[1]);
+ //Propercase it
+ T := aName[1];
+ T := UpperCase(T);
+ aName[1] := T[1];
+
+ Result := aName;
+ // Add at least a 1 to the name if the last char
+ // is not a digit.
+ if not (AnsiChar(aName[length(aName)]) in ['0'..'9']) then
+ Result := Format('%s%d', [aName, 1]);
+ J := 1;
+ repeat
+ I := IndexOf(Result);
+ if I > -1 then
+ begin
+ inc(J);
+ Result := Format('%s%d', [aName, J]);
+ end;
+ until I = -1;
+ if flags<>0 then
+ begin
+ Str(flags,T);
+ Result:=Result+FlagDelimeterChar+T;
+ end;
+end;
+
+// This is probably not complete yet.
+function TDesigner.PrepareClassName(aControl: PControl): KOLString;
+begin
+ Result := aControl.subclassname;
+ with aControl^ do
+ if subClassname = 'obj_STATIC' then
+ begin
+ // Only place where panel and label differ
+ // consistently???
+ // why not aControl.SizeRedraw ??
+ if pHack(aControl).SizeRedraw = True then
+ Result := 'obj_LABEL'
+ else
+ Result := 'obj_PANEL'
+ end
+
+ else if subclassname = 'obj_BUTTON' then
+ begin
+ if Boolean(Style and BS_AUTOCHECKBOX) then Result := 'obj_CHECKBOX'
+ else if Boolean(style and BS_RADIOBUTTON ) then Result := 'obj_RADIOBOX'
+ else if Boolean(style and BS_OWNERDRAW ) then Result := 'obj_BITBTN'
+ else if Boolean(style and BS_GROUPBOX ) then Result := 'obj_GROUPBOX';
+ end
+
+ else if IndexOfStr(UpperCase(subclassname), 'RICHEDIT')>-1 then
+ Result := 'obj_RICHEDIT';
+end;
+
+end.
diff --git a/plugins/Utils.pas/mApiCardM.pas b/plugins/Utils.pas/mApiCardM.pas new file mode 100644 index 0000000000..ff289168f3 --- /dev/null +++ b/plugins/Utils.pas/mApiCardM.pas @@ -0,0 +1,404 @@ +{service insertion code}
+unit mApiCardM;
+
+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);
+ destructor 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
+ storage:pointer;
+ current:pointer;
+ namespace: array [0.. 63] 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,memini;
+
+{$r mApiCard.res}
+
+{$include i_card_const.inc}
+
+const
+ WM_UPDATEHELP = WM_USER+100;
+
+const
+ BufSize = 2048;
+
+const
+ ApiHlpFile = 'plugins\services.ini';
+{
+ ServiceHlpFile = 'plugins\services.ini';
+ EventsHlpFile = 'plugins\events.ini';
+}
+function tmApiCard.GetResultType:pAnsiChar;
+var
+ buf:array [0..2047] of AnsiChar;
+ p:pAnsiChar;
+begin
+ if storage<>nil then
+ begin
+ StrCopy(buf,GetParamSectionStr(current,'return',''));
+ p:=@buf;
+ while p^ in sWordOnly do inc(p);
+ p^:=#0;
+ StrDup(result,@buf);
+ end
+ else
+ result:=nil;
+end;
+
+function tmApiCard.GetDescription:pAnsiChar;
+begin
+ if storage<>nil then
+ begin
+ StrDup(result,GetParamSectionStr(current,'descr',''));
+ 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 storage=nil then
+ begin
+ result:=nil;
+ exit;
+ end;
+ if wparam then
+ paramname:='wparam'
+ else
+ paramname:='lparam';
+
+ StrCopy(buf,GetParamSectionStr(current,paramname,''));
+ 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
+ tmpbuf:array [0..127] of AnsiChar;
+ p,pp,pc:PAnsiChar;
+begin
+ if storage<>nil then
+ begin
+ SendMessage(combo,CB_RESETCONTENT,0,0);
+ p:=GetSectionList(storage,namespace);
+ pp:=p;
+ while p^<>#0 do
+ begin
+ case mode of
+ 1: begin // just constant name
+ pc:=GetParamStr(storage,p,'alias',nil,namespace);
+ if pc=nil then
+ pc:=p;
+ end;
+ 2: begin // value (name)
+ pc:=StrCopyE(tmpbuf,p);
+ pc^:=' '; inc(pc);
+ pc^:='('; inc(pc);
+ pc:=StrCopyE(pc,GetParamStr(storage,p,'alias',nil,namespace));
+ pc^:=')'; inc(pc);
+ pc^:=#0;
+ pc:=@tmpbuf;
+ end;
+ 3: begin // name 'value'
+ pc:=@tmpbuf;
+ pc:=StrCopyE(pc,GetParamStr(storage,p,'alias',nil,namespace));
+ 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;
+ FreeSectionList(pp);
+ SendMessage(combo,CB_SETCURSEL,-1,0);
+ end;
+end;
+
+function ServiceHelpDlg(Dialog:HWnd;hMessage:uint;wParam:WPARAM;lParam:LPARAM):LRESULT; stdcall;
+var
+ buf: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 (storage<>nil) and (lParam<>0) and (current<>nil) then
+ begin
+ GetMem(buf,BufSize);
+ GetMem(tmp,BufSize*SizeOf(WideChar));
+
+ SetDlgItemTextA(Dialog,IDC_HLP_SERVICE,GetSectionName(current));
+
+ SetDlgItemTextA(Dialog,IDC_HLP_ALIAS,
+ GetParamSectionStr(current,'alias',''));
+
+ FastAnsiToWideBuf(GetParamSectionStr(current,'return','Undefined'),tmp);
+ SetDlgItemTextW(Dialog,IDC_HLP_RETURN,TranslateW(tmp));
+
+ FastAnsiToWideBuf(GetParamSectionStr(current,'descr','Undefined'),tmp);
+ SetDlgItemTextW(Dialog,IDC_HLP_EFFECT,TranslateW(tmp));
+
+ FastAnsiToWideBuf(GetParamSectionStr(current,'plugin',''),tmp);
+ SetDlgItemTextW(Dialog,IDC_HLP_PLUGIN,TranslateW(tmp));
+
+ // Parameters
+ StrCopy(buf,GetParamSectionStr(current,'wparam','0'));
+ 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;
+
+ StrCopy(buf,GetParamSectionStr(current,'lparam','0'));
+ 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
+ if (item=nil) or (item^=#0) then
+ current:=nil
+ else
+ current:=SearchSection(storage,item,namespace);
+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);
+var
+ IniFile: array [0..511] of AnsiChar;
+begin
+ inherited Create;
+
+ StrCopy(@IniFile,fname);
+ HelpWindow:=0;
+ current:=nil;
+ if fname<>nil then
+ begin
+ ConvertFileName(fname,@INIFile);
+ // CallService(MS_UTILS_PATHTOABSOLUTE,
+ // dword(PAnsiChar(ServiceHlpFile)),dword(INIFile));
+ if GetFSize(pAnsiChar(@INIFile))=0 then
+ begin
+ INIFile[0]:=#0;
+ end;
+ parent:=lparent;
+ end;
+ storage:=OpenStorage(@IniFile);
+end;
+
+destructor tmApiCard.Free;
+begin
+ CloseStorage(storage);
+// inherited;
+end;
+
+function CreateServiceCard(parent:HWND=0):tmApiCard;
+begin
+ result:=tmApiCard.Create(ApiHlpFile,parent);
+ result.isServiceHelp:=true;
+ StrCopy(result.namespace,'Service');
+end;
+
+function CreateEventCard(parent:HWND=0):tmApiCard;
+begin
+ result:=tmApiCard.Create(ApiHlpFile,parent);
+ result.isServiceHelp:=false;
+ StrCopy(result.namespace,'Event');
+end;
+
+
+//initialization
+//finalization
+end.
diff --git a/plugins/Utils.pas/mApicard.rc b/plugins/Utils.pas/mApicard.rc new file mode 100644 index 0000000000..e4d1431e8f --- /dev/null +++ b/plugins/Utils.pas/mApicard.rc @@ -0,0 +1,39 @@ +#include "i_card_const.inc"
+
+LANGUAGE 0,0
+
+IDD_MAPIHELP DIALOGEX 0, 0, 256, 174, 0
+STYLE DS_SETFONT | DS_FIXEDSYS | WS_VISIBLE | WS_CAPTION | WS_SYSMENU
+EXSTYLE WS_EX_CONTROLPARENT
+CAPTION "Service help"
+FONT 8, "MS Shell Dlg", 0, 0
+{
+ DEFPUSHBUTTON "OK", IDOK, 4, 126, 26, 16
+
+ RTEXT "Name", -1 , 4, 4, 60, 14, SS_CENTERIMAGE
+ EDITTEXT IDC_HLP_SERVICE, 70, 5, 180, 12, ES_READONLY
+
+ RTEXT "Alias", -1 , 4, 20, 60, 14, SS_CENTERIMAGE
+ EDITTEXT IDC_HLP_ALIAS , 70, 21, 180, 12, ES_READONLY
+
+ RTEXT "Plugin", -1 , 4, 36, 60, 14, SS_CENTERIMAGE
+ EDITTEXT IDC_HLP_PLUGIN , 70, 37, 180, 12, ES_READONLY
+
+ RTEXT "wParam", -1 , 4, 52, 60, 14, SS_CENTERIMAGE
+ EDITTEXT IDC_HLP_WPARAM , 70, 53, 180, 12, ES_READONLY
+ COMBOBOX IDC_HLP_WPARAML, 70, 53, 180, 76, CBS_DROPDOWNLIST | WS_VSCROLL | CBS_AUTOHSCROLL
+
+ RTEXT "lParam", -1 , 4, 68, 60, 14, SS_CENTERIMAGE
+ EDITTEXT IDC_HLP_LPARAM , 70, 69, 180, 12, ES_READONLY
+ COMBOBOX IDC_HLP_LPARAML, 70, 69, 180, 76, CBS_DROPDOWNLIST | WS_VSCROLL | CBS_AUTOHSCROLL
+
+ RTEXT "Return", -1 , 4, 84, 60, 14, SS_CENTERIMAGE
+ EDITTEXT IDC_HLP_RETURN , 70, 85, 180, 12, ES_READONLY | ES_AUTOHSCROLL
+
+ RTEXT "Effect", -1 , 4, 100, 60, 14, SS_CENTERIMAGE
+ EDITTEXT IDC_HLP_EFFECT , 70, 100, 180, 42, ES_MULTILINE | ES_READONLY | ES_AUTOVSCROLL
+
+ CONTROL "", -1, "STATIC", SS_ETCHEDHORZ, 2, 146, 252, 2
+ LTEXT "'<proto>' in service name will be replaced by protocol name for contact handle in parameter",
+ IDC_HLP_NOTE, 4, 149, 248, 22
+}
diff --git a/plugins/Utils.pas/mApicard.res b/plugins/Utils.pas/mApicard.res Binary files differnew file mode 100644 index 0000000000..7d6ed320b9 --- /dev/null +++ b/plugins/Utils.pas/mApicard.res diff --git a/plugins/Utils.pas/make.bat b/plugins/Utils.pas/make.bat new file mode 100644 index 0000000000..39a182dae2 --- /dev/null +++ b/plugins/Utils.pas/make.bat @@ -0,0 +1,14 @@ +@echo off
+set myopts=
+
+if /i '%2' == 'fpc' (
+ ..\FPC\bin\fpc.exe %myopts% %1 %3 %4 %5 %6 %7 %8 %9
+) else if /i '%2' == 'fpc64' (
+ ..\FPC\bin64\ppcrossx64.exe %myopts% %1 %3 %4 %5 %6 %7 %8 %9
+) else if /i '%2' == 'xe2' (
+ ..\XE2\bin\dcc32.exe %myopts% %1 %3 %4 %5 %6 %7 %8 %9
+) else if /i '%2' == 'xe64' (
+ ..\XE2\bin\dcc64.exe %myopts% %1 %3 %4 %5 %6 %7 %8 %9
+) else (
+ ..\delphi\dcc32 %myopts% %1 %2 %3 %4 %5 %6 %7 %8 %9
+)
diff --git a/plugins/Utils.pas/memini.pas b/plugins/Utils.pas/memini.pas new file mode 100644 index 0000000000..b4f65093bb --- /dev/null +++ b/plugins/Utils.pas/memini.pas @@ -0,0 +1,514 @@ +unit memini;
+
+interface
+
+function OpenStorage(fname:pAnsiChar):pointer;
+function OpenStorageBuf(buf:pAnsiChar):pointer;
+procedure CloseStorage(storage:pointer);
+
+function GetSectionList(storage:pointer;namespace:pAnsiChar=nil):pAnsiChar;
+procedure FreeSectionList(ptr:pAnsiChar);
+
+function GetParamStr(storage:pointer;section,param:pAnsiChar;default:pAnsiChar=nil;
+ namespace:pAnsiChar=nil):pAnsiChar;
+function GetParamInt(storage:pointer;section,param:pAnsiChar;default:integer=0;
+ namespace:pAnsiChar=nil):integer;
+
+function SearchSection(storage:pointer;section:pAnsiChar;namespace:pAnsiChar=nil):pointer;
+function GetSectionName(section:pointer):pAnsiChar;
+
+function GetParamSectionStr(section:pointer;param:pAnsiChar;default:pAnsiChar=nil):pAnsiChar;
+function GetParamSectionInt(section:pointer;param:pAnsiChar;default:integer=0):integer;
+
+implementation
+
+uses windows,io,common;
+
+const
+ arstep = 8;
+const
+ ns_separator = ':';
+ line_separator = '\';
+type
+ pParam = ^tParam;
+ tParam = record
+ hash :integer; // param name hash
+ name :pAnsiChar; // points to source (for write only)
+ value :pAnsiChar; // points to source? or modified
+ assign:boolean; // newly assigned value or in INI buffer
+ end;
+ pSection = ^tSection;
+ tSection = record
+ ns :integer; // namespace hash
+ code :integer; // section name hash
+ full :integer; // namespace+section name hash
+ fullname:pAnsiChar; // pointer to namespace:name
+ name :pAnsiChar; // pointer to name only
+
+ numparam:integer;
+ arParams:array of tParam;
+ end;
+ pStorage = ^tStorage;
+ tStorage = record
+ Name :pAnsiChar; // filename
+ buffer :pAnsiChar; // source (INI) text
+
+ numsect :integer;
+ arSection: array of tSection;
+ end;
+
+
+function HashOf(txt:pAnsiChar):integer;
+begin
+ result:=Hash(txt,StrLen(txt));
+{
+ result:=0;
+ while txt^<>#0 do
+ begin
+ result:=((result shl 2) or (result shr (SizeOf(result)*8-2))) xor Ord(UpCase(txt^));
+ inc(txt);
+ end;
+}
+end;
+
+// sections adds 1 by 1, without duplicate check
+procedure AddSection(data:pStorage;anamespace,aname:pAnsiChar);
+var
+ c:AnsiChar;
+begin
+ // search section with same name?
+
+ // add section
+ if data.numsect>High(data.arSection) then
+ SetLength(data.arSection,Length(data.arSection)+arstep);
+
+ FillChar(data.arSection[data.numsect],SizeOf(tSection),0);
+ with data.arSection[data.numsect] do
+ begin
+ fullname:=anamespace;
+ name :=aname;
+ full:=HashOf(anamespace);
+ if anamespace<>aname then
+ begin
+ c:=(aname-1)^;
+ (aname-1)^:=#0;
+ code:=HashOf(aname);
+ ns :=HashOf(anamespace);
+ (aname-1)^:=c;
+ end;
+ end;
+ inc(data.numsect);
+end;
+
+procedure AddParam(data:pStorage;aname,avalue:pAnsiChar;assignvalue:boolean);
+begin
+ // search param with same name?
+
+ with data.arSection[data.numsect-1] do
+ begin
+ // add param
+ if numparam>High(arParams) then
+ SetLength(arParams,Length(arParams)+arstep);
+
+ FillChar(arParams[numparam],SizeOf(tParam),0);
+ with arParams[numparam] do
+ begin
+ hash :=HashOf(aname);
+ name :=aname;
+ value :=avalue;
+ assign:=assignvalue;
+ end;
+ inc(numparam);
+ end;
+end;
+
+// quotes, multiline etc
+// result = pointer to non-parameter line
+// pointers: start of value, start of current line, end of value in line, end of current line
+function ProcessParamValue(var start:pAnsiChar):pAnsiChar;
+var
+ lineend,eol,dst,bov:pAnsiChar;
+ multiline,crlf:boolean;
+begin
+
+ dst:=start;
+ bov:=start;
+ result:=nil;
+ repeat
+ multiline:=false;
+ crlf :=false;
+ // skip starting spaces
+ while start^ in [#9,' '] do inc(start);
+
+ if start^ in [#0,#10,#13] then // empty value or end
+ begin
+ while start^ in [#10,#13] do inc(start);
+ exit;
+ end;
+
+ lineend:=start;
+ while not (lineend^ in [#0,#10,#13]) do inc(lineend);
+ eol:=lineend;
+ dec(lineend);
+ while lineend^ in [#9,' '] do dec(lineend);
+
+ if lineend^=line_separator then // multiline or part of value
+ begin
+ if (lineend-1)^ in [#9,' '] then // multiline
+ begin
+ dec(lineend);
+ multiline:=true;
+ while lineend^ in [#9,' '] do dec(lineend);
+ end
+ // double separator = multiline + crlf saving
+ else if ((lineend-1)^=line_separator) and ((lineend-2)^ in [#9,' ']) then
+ begin
+ dec(lineend,2);
+ multiline:=true;
+ crlf :=true;
+ while lineend^ in [#9,' '] do dec(lineend);
+ end;
+ end;
+ // lineend points to last char
+ // start points to first char
+ // eol points to end of line
+
+ //!! now just starting/ending quotes
+ if (start^ in ['''','"']) and (lineend^ in ['''','"']) then
+ begin
+ inc(start);
+ dec(lineend);
+ end;
+
+ while start<=lineend do
+ begin
+ dst^:=start^;
+ inc(dst);
+ inc(start);
+ end;
+ if crlf then
+ begin
+ dst^:=#13;
+ inc(dst);
+ dst^:=#10;
+ inc(dst);
+ end;
+ start:=eol;
+ while start^ in [#10,#13] do inc(start);
+
+ until not multiline;
+ dst^:=#0;
+ result:=bov;
+end;
+
+procedure TranslateData(data:pStorage);
+var
+ pc2,pc1,pc:pAnsiChar;
+begin
+ pc:=data^.buffer;
+ data.numsect:=0;
+ while pc^<>#0 do
+ begin
+ while pc^ in [#9,#10,#13,' '] do inc(pc);
+
+ // comment
+ if pc^=';' then
+ begin
+ // skip to next line (or end)
+ while not (pc^ in [#0,#10,#13]) do inc(pc);
+ // skip empty
+ while pc^ in [#9,#10,#13,' '] do inc(pc);
+ end
+ // section
+ else if pc^='[' then
+ begin
+
+ inc(pc);
+ //!! without #0 check
+ pc1:=pc;
+ pc2:=pc;
+ while pc^ in sLatWord do inc(pc);
+ // namespace
+ if pc^=ns_separator then
+ begin
+ inc(pc);
+ pc2:=pc;
+ end;
+ while pc^ <> ']' do inc(pc);
+ pc^:=#0; //!!
+
+ AddSection(data,pc1,pc2);
+ inc(pc);
+ end
+ // parameter
+ else if pc^ in sIdFirst then
+ begin
+ pc1:=pc;
+ // skip param name
+ while pc^ in sLatWord do inc(pc);
+ pc^:=#0; //!!
+ // skip spaces
+ while pc^ in [#9,' '] do inc(pc);
+ inc(pc); // must be "="
+ // skip spaces
+ while pc^ in [#9,' '] do inc(pc);
+// pc2:=pc;
+ // parameter can be quoted
+ // here need to cut spaces, comments but join next lines
+ pc2:=ProcessParamValue(pc);
+
+ AddParam(data,pc1,pc2,false);
+ end;
+ end;
+
+end;
+
+function OpenStorageBuf(buf:pAnsiChar):pointer;
+begin
+ result:=nil;
+ if (buf<>nil) and (buf^<>#0) then
+ begin
+ GetMem(result,SizeOf(tStorage));
+ FillChar(result^,SizeOf(tStorage),0);
+
+ StrDup(pStorage(result)^.buffer,buf);
+
+ TranslateData(pStorage(result));
+ end;
+end;
+
+function OpenStorage(fname:pAnsiChar):pointer;
+var
+ h:THANDLE;
+ size:integer;
+begin
+ result:=nil;
+ if FileExists(fname) then
+ begin
+ h:=Reset(fname);
+ if h<>THANDLE(INVALID_HANDLE_VALUE) then
+ begin
+ size:=FileSize(h);
+ if size>0 then
+ begin
+ GetMem(result,SizeOf(tStorage));
+ FillChar(result^,SizeOf(tStorage),0);
+
+ // save name too?
+ GetMem(pStorage(result)^.buffer,size+1);
+ BlockRead(h,pStorage(result)^.buffer^,size);
+ pStorage(result)^.buffer[size]:=#0;
+ end;
+ CloseHandle(h);
+ TranslateData(pStorage(result));
+ end;
+ end;
+end;
+
+procedure CloseStorage(storage:pointer);
+var
+ i:integer;
+begin
+ if storage=nil then exit;
+
+ with pStorage(storage)^ do
+ begin
+ if name<>nil then FreeMem(name);
+ // cycle by sections
+ for i:=0 to HIGH(arSection) do
+ SetLength(arSection[i].arParams,0);
+
+ SetLength(arSection,0);
+ FreeMem(buffer);
+ end;
+ FreeMem(storage);
+end;
+
+function GetSectionList(storage:pointer;namespace:pAnsiChar=nil):pAnsiChar;
+var
+ i,size,ns:integer;
+ pc:pAnsiChar;
+begin
+ if storage=nil then
+ begin
+ result:=nil;
+ exit;
+ end;
+
+ // calculate size
+ size:=0;
+ ns:=0;
+ if (namespace<>nil) and (namespace^<>#0) then
+ ns:=HashOf(namespace);
+
+ with pStorage(storage)^ do
+ begin
+ for i:=0 to HIGH(arSection) do
+ begin
+ if (namespace<>nil) and (namespace^<>#0) then
+ begin
+ if ns<>arSection[i].ns then
+ continue;
+ inc(size,StrLen(arSection[i].name)+1);
+ end
+ else
+ inc(size,StrLen(arSection[i].fullname)+1);
+ end;
+ inc(size);
+ // get memory
+ GetMem(pc,size);
+ result:=pc;
+ // fill
+ for i:=0 to HIGH(arSection) do
+ begin
+ if (namespace<>nil) and (namespace^<>#0) then
+ begin
+ if ns<>arSection[i].ns then
+ continue;
+ pc:=StrCopyE(pc,arSection[i].name);
+ end
+ else
+ pc:=StrCopyE(pc,arSection[i].fullname);
+ inc(pc);
+ end;
+ pc^:=#0;
+ end;
+end;
+
+procedure FreeSectionList(ptr:pAnsiChar);
+begin
+ FreeMem(ptr);
+end;
+
+function SearchSection(storage:pointer;section:pAnsiChar;namespace:pAnsiChar=nil):pointer;
+var
+ i:integer;
+ nsn,nss:integer;
+begin
+ result:=nil;
+ nss:=HashOf(section);
+ if namespace=nil then
+ begin
+ with pStorage(storage)^ do
+ for i:=0 to numsect-1 do
+ begin
+ if arSection[i].full=nss then
+ begin
+ result:=@arSection[i];
+ break;
+ end;
+ end;
+ end
+ else
+ begin
+ nsn:=HashOf(namespace);
+ with pStorage(storage)^ do
+ begin
+ for i:=0 to numsect-1 do
+ begin
+ if (arSection[i].ns=nsn) and (arSection[i].code=nss) then
+ begin
+ result:=@arSection[i];
+ break;
+ end;
+ end;
+ end;
+ end;
+end;
+
+function GetSectionName(section:pointer):pAnsiChar;
+begin
+ if section=nil then
+ result:=nil
+ else
+ result:=pSection(section).name;
+end;
+
+function SearchParameter(section:pointer;param:pAnsiChar):pointer;
+var
+ i:integer;
+ nsp:integer;
+begin
+ result:=nil;
+ if section<>nil then
+ begin
+ nsp:=HashOf(param);
+ with pSection(section)^ do
+ begin
+ for i:=0 to numparam-1 do
+ begin
+ if arParams[i].hash=nsp then
+ begin
+ result:=@arParams[i];
+ break;
+ end;
+ end;
+ end;
+ end;
+end;
+
+function GetParamSectionStr(section:pointer;param:pAnsiChar;default:pAnsiChar=nil):pAnsiChar;
+var
+ pn:pParam;
+begin
+ result:=default;
+
+ if section<>nil then
+ begin
+ pn:=SearchParameter(section,param);
+ if pn<>nil then
+ result:=pn.value //StrCopy(buffer,value,len-1);
+ end;
+end;
+
+function GetParamSectionInt(section:pointer;param:pAnsiChar;default:integer=0):integer;
+var
+ pn:pParam;
+begin
+ result:=default;
+
+ if section<>nil then
+ begin
+ pn:=SearchParameter(section,param);
+ if pn<>nil then
+ begin
+ if pn.value[0]='$' then
+ result:=HexToInt(pAnsiChar(@pn.value[1]))
+ else
+ result:=StrToInt(pn.value);
+ end;
+ end;
+end;
+
+
+function GetParamStr(storage:pointer;section,param:pAnsiChar;default:pAnsiChar=nil;
+ namespace:pAnsiChar=nil):pAnsiChar;
+var
+ sn:pSection;
+begin
+ if storage=nil then
+ begin
+ result:=default;
+ exit;
+ end;
+
+ sn:=SearchSection(storage,section,namespace);
+ result:=GetParamSectionStr(sn,param,default);
+end;
+
+function GetParamInt(storage:pointer;section,param:pAnsiChar;default:integer=0;
+ namespace:pAnsiChar=nil):integer;
+var
+ sn:pSection;
+begin
+ if storage=nil then
+ begin
+ result:=default;
+ exit;
+ end;
+
+ sn:=SearchSection(storage,section,namespace);
+ result:=GetParamSectionInt(sn,param,default);
+end;
+
+end.
diff --git a/plugins/Utils.pas/mirutils.pas b/plugins/Utils.pas/mirutils.pas new file mode 100644 index 0000000000..b71de66708 --- /dev/null +++ b/plugins/Utils.pas/mirutils.pas @@ -0,0 +1,1163 @@ +{$Include compilers.inc}
+unit mirutils;
+
+interface
+
+uses windows,m_api;
+
+// icons
+function SetButtonIcon(btn:HWND;name:PAnsiChar):HICON;
+function RegisterSingleIcon(resname,ilname,descr,group:PAnsiChar):int;
+
+// others
+
+function ConvertFileName(src:pAnsiChar;hContact:THANDLE=0):pAnsiChar; overload;
+function ConvertFileName(src:pWideChar;hContact:THANDLE=0):pWideChar; overload;
+function ConvertFileName(src:pAnsiChar;dst:pAnsiChar;hContact:THANDLE=0):pAnsiChar; overload;
+function ConvertFileName(src:pWideChar;dst:pWideChar;hContact:THANDLE=0):pWideChar; overload;
+
+procedure ShowPopupW(text:pWideChar;title:pWideChar=nil);
+function GetAddonFileName(prefix,altname,path:PAnsiChar;ext:PAnsiChar):PAnsiChar;
+function TranslateA2W(sz:PAnsiChar):PWideChar;
+function MirandaCP:integer;
+
+function isVarsInstalled:bool;
+function ParseVarString(astr:pAnsiChar;aContact:THANDLE=0;extra:pAnsiChar=nil):pAnsiChar; overload;
+function ParseVarString(astr:pWideChar;aContact:THANDLE=0;extra:pWideChar=nil):pWideChar; overload;
+function ShowVarHelp(dlg:HWND;id:integer=0):integer;
+
+function IsChat(hContact:THANDLE):bool;
+procedure SendToChat(hContact:THANDLE;pszText:PWideChar);
+
+function LoadContact(group,setting:PAnsiChar):THANDLE;
+function SaveContact(hContact:THANDLE;group,setting:PAnsiChar):integer;
+
+function SetCListSelContact(hContact:THANDLE):THANDLE;
+function GetCListSelContact:THANDLE; {$IFDEF DELPHI_10_UP}inline;{$ENDIF}
+function GetContactProtoAcc(hContact:THANDLE):PAnsiChar;
+function IsMirandaUser(hContact:THANDLE):integer; // >0=Miranda; 0=Not miranda; -1=unknown
+procedure ShowContactDialog(hContact:THANDLE;DblClk:boolean=true;anystatus:boolean=true);
+function FindContactHandle(proto:pAnsiChar;const dbv:TDBVARIANT;is_chat:boolean=false):THANDLE;
+function WndToContact(wnd:hwnd):THANDLE; overload;
+function WndToContact:THANDLE; overload;
+function GetContactStatus(hContact:THANDLE):integer;
+// -2 - deleted account, -1 - disabled account, 0 - hidden
+// 1 - metacontact, 2 - submetacontact, positive - active
+// proto - ASSIGNED buffer
+function IsContactActive(hContact:THANDLE;proto:pAnsiChar=nil):integer;
+
+function CreateGroupW(name:pWideChar;hContact:THANDLE):integer;
+function CreateGroup (name:pAnsiChar;hContact:THANDLE):integer;
+
+function MakeGroupMenu(idxfrom:integer=100):HMENU;
+function GetNewGroupName(parent:HWND):pWideChar;
+
+const
+ MAX_REDIRECT_RECURSE = 4;
+
+function SendRequest(url:PAnsiChar;rtype:int;args:pAnsiChar=nil;hNetLib:THANDLE=0):pAnsiChar;
+
+function GetFile(url:PAnsiChar;save_file:PAnsiChar;
+ hNetLib:THANDLE=0;recurse_count:integer=0):bool; overload;
+// next is just wrapper
+function GetFile(url:PWideChar;save_file:PWideChar;
+ hNetLib:THANDLE=0;recurse_count:integer=0):bool; overload;
+
+function GetProxy(hNetLib:THANDLE):PAnsiChar;
+function LoadImageURL(url:pAnsiChar;size:integer=0):HBITMAP;
+
+implementation
+
+uses Messages,dbsettings,common,io,freeimage,syswin;
+
+const
+ clGroup = 'Group';
+// Save / Load contact
+const
+ opt_cproto = 'cproto';
+ opt_cuid = 'cuid';
+ opt_ischat = 'ischat';
+
+function SetButtonIcon(btn:HWND;name:PAnsiChar):HICON;
+begin
+ result:=CallService(MS_SKIN2_GETICON,0,LPARAM(name));
+ SendMessage(btn,BM_SETIMAGE,IMAGE_ICON,result);
+end;
+
+function ConvertFileName(src:pWideChar;dst:pWideChar;hContact:THANDLE=0):pWideChar; overload;
+var
+ pc:pWideChar;
+begin
+ result:=dst;
+ dst^:=#0;
+ if (src<>nil) and (src^<>#0) then
+ begin
+ if isVarsInstalled then
+ begin
+ pc:=ParseVarString(src,hContact);
+ src:=pc;
+ end
+ else
+ pc:=nil;
+ CallService(MS_UTILS_PATHTOABSOLUTEW,wparam(src),lparam(dst));
+ mFreeMem(pc);
+ end;
+end;
+
+function ConvertFileName(src:pWideChar;hContact:THANDLE=0):pWideChar; overload;
+var
+ buf1:array [0..511] of WideChar;
+begin
+ if (src<>nil) and (src^<>#0) then
+ StrDupW(result,ConvertFileName(src,buf1,hContact))
+ else
+ result:=nil;
+end;
+
+function ConvertFileName(src:pAnsiChar;dst:pAnsiChar;hContact:THANDLE=0):pAnsiChar; overload;
+var
+ pc:pAnsiChar;
+begin
+ result:=dst;
+ dst^:=#0;
+ if (src<>nil) and (src^<>#0) then
+ begin
+ if isVarsInstalled then
+ begin
+ pc:=ParseVarString(src,hContact);
+ src:=pc;
+ end
+ else
+ pc:=nil;
+ CallService(MS_UTILS_PATHTOABSOLUTE,wparam(src),lparam(dst));
+ mFreeMem(pc);
+ end;
+end;
+
+function ConvertFileName(src:pAnsiChar;hContact:THANDLE=0):pAnsiChar; overload;
+var
+ buf1:array [0..511] of AnsiChar;
+begin
+ if (src<>nil) and (src^<>#0) then
+ StrDup(result,ConvertFileName(src,buf1,hContact))
+ else
+ result:=nil;
+end;
+
+const
+ MirCP:integer=-1;
+
+function MirandaCP:integer;
+begin
+ if MirCP<0 then
+ MirCP:=CallService(MS_LANGPACK_GETCODEPAGE,0,0);
+ result:=MirCP;
+end;
+
+function IsChat(hContact:THANDLE):bool;
+begin
+ result:=DBReadByte(hContact,
+ PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO,hContact,0)),
+ 'ChatRoom',0)=1;
+end;
+
+function isVarsInstalled:bool;
+begin
+ result:=ServiceExists(MS_VARS_FORMATSTRING)<>0;
+end;
+
+function ParseVarString(astr:pAnsiChar;aContact:THANDLE=0;extra:pAnsiChar=nil):pAnsiChar;
+var
+ tfi:TFORMATINFO;
+ tmp,pc:pAnsiChar;
+ dat:TREPLACEVARSDATA;
+begin
+ if ServiceExists(MS_UTILS_REPLACEVARS)<>0 then
+ begin
+ FillChar(dat,SizeOf(TREPLACEVARSDATA),0);
+ dat.cbSize :=SizeOf(TREPLACEVARSDATA);
+ pc:=pAnsiChar(CallService(MS_UTILS_REPLACEVARS,wparam(astr),lparam(@dat)));
+ astr:=pc;
+ end
+ else
+ pc:=nil;
+
+ if isVarsInstalled then
+ begin
+ FillChar(tfi,SizeOf(tfi),0);
+ with tfi do
+ begin
+ cbSize :=SizeOf(TFORMATINFO);
+ szFormat.a :=astr;
+ szExtraText.a:=extra;
+ hContact :=aContact;
+ end;
+ tmp:=pointer(CallService(MS_VARS_FORMATSTRING,wparam(@tfi),0));
+ StrDup(result,tmp);
+ CallService(MS_VARS_FREEMEMORY,wparam(tmp),0);
+ end
+ else
+ begin
+ StrDup(result,astr);
+ end;
+ mir_free(pc);
+end;
+
+function ParseVarString(astr:pWideChar;aContact:THANDLE=0;extra:pWideChar=nil):pWideChar;
+var
+ tfi:TFORMATINFO;
+ tmp,pc:pWideChar;
+ dat:TREPLACEVARSDATA;
+begin
+ if ServiceExists(MS_UTILS_REPLACEVARS)<>0 then
+ begin
+ FillChar(dat,SizeOf(TREPLACEVARSDATA),0);
+ dat.cbSize :=SizeOf(TREPLACEVARSDATA);
+ dat.dwflags:=RVF_UNICODE;
+ pc:=pWideChar(CallService(MS_UTILS_REPLACEVARS,wparam(astr),lparam(@dat)));
+ astr:=pc;
+ end
+ else
+ pc:=nil;
+
+ if isVarsInstalled then
+ begin
+ FillChar(tfi,SizeOf(tfi),0);
+ with tfi do
+ begin
+ cbSize :=SizeOf(TFORMATINFO);
+ flags :=FIF_UNICODE;
+ szFormat.w :=astr;
+ szExtraText.w:=extra;
+ hContact :=aContact;
+ end;
+ tmp:=pointer(CallService(MS_VARS_FORMATSTRING,wparam(@tfi),0));
+ StrDupW(result,tmp);
+ CallService(MS_VARS_FREEMEMORY,wparam(tmp),0);
+ end
+ else
+ begin
+ StrDupW(result,astr);
+ end;
+ mir_free(pc); // forced!
+// mFreeMem(pc);
+end;
+
+function ShowVarHelp(dlg:HWND;id:integer=0):integer;
+var
+ vhi:TVARHELPINFO;
+begin
+ FillChar(vhi,SizeOf(vhi),0);
+ with vhi do
+ begin
+ cbSize:=SizeOf(vhi);
+ if id=0 then
+ flags:=VHF_NOINPUTDLG
+ else
+ begin
+ flags :=VHF_FULLDLG or VHF_SETLASTSUBJECT;
+ hwndCtrl:=GetDlgItem(dlg,id);
+ end;
+ end;
+ result:=CallService(MS_VARS_SHOWHELPEX,dlg,lparam(@vhi));
+end;
+
+procedure ShowPopupW(text:pWideChar;title:pWideChar=nil);
+var
+ ppdu:TPOPUPDATAW;
+begin
+ FillChar(ppdu,SizeOf(TPOPUPDATAW),0);
+ if CallService(MS_POPUP_ISSECONDLINESHOWN,0,0)<>0 then
+ begin
+ StrCopyW(ppdu.lpwzText,text,MAX_SECONDLINE-1);
+ if title<>nil then
+ StrCopyW(ppdu.lpwzContactName,title,MAX_CONTACTNAME-1)
+ else
+ ppdu.lpwzContactName[0]:=' ';
+ end
+ else
+ begin
+ StrCopyW(ppdu.lpwzContactName,text,MAX_CONTACTNAME-1);
+ ppdu.lpwzText[0]:=' ';
+ end;
+ CallService(MS_POPUP_ADDPOPUPW,wparam(@ppdu),APF_NO_HISTORY);
+end;
+
+function TranslateA2W(sz:PAnsiChar):PWideChar;
+var
+ tmp:pWideChar;
+begin
+ mGetMem(tmp,(StrLen(sz)+1)*SizeOf(WideChar));
+ Result:=PWideChar(CallService(MS_LANGPACK_TRANSLATESTRING,LANG_UNICODE,
+ lParam(FastAnsiToWideBuf(sz,tmp))));
+ if Result<>tmp then
+ begin
+ StrDupW(Result,Result);
+ mFreeMem(tmp);
+ end;
+end;
+
+function GetContactProtoAcc(hContact:THANDLE):PAnsiChar;
+begin
+ if ServiceExists(MS_PROTO_GETCONTACTBASEACCOUNT)<>0 then
+ result:=PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEACCOUNT,hContact,0))
+ else
+ result:=PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO,hContact,0));
+end;
+
+function IsMirandaUser(hContact:THANDLE):integer; // >0=Miranda; 0=Not miranda; -1=unknown
+var
+ sz:PAnsiChar;
+begin
+ sz:=PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO,hContact,0));
+ sz:=DBReadString(hContact,sz,'MirVer');
+ if sz<>nil then
+ begin
+ result:=int_ptr(StrPos(sz,'Miranda'));
+ mFreeMem(sz);
+ end
+ else
+ result:=-1;
+end;
+
+function SetCListSelContact(hContact:THANDLE):THANDLE;
+var
+ wnd:HWND;
+begin
+ wnd:=CallService(MS_CLUI_GETHWNDTREE,0,0);
+ result:=hContact;
+// hContact:=SendMessage(wnd,CLM_FINDCONTACT ,hContact,0);
+ SendMessage(wnd,CLM_SELECTITEM ,hContact,0);
+// SendMessage(wnd,CLM_ENSUREVISIBLE,hContact,0);
+end;
+
+function GetCListSelContact:THANDLE;
+begin
+ result:=SendMessageW(CallService(MS_CLUI_GETHWNDTREE,0,0),CLM_GETSELECTION,0,0);
+end;
+
+function LoadContact(group,setting:PAnsiChar):THANDLE;
+var
+ p,proto:pAnsiChar;
+ section:array [0..63] of AnsiChar;
+ dbv:TDBVARIANT;
+ is_chat:boolean;
+begin
+ p:=StrCopyE(section,setting);
+ StrCopy(p,opt_cproto); proto :=DBReadString(0,group,section);
+ StrCopy(p,opt_ischat); is_chat:=DBReadByte (0,group,section,0)<>0;
+ StrCopy(p,opt_cuid );
+ if is_chat then
+ dbv.szVal.W:=DBReadUnicode(0,group,section,@dbv)
+ else
+ DBReadSetting(0,group,section,@dbv);
+
+ result:=FindContactHandle(proto,dbv,is_chat);
+
+ mFreeMem(proto);
+ if not is_chat then
+ DBFreeVariant(@dbv)
+ else
+ mFreeMem(dbv.szVal.W);
+end;
+
+function SaveContact(hContact:THANDLE;group,setting:PAnsiChar):integer;
+var
+ p,proto,uid:pAnsiChar;
+ cws:TDBVARIANT;
+ section:array [0..63] of AnsiChar;
+ pw:pWideChar;
+ is_chat:boolean;
+begin
+ result:=0;
+ proto:=GetContactProtoAcc(hContact);
+ if proto<>nil then
+ begin
+ p:=StrCopyE(section,setting);
+ is_chat:=IsChat(hContact);
+ if is_chat then
+ begin
+ pw:=DBReadUnicode(hContact,proto,'ChatRoomID');
+ StrCopy(p,opt_cuid); DBWriteUnicode(0,group,section,pw);
+ mFreeMem(pw);
+ result:=1;
+ end
+ else
+ begin
+ uid:=pAnsiChar(CallProtoService(proto,PS_GETCAPS,PFLAG_UNIQUEIDSETTING,0));
+ if uid<>pAnsiChar(CALLSERVICE_NOTFOUND) then
+ begin
+ if DBReadSetting(hContact,proto,uid,@cws)=0 then
+ begin
+ StrCopy(p,opt_cuid); DBWriteSetting(0,group,section,@cws);
+ DBFreeVariant(@cws);
+ result:=1;
+ end;
+ end;
+ end;
+ if result<>0 then
+ begin
+ StrCopy(p,opt_cproto); DBWriteString(0,group,section,proto);
+ StrCopy(p,opt_ischat); DBWriteByte (0,group,section,ord(is_chat));
+ end;
+ end;
+end;
+
+function WndToContact(wnd:hwnd):THANDLE; overload;
+var
+ hContact:THANDLE;
+ mwid:TMessageWindowInputData;
+ mwod:TMessageWindowOutputData;
+begin
+ wnd:=GetParent(wnd); //!!
+ hContact:=CallService(MS_DB_CONTACT_FINDFIRST,0,0);
+ with mwid do
+ begin
+ cbSize:=SizeOf(mwid);
+ uFlags:=MSG_WINDOW_UFLAG_MSG_BOTH;
+ end;
+ mwod.cbSize:=SizeOf(mwod);
+ while hContact<>0 do
+ begin
+ mwid.hContact:=hContact;
+ if CallService(MS_MSG_GETWINDOWDATA,wparam(@mwid),lparam(@mwod))=0 then
+ begin
+ if {((mwod.uState and MSG_WINDOW_STATE_FOCUS)<>0) and} (mwod.hwndWindow=wnd) then
+ begin
+ result:=mwid.hContact;
+ exit;
+ end
+ end;
+ hContact:=CallService(MS_DB_CONTACT_FINDNEXT,hContact,0);
+ end;
+ result:=0;
+end;
+
+function WndToContact:THANDLE; overload;
+var
+ wnd:HWND;
+begin
+ wnd:=GetFocus;
+ if wnd=0 then
+ wnd:=WaitFocusedWndChild(GetForegroundWindow);
+ if wnd<>0 then
+ result:=WndToContact(wnd)
+ else
+ result:=0;
+ if result=0 then
+ result:=GetCListSelContact;
+end;
+
+function GetContactStatus(hContact:THANDLE):integer;
+var
+ szProto:PAnsiChar;
+begin
+ szProto:=PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO,hContact,0));
+ if szProto=NIL then
+ result:=ID_STATUS_OFFLINE
+ else
+ result:=DBReadWord(hContact,szProto,'Status',ID_STATUS_OFFLINE);
+end;
+
+function CheckPath(filename,profilepath,path:PAnsiChar):PAnsiChar;
+var
+ buf:array [0..511] of AnsiChar;
+ f:THANDLE;
+ p:PAnsiChar;
+begin
+ result:=nil;
+ if profilepath<>nil then
+ StrCopy(buf,profilepath)
+ else
+ buf[0]:=#0;
+ StrCat(buf,filename);
+ f:=Reset(buf);
+ if f=THANDLE(INVALID_HANDLE_VALUE) then
+ begin
+ if path<>nil then
+ begin
+ CallService(MS_UTILS_PATHTOABSOLUTE,wparam(path),lparam(@buf));
+ p:=StrEnd(buf);
+ if p^<>'\' then
+ begin
+ p^:='\';
+ inc(p);
+ p^:=#0;
+ end;
+ end
+ else if profilepath=nil then
+ exit
+ else
+ buf[0]:=#0;
+ StrCat(buf,filename); //path\prefix+name
+ f:=Reset(buf);
+ end;
+ if f<>THANDLE(INVALID_HANDLE_VALUE) then
+ begin
+ CloseHandle(f);
+ StrDup(result,buf);
+ end;
+end;
+
+function GetAddonFileName(prefix,altname,path:PAnsiChar;ext:PAnsiChar):PAnsiChar;
+var
+ profilepath:array [0..511] of AnsiChar;
+ altfilename,filename:array [0..127] of AnsiChar;
+ p:PAnsiChar;
+begin
+ CallService(MS_DB_GETPROFILEPATH,300,lparam(@profilepath));
+ p:=StrEnd(profilepath);
+ p^:='\'; inc(p);
+ p^:=#0;
+ filename[0]:=#0;
+ altfilename[0]:=#0;
+ if prefix<>nil then
+ begin
+ StrCopy(filename,prefix);
+ p:=StrEnd(filename);
+ CallService(MS_DB_GETPROFILENAME,SizeOf(filename)-integer(p-pAnsiChar(@filename)),lparam(p));
+ ChangeExt(filename,ext);
+ result:=CheckPath(filename,profilepath,path);
+ end
+ else
+ result:=nil;
+
+ if (result=nil) and (altname<>nil) then
+ begin
+ StrCopy(altfilename,altname);
+ ChangeExt(altfilename,ext);
+ result:=CheckPath(altfilename,profilepath,path);
+ end;
+ if result=nil then
+ begin
+ if filename[0]<>#0 then
+ StrCat(profilepath,filename)
+ else
+ StrCat(profilepath,altfilename);
+ StrDup(result,profilepath);
+ end;
+end;
+
+procedure ShowContactDialog(hContact:THANDLE;DblClk:boolean=true;anystatus:boolean=true);
+var
+ pc:array [0..127] of AnsiChar;
+begin
+{
+CallService(MS_CLIST_CONTACTDOUBLECLICKED,hContact,0);
+}
+ if (hContact<>0) and (CallService(MS_DB_CONTACT_IS,hContact,0)<>0) then
+ begin
+ if StrCopy(pc,PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO,hContact,0)))<>nil then
+ if DblClk or (DBReadByte(hContact,pc,'ChatRoom',0)=1) then // chat room
+ begin
+ if not anystatus then
+ begin
+ StrCat(pc,PS_GETSTATUS);
+ anystatus:=(CallService(pc,0,0)<>ID_STATUS_OFFLINE);
+ end;
+ if anystatus then
+ begin
+ CallService(MS_CLIST_CONTACTDOUBLECLICKED,hContact,0); //??
+ // if chat exist, open chat
+ // else create new session
+ end;
+ end
+ else
+ begin
+ if ServiceExists(MS_MSG_CONVERS)<>0 then // Convers compat.
+ CallService(MS_MSG_CONVERS,hContact,0)
+ else
+ CallService(MS_MSG_SENDMESSAGE,hContact,0)
+ end;
+ end;
+end;
+
+procedure SendChatText(pszID:pointer;pszModule:PAnsiChar;pszText:pointer);
+var
+ gcd:TGCDEST;
+ gce:TGCEVENT;
+begin
+ gcd.pszModule:=pszModule;
+ gcd.iType :=GC_EVENT_SENDMESSAGE;
+ gcd.szID.w :=pszID;
+
+ FillChar(gce,SizeOf(TGCEVENT),0);
+ gce.cbSize :=SizeOf(TGCEVENT);
+ gce.pDest :=@gcd;
+ gce.bIsMe :=true;
+ gce.szText.w:=pszText;
+ gce.dwFlags :=GCEF_ADDTOLOG+GC_UNICODE;
+ gce.time :=GetCurrentTime;
+
+ CallServiceSync(MS_GC_EVENT,0,lparam(@gce));
+end;
+
+procedure SendToChat(hContact:THANDLE;pszText:PWideChar);
+var
+ gci:TGC_INFO;
+ pszModule:PAnsiChar;
+ i,cnt:integer;
+begin
+ pszModule:=PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO,hContact,0));
+ cnt:=CallService(MS_GC_GETSESSIONCOUNT,0,lparam(pszModule));
+ i:=0;
+ gci.pszModule:=pszModule;
+ while i<cnt do
+ begin
+ gci.iItem:=i;
+ gci.Flags:=GCI_BYINDEX+GCI_HCONTACT+GCI_ID;
+ CallService(MS_GC_GETINFO,0,lparam(@gci));
+ if gci.hContact=hContact then
+ begin
+ SendChatText(gci.pszID.w,pszModule,pszText);
+ break;
+ end;
+ inc(i);
+ end;
+end;
+
+function FindContactHandle(proto:pAnsiChar;const dbv:TDBVARIANT;is_chat:boolean=false):THANDLE;
+var
+ uid:pAnsiChar;
+ ldbv:TDBVARIANT;
+ hContact:THANDLE;
+ pw:pWideChar;
+begin
+ result:=0;
+ uid:=nil;
+ if not is_chat then
+ begin
+ uid:=pAnsiChar(CallProtoService(proto,PS_GETCAPS,PFLAG_UNIQUEIDSETTING,0));
+ if uid=pAnsiChar(CALLSERVICE_NOTFOUND) then exit;
+ end;
+
+ hContact:=CallService(MS_DB_CONTACT_FINDFIRST,0,0);
+ while hContact<>0 do
+ begin
+ if is_chat then
+ begin
+ if IsChat(hContact) then
+ begin
+ pw:=DBReadUnicode(hContact,proto,'ChatRoomID');
+ if StrCmpW(pw,dbv.szVal.W)=0 then result:=hContact;
+ mFreeMem(pw);
+ end
+ end
+ else
+ begin
+ if DBReadSetting(hContact,proto,uid,@ldbv)=0 then
+ begin
+ if dbv._type=ldbv._type then
+ begin
+ case dbv._type of
+// DBVT_DELETED: ;
+ DBVT_BYTE : if dbv.bVal=ldbv.bVal then result:=hContact;
+ DBVT_WORD : if dbv.wVal=ldbv.wVal then result:=hContact;
+ DBVT_DWORD : if dbv.dVal=ldbv.dVal then result:=hContact;
+ DBVT_UTF8,
+ DBVT_ASCIIZ : if StrCmp (dbv.szVal.A,ldbv.szVal.A)=0 then result:=hContact;
+ DBVT_WCHAR : if StrCmpW(dbv.szVal.W,ldbv.szVal.W)=0 then result:=hContact;
+ DBVT_BLOB : begin
+ if dbv.cpbVal = ldbv.cpbVal then
+ begin
+ if CompareMem(dbv.pbVal,ldbv.pbVal,dbv.cpbVal) then
+ result:=hContact;
+ end;
+ end;
+ end;
+ end;
+ DBFreeVariant(@ldbv);
+ end;
+ end;
+ // added 2011.04.20
+ if result<>0 then break;
+ hContact:=CallService(MS_DB_CONTACT_FINDNEXT,hContact,0);
+ end;
+end;
+
+function IsContactActive(hContact:THANDLE;proto:pAnsiChar=nil):integer;
+var
+ p:PPROTOACCOUNT;
+ dbv :TDBVARIANT;
+ dbcgs:TDBCONTACTGETSETTING;
+ name: array [0..31] of AnsiChar;
+begin
+
+ dbv._type :=DBVT_ASCIIZ;
+ dbv.szVal.a:=@name;
+ dbv.cchVal :=SizeOf(name);
+ dbcgs.pValue :=@dbv;
+ dbcgs.szModule :='Protocol';
+ dbcgs.szSetting:='p';
+
+ if CallService(MS_DB_CONTACT_GETSETTINGSTATIC,hContact,lparam(@dbcgs))=0 then
+ begin
+ result:=0;
+
+ if ServiceExists(MS_PROTO_GETACCOUNT)<>0 then
+ begin
+ p:=PPROTOACCOUNT(CallService(MS_PROTO_GETACCOUNT,0,lparam(dbv.szVal.a)));
+ if p=nil then
+ result:=-2 // deleted
+ else if (p^.bIsEnabled=0) or p^.bDynDisabled then
+ result:=-1; // disabled
+ end
+ else
+ begin
+ if CallService(MS_PROTO_ISPROTOCOLLOADED,0,lparam(dbv.szVal.a))=0 then
+ result:=-1;
+ end;
+
+ if (result=0) and (DBReadByte(hContact,strCList,'Hidden',0)=0) then
+ begin
+ result:=255;
+ if ServiceExists(MS_MC_GETMETACONTACT)<>0 then
+ begin
+ if CallService(MS_MC_GETMETACONTACT,hContact,0)<>0 then
+ result:=2;
+ if StrCmp(
+ PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO,hContact,0)),
+ PAnsiChar(CallService(MS_MC_GETPROTOCOLNAME,0,0)))=0 then
+ result:=1;
+ end;
+ end;
+ if proto<>nil then
+ StrCopy(proto,dbv.szVal.a);
+ end
+ else
+ begin
+ result:=-2;
+ if proto<>nil then
+ proto^:=#0;
+ end;
+
+end;
+
+// Import plugin function adaptation
+function CreateGroupW(name:pWideChar;hContact:THANDLE):integer;
+var
+ groupId:integer;
+ groupIdStr:array [0..10] of AnsiChar;
+ dbv:TDBVARIANT;
+ cgs:TDBCONTACTGETSETTING;
+ grbuf:array [0..127] of WideChar;
+ p:pWideChar;
+begin
+ if (name=nil) or (name^=#0) then
+ begin
+ result:=0;
+ exit;
+ end;
+
+ StrCopyW(@grbuf[1],name);
+ grbuf[0]:=WideChar(1 or GROUPF_EXPANDED);
+
+ // Check for duplicate & find unused id
+ groupId:=0;
+ cgs.szModule:='CListGroups';
+ cgs.pValue :=@dbv;
+ repeat
+ dbv._type:=DBVT_WCHAR;
+ cgs.szSetting:=IntToStr(groupIdStr,groupId);
+ if CallService(MS_DB_CONTACT_GETSETTING_STR,0,lParam(@cgs))<>0 then
+ break;
+
+ if StrCmpW(dbv.szVal.w+1,@grbuf[1])=0 then
+ begin
+ if hContact<>0 then
+ DBWriteUnicode(hContact,strCList,clGroup,@grbuf[1]);
+
+ DBFreeVariant(@dbv);
+ result:=0;
+ exit;
+ end;
+
+ DBFreeVariant(@dbv);
+ inc(groupId);
+ until false;
+
+ DBWriteUnicode(0,'CListGroups',groupIdStr,grbuf);
+
+ if hContact<>0 then
+ DBWriteUnicode(hContact,strCList,clGroup,@grbuf[1]);
+
+ p:=StrRScanW(grbuf,'\');
+ if p<>nil then
+ begin
+ p^:=#0;
+ CreateGroupW(grbuf+1,0);
+ end;
+
+ result:=1;
+end;
+
+function CreateGroup(name:pAnsiChar;hContact:THANDLE):integer;
+var
+ groupId:integer;
+ groupIdStr:array [0..10] of AnsiChar;
+ dbv:TDBVARIANT;
+ cgs:TDBCONTACTGETSETTING;
+ grbuf:array [0..127] of AnsiChar;
+ p:pAnsiChar;
+begin
+ if (name=nil) or (name^=#0) then
+ begin
+ result:=0;
+ exit;
+ end;
+
+ StrCopy(@grbuf[1],name);
+ grbuf[0]:=CHAR(1 or GROUPF_EXPANDED);
+
+ // Check for duplicate & find unused id
+ groupId:=0;
+ cgs.szModule:='CListGroups';
+ cgs.pValue :=@dbv;
+ repeat
+ dbv._type:=DBVT_ASCIIZ;
+ cgs.szSetting:=IntToStr(groupIdStr,groupId);
+ if CallService(MS_DB_CONTACT_GETSETTING_STR,0,lParam(@cgs))<>0 then
+ break;
+
+ if StrCmp(dbv.szVal.a+1,@grbuf[1])=0 then
+ begin
+ if hContact<>0 then
+ DBWriteString(hContact,strCList,clGroup,@grbuf[1]);
+
+ DBFreeVariant(@dbv);
+ result:=0;
+ exit;
+ end;
+
+ DBFreeVariant(@dbv);
+ inc(groupId);
+ until false;
+
+ DBWriteString(0,'CListGroups',groupIdStr,grbuf);
+
+ if hContact<>0 then
+ DBWriteString(hContact,strCList,clGroup,@grbuf[1]);
+
+ p:=StrRScan(grbuf,'\');
+ if p<>nil then
+ begin
+ p^:=#0;
+ CreateGroup(grbuf+1,0);
+ end;
+
+ result:=1;
+end;
+
+function MyStrSort(para1:pointer; para2:pointer):int; cdecl;
+begin
+ result:=StrCmpW(pWideChar(para1),pWideChar(para2));
+end;
+
+function MakeGroupMenu(idxfrom:integer=100):HMENU;
+var
+ sl:TSortedList;
+ i:integer;
+ b:array [0..15] of AnsiChar;
+ p:pWideChar;
+begin
+ result:=CreatePopupMenu;
+ i:=0;
+ AppendMenuW(result,MF_STRING,idxfrom,TranslateW('<Root Group>'));
+ AppendMenuW(result,MF_SEPARATOR,0,nil);
+ FillChar(sl,SizeOf(sl),0);
+ sl.increment:=16;
+ sl.sortFunc:=@MyStrSort;
+ repeat
+ p:=DBReadUnicode(0,'CListGroups',IntToStr(b,i),nil);
+ if p=nil then break;
+ List_InsertPtr(@sl,p+1);
+ inc(i);
+ until false;
+ inc(idxfrom);
+ for i:=0 to sl.realCount-1 do
+ begin
+ AppendMenuW(result,MF_STRING,idxfrom+i,pWideChar(sl.Items[i]));
+ p:=pWideChar(sl.Items[i])-1;
+ mFreeMem(p);
+ end;
+ List_Destroy(@sl);
+end;
+
+function GetNewGroupName(parent:HWND):pWideChar;
+var
+ mmenu:HMENU;
+ i:integer;
+ buf:array [0..63] of WideChar;
+ pt:TPoint;
+begin
+ result:=nil;
+ mmenu:=MakeGroupMenu(100);
+ GetCursorPos(pt);
+ i:=integer(TrackPopupMenu(mmenu,TPM_RETURNCMD+TPM_NONOTIFY,pt.x,pt.y,0,parent,nil));
+ if i>100 then // no root or cancel
+ begin
+ GetMenuStringW(mmenu,i,buf,HIGH(buf)+1,MF_BYCOMMAND);
+ StrDupW(result,buf);
+ end;
+ DestroyMenu(mmenu);
+end;
+
+function SendRequest(url:PAnsiChar;rtype:int;args:pAnsiChar=nil;hNetLib:THANDLE=0):pAnsiChar;
+var
+ nlu:TNETLIBUSER;
+ req :TNETLIBHTTPREQUEST;
+ resp:PNETLIBHTTPREQUEST;
+ hTmpNetLib:THANDLE;
+ nlh:array [0..1] of TNETLIBHTTPHEADER;
+ buf:array [0..31] of AnsiChar;
+begin
+ result:=nil;
+
+ FillChar(req,SizeOf(req),0);
+ req.cbSize :=NETLIBHTTPREQUEST_V1_SIZE;//SizeOf(req);
+ req.requestType:=rtype;
+ req.szUrl :=url;
+ req.flags :=NLHRF_NODUMP or NLHRF_HTTP11;
+ if args<>nil then
+ begin
+ nlh[0].szName :='Content-Type';
+ nlh[0].szValue:='application/x-www-form-urlencoded';
+ nlh[1].szName :='Content-Length';
+ nlh[1].szValue:=IntToStr(buf,StrLen(args));
+ req.headers :=@nlh;
+ req.headersCount:=2;
+ req.pData :=args;
+ req.dataLength :=StrLen(args);
+ end;
+
+ if hNetLib=0 then
+ begin
+ FillChar(nlu,SizeOf(nlu),0);
+ nlu.cbSize :=SizeOf(nlu);
+ nlu.flags :=NUF_HTTPCONNS or NUF_NOHTTPSOPTION or NUF_OUTGOING or NUF_NOOPTIONS;
+ nlu.szSettingsModule:='dummy';
+ hTmpNetLib:=CallService(MS_NETLIB_REGISTERUSER,0,lparam(@nlu));
+ end
+ else
+ hTmpNetLib:=hNetLib;
+
+ resp:=pointer(CallService(MS_NETLIB_HTTPTRANSACTION,hTmpNetLib,lparam(@req)));
+
+ if resp<>nil then
+ begin
+ if resp^.resultCode=200 then
+ begin
+ StrDup(result,resp.pData,resp.dataLength);
+ end
+ else
+ begin
+ result:=pAnsiChar(int_ptr(resp^.resultCode and $0FFF));
+ end;
+ CallService(MS_NETLIB_FREEHTTPREQUESTSTRUCT,0,lparam(resp));
+ end;
+
+ if (hNetLib=0) and (nlu.cbSize<>0) then
+ CallService(MS_NETLIB_CLOSEHANDLE,hTmpNetLib,0);
+end;
+
+(*
+static int __inline NLog(AnsiChar *msg) {
+ return CallService(MS_NETLIB_LOG, (WPARAM)hNetlibUser, (LPARAM)msg);
+}
+*)
+function GetFile(url:PAnsiChar;save_file:PAnsiChar;
+ hNetLib:THANDLE=0;recurse_count:integer=0):bool;
+var
+ nlu:TNETLIBUSER;
+ req :TNETLIBHTTPREQUEST;
+ resp:PNETLIBHTTPREQUEST;
+ hSaveFile:THANDLE;
+ i:integer;
+begin
+ result:=false;
+ if recurse_count>MAX_REDIRECT_RECURSE then
+ exit;
+ if (url=nil) or (url^=#0) or (save_file=nil) or (save_file^=#0) then
+ exit;
+
+ FillChar(req,SizeOf(req),0);
+ req.cbSize :=NETLIBHTTPREQUEST_V1_SIZE;//SizeOf(req);
+ req.requestType:=REQUEST_GET;
+ req.szUrl :=url;
+ req.flags :=NLHRF_NODUMP;
+
+
+ FillChar(nlu,SizeOf(nlu),0);
+ if hNetLib=0 then
+ begin
+ nlu.cbSize :=SizeOf(nlu);
+ nlu.flags :=NUF_HTTPCONNS or NUF_NOHTTPSOPTION or NUF_OUTGOING or NUF_NOOPTIONS;
+ nlu.szSettingsModule:='dummy';
+ hNetLib:=CallService(MS_NETLIB_REGISTERUSER,0,lparam(@nlu));
+ end;
+
+ resp:=pointer(CallService(MS_NETLIB_HTTPTRANSACTION,hNetLib,lparam(@req)));
+
+ if resp<>nil then
+ begin
+ if resp^.resultCode=200 then
+ begin
+ hSaveFile:=Rewrite(save_file);
+ if hSaveFile<>THANDLE(INVALID_HANDLE_VALUE) then
+ begin
+ BlockWrite(hSaveFile,resp^.pData^,resp^.dataLength);
+ CloseHandle(hSaveFile);
+ result:=true;
+ end
+ end
+ else if (resp.resultCode>=300) and (resp.resultCode<400) then
+ begin
+ // get new location
+ for i:=0 to resp^.headersCount-1 do
+ begin
+ //MessageBox(0,resp^.headers[i].szValue, resp^.headers[i].szName,MB_OK);
+ if StrCmp(resp^.headers^[i].szName,'Location')=0 then
+ begin
+ result:=GetFile(resp^.headers^[i].szValue,save_file,hNetLib,recurse_count+1);
+ break;
+ end
+ end;
+ end
+ else
+ begin
+{
+ _stprintf(buff, TranslateT("Failed to download \"%s\" - Invalid response, code %d"), plugin_name, resp->resultCode);
+
+ ShowError(buff);
+ AnsiChar *ts = GetAString(buff);
+ NLog(ts);
+}
+ end;
+ CallService(MS_NETLIB_FREEHTTPREQUESTSTRUCT,0,lparam(resp));
+
+ if nlu.cbSize<>0 then
+ CallService(MS_NETLIB_CLOSEHANDLE,hNetLib,0);
+ end;
+end;
+
+function GetFile(url:PWideChar;save_file:PWideChar;
+ hNetLib:THANDLE=0;recurse_count:integer=0):bool;
+var
+ aurl,asave:array [0..MAX_PATH-1] of AnsiChar;
+begin
+ FastWideToAnsiBuf(url,aurl);
+ FastWideToAnsiBuf(save_file,asave);
+ result:=GetFile(aurl,asave,hNetLib,0);
+end;
+
+function GetProxy(hNetLib:THANDLE):PAnsiChar;
+var
+ nlus:TNETLIBUSERSETTINGS;
+ pc:PAnsiChar;
+ proxy:array [0..127] of AnsiChar;
+begin
+ result:=nil;
+ nlus.cbSize:=SizeOf(nlus);
+ if CallService(MS_NETLIB_GETUSERSETTINGS,hNetLib,lparam(@nlus))<>0 then
+ begin
+ if nlus.useProxy<>0 then
+ begin
+ if nlus.proxyType<>PROXYTYPE_IE then
+ begin
+ pc:=@proxy;
+ if nlus.szProxyServer<>nil then
+ begin
+ if nlus.useProxyAuth<>0 then
+ begin
+ if nlus.szProxyAuthUser<>nil then
+ begin
+ pc:=StrCopyE(proxy,nlus.szProxyAuthUser);
+ if nlus.szProxyAuthPassword<>nil then
+ begin
+ pc^:=':'; inc(pc);
+ pc:=StrCopyE(pc,nlus.szProxyAuthPassword);
+ end;
+ pc^:='@';
+ inc(pc);
+ end;
+ end;
+ pc:=StrCopyE(pc,nlus.szProxyServer);
+ if nlus.wProxyPort<>0 then
+ begin
+ pc^:=':'; inc(pc);
+ IntToStr(pc,nlus.wProxyPort);
+ end;
+ end;
+ StrDup(result,proxy);
+ end
+ else // use IE proxy
+ begin
+ mGetMem(result,1);
+ result^:=#0;
+ end;
+ end;
+ end;
+end;
+
+function LoadImageURL(url:pAnsiChar;size:integer=0):HBITMAP;
+var
+ nlu:TNETLIBUSER;
+ req :TNETLIBHTTPREQUEST;
+ resp:PNETLIBHTTPREQUEST;
+ hNetLib:THANDLE;
+ im:TIMGSRVC_MEMIO;
+begin
+ result:=0;
+ if (url=nil) or (url^=#0) then
+ exit;
+
+ FillChar(req,SizeOf(req),0);
+ req.cbSize :=NETLIBHTTPREQUEST_V1_SIZE;//SizeOf(req);
+ req.requestType:=REQUEST_GET;
+ req.szUrl :=url;
+ req.flags :=NLHRF_NODUMP;
+
+ FillChar(nlu,SizeOf(nlu),0);
+ nlu.cbSize :=SizeOf(nlu);
+ nlu.flags :=NUF_HTTPCONNS or NUF_NOHTTPSOPTION or NUF_OUTGOING or NUF_NOOPTIONS;
+ nlu.szSettingsModule:='dummy';
+ hNetLib:=CallService(MS_NETLIB_REGISTERUSER,0,lparam(@nlu));
+
+ resp:=pointer(CallService(MS_NETLIB_HTTPTRANSACTION,hNetLib,lparam(@req)));
+
+ if resp<>nil then
+ begin
+ if resp^.resultCode=200 then
+ begin
+ im.iLen :=resp.dataLength;
+ im.pBuf :=resp.pData;
+ im.flags:=size shl 16;
+ im.fif :=FIF_JPEG;
+ result :=CallService(MS_IMG_LOADFROMMEM,wparam(@im),0);
+// if result<>0 then
+// DeleteObject(SendMessage(wnd,STM_SETIMAGE,IMAGE_BITMAP,result)); //!!
+ end;
+ CallService(MS_NETLIB_FREEHTTPREQUESTSTRUCT,0,lparam(resp));
+ end;
+ CallService(MS_NETLIB_CLOSEHANDLE,hNetLib,0);
+end;
+
+function RegisterSingleIcon(resname,ilname,descr,group:pAnsiChar):int;
+var
+ sid:TSKINICONDESC;
+begin
+ FillChar(sid,SizeOf(TSKINICONDESC),0);
+ sid.cbSize :=SizeOf(TSKINICONDESC);
+ sid.cx :=16;
+ sid.cy :=16;
+ sid.flags :=0;
+ sid.szSection.a:=group;
+
+ sid.hDefaultIcon :=LoadImageA(hInstance,resname,IMAGE_ICON,16,16,0);
+ sid.pszName :=ilname;
+ sid.szDescription.a:=descr;
+ result:=Skin_AddIcon(@sid);
+ DestroyIcon(sid.hDefaultIcon);
+end;
+
+end.
diff --git a/plugins/Utils.pas/msninfo.pas b/plugins/Utils.pas/msninfo.pas new file mode 100644 index 0000000000..05fef4959b --- /dev/null +++ b/plugins/Utils.pas/msninfo.pas @@ -0,0 +1,182 @@ +unit MSNInfo;
+
+interface
+
+type
+ pMSNInfo = ^tMSNInfo;
+ tMSNInfo = record
+ msnPlayer:pWideChar;
+ msnArtist:pWideChar;
+ msnTitle :pWideChar;
+ msnAlbum :pWideChar;
+ end;
+
+
+procedure StartMSNHook;
+procedure StopMSNHook;
+
+function GetMSNInfo:pMSNInfo;
+
+implementation
+
+uses windows, messages, common;
+
+const
+ HWND_MESSAGE = HWND(-3);
+
+const
+ MSNClassName = 'MsnMsgrUIManager';
+const
+ hMSNWindow:THANDLE = 0;
+
+const
+ RealMSNData:PWideChar = nil;
+ anMSNInfo:tMSNInfo =(
+ msnPlayer:nil;
+ msnArtist:nil;
+ msnTitle :nil;
+ msnAlbum :nil
+ );
+
+function GetMSNInfo:pMSNInfo;
+begin
+ if ((anMSNInfo.msnPlayer=nil) or (anMSNInfo.msnPlayer^=#0)) and
+ ((anMSNInfo.msnArtist=nil) or (anMSNInfo.msnArtist^=#0)) and
+ ((anMSNInfo.msnTitle =nil) or (anMSNInfo.msnTitle ^=#0)) and
+ ((anMSNInfo.msnAlbum =nil) or (anMSNInfo.msnAlbum ^=#0)) then
+ result:=nil
+ else
+ result:=@anMSNInfo;
+end;
+
+procedure ClearMSNInfo;
+begin
+ if RealMSNData<>nil then
+ begin
+ mFreeMem(RealMSNData);
+ RealMSNData:=nil;
+ end;
+ FillChar(anMSNInfo,SizeOf(anMSNInfo),0);
+ {FreeMem(anMSNInfo.msnPlayer);} //anMSNInfo.msnPlayer:=nil;
+ {FreeMem(anMSNInfo.msnArtist);} //anMSNInfo.msnArtist:=nil;
+ {FreeMem(anMSNInfo.msnTitle); } //anMSNInfo.msnTitle :=nil;
+ {FreeMem(anMSNInfo.msnAlbum); } //anMSNInfo.msnAlbum :=nil;
+end;
+
+procedure Split(pc:pWideChar);
+var
+ lpc:pWideChar;
+begin
+ // Player
+ anMSNInfo.msnPlayer:=pc;
+ while (pc^<>'\') or ((pc+1)^<>'0') do inc(pc);
+ pc^:=#0;
+ inc(pc,2);
+
+ // Type
+ lpc:=pc;
+
+ while (pc^<>'\') or ((pc+1)^<>'0') do inc(pc);
+ pc^:=#0;
+ inc(pc,2);
+
+ if StrCmpW(lpc,'Music')<>0 then
+ begin
+ anMSNInfo.msnPlayer:=nil;
+ exit;
+ end;
+
+ // Status
+ lpc:=pc;
+ if lpc^='0' then // stop track
+ begin
+ anMSNInfo.msnPlayer:=nil;
+ exit;
+ end;
+
+ while (pc^<>'\') or ((pc+1)^<>'0') do inc(pc);
+ pc^:=#0;
+ inc(pc,2);
+
+ // Format - just skip
+ while (pc^<>'\') or ((pc+1)^<>'0') do inc(pc);
+ pc^:=#0;
+ inc(pc,2);
+
+ // Artist
+ anMSNInfo.msnArtist:=pc;
+
+ while (pc^<>'\') or ((pc+1)^<>'0') do inc(pc);
+ pc^:=#0;
+ inc(pc,2);
+
+ // Title
+ anMSNInfo.msnTitle:=pc;
+
+ while (pc^<>'\') or ((pc+1)^<>'0') do inc(pc);
+ pc^:=#0;
+ inc(pc,2);
+
+ // Album
+ anMSNInfo.msnAlbum:=pc;
+
+ while (pc^<>'\') or ((pc+1)^<>'0') do inc(pc);
+ pc^:=#0;
+
+ // WMContentID - not needs
+end;
+
+function dlgMSNHook(Dialog:HWnd;hMessage:UINT;wParam:WPARAM;lParam:LPARAM):lresult; stdcall;
+var
+ pMyCDS:PCOPYDATASTRUCT;
+begin
+ result:=0;
+ case hMessage of
+ WM_COPYDATA: begin
+ pMyCDS:=PCOPYDATASTRUCT(lParam);
+ if pMyCDS^.dwData=1351 then // Media player info
+ begin
+ ClearMSNInfo;
+ Split(StrDupW(RealMSNData,pWideChar(pMyCDS^.lpData)));
+ end;
+ end;
+ else
+ result:=DefWindowProc(Dialog,hMessage,wParam,lParam);
+ end;
+end;
+
+procedure StartMSNhook;
+var
+ msnClass:TWNDCLASSW;
+ hMSNClass:THANDLE;
+begin
+ FillChar(msnClass,SizeOf(TWNDCLASS),0);
+
+ msnClass.hInstance :=hInstance;
+ msnClass.lpszClassName:=MSNClassName;
+ msnClass.lpfnWndProc :=@dlgMSNHook;
+ hMSNClass:=RegisterClassW(msnClass);
+
+ if (hMSNClass<>0) and (hMSNWindow=0) then
+ begin
+ hMSNWindow:=CreateWindowExW(0,PWideChar(hMSNClass),nil,0,1,1,1,1,HWND_MESSAGE,0,hInstance,nil);
+ end;
+ ClearMSNInfo;
+end;
+
+procedure StopMSNHook;
+begin
+ if hMSNWindow<>0 then
+ begin
+ DestroyWindow(hMSNWindow);
+ hMSNWindow:=0;
+
+ ClearMSNInfo;
+
+ UnRegisterClass(MSNClassName,hInstance);
+ end;
+end;
+
+//finalization
+// StopMSNHook;
+end.
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.
diff --git a/plugins/Utils.pas/playlist.pas b/plugins/Utils.pas/playlist.pas new file mode 100644 index 0000000000..2ffe0143d6 --- /dev/null +++ b/plugins/Utils.pas/playlist.pas @@ -0,0 +1,480 @@ +{Playlist process}
+unit playlist;
+
+interface
+
+type
+ tPlaylist = class
+ private
+ fShuffle :boolean;
+ plSize :cardinal; // playlist entries
+ plCapacity:cardinal;
+ base :pWideChar;
+ name :pWideChar;
+ descr :pWideChar;
+ plStrings :array of PWideChar;
+ CurElement:cardinal;
+ PlOrder :array of cardinal;
+ CurOrder :cardinal;
+
+ procedure SetShuffle(value:boolean);
+ function GetShuffle:boolean;
+ procedure DoShuffle;
+
+ function GetTrackNumber:integer;
+ procedure SetTrackNumber(value:integer);
+
+ procedure AddLine(name,descr:pWideChar;new:boolean=true);
+ function ProcessElement(num:integer=-1):PWideChar; //virtual;
+
+ public
+ constructor Create(fname:pWideChar);
+ destructor Free;
+
+ procedure SetBasePath(path:pWideChar);
+
+ function GetSong(number:integer=-1):pWideChar;
+ function GetCount:integer;
+
+ function Next :pWideChar;
+ function Previous:pWideChar;
+
+ property Track :integer read GetTrackNumber write SetTrackNumber;
+ property Shuffle:boolean read GetShuffle write SetShuffle;
+ end;
+
+function isPlaylist(fname:pWideChar):integer;
+function CreatePlaylist(fname:pWideChar):tPlaylist;
+function CreatePlaylistBuf(buf:pointer;format:integer):tPlaylist;
+
+implementation
+
+uses windows, common, io, memini;//, m_api, mirutils;
+
+const
+ plSizeStart = 2048;
+ plSizeStep = 256;
+const
+ pltM3OLD = $100;
+ pltM3UTF = $200;
+
+type
+ tM3UPlaylist = class(tPlaylist)
+ private
+ public
+ constructor Create(fName:pWideChar);
+ constructor CreateBuf(buf:pointer);
+ end;
+
+ tPLSPlaylist = class(tPlaylist)
+ private
+ public
+ constructor Create(fname:pWideChar);
+ constructor CreateBuf(buf:pointer);
+ end;
+
+function isPlaylist(fname:pWideChar):integer;
+var
+ ext:array [0..7] of WideChar;
+begin
+ GetExt(fname,ext,7);
+ if StrCmpW(ext,'M3U',3)=0 then result:=1
+ else if StrCmpW(ext,'PLS' )=0 then result:=2
+ else result:=0;
+end;
+
+function CreatePlaylist(fname:pWideChar):tPlaylist;
+begin
+ case isPlaylist(fname) of
+ 1: result:=tM3UPlaylist.Create(fname);
+ 2: result:=tPLSPlaylist.Create(fname);
+ else result:=nil;
+ end;
+end;
+
+function CreatePlaylistBuf(buf:pointer;format:integer):tPlaylist;
+begin
+ case format of
+ 1: result:=tM3UPlaylist.CreateBuf(buf);
+ 2: result:=tPLSPlaylist.CreateBuf(buf);
+ else result:=nil;
+ end;
+end;
+
+//----- -----
+
+function SkipLine(var p:PWideChar):bool;
+begin
+ while p^>=' ' do inc(p);
+ while p^<=' ' do // Skip spaces too
+ begin
+ if p^=#0 then
+ begin
+ result:=false;
+ exit;
+ end;
+ p^:=#0;
+ inc(p);
+ end;
+ result:=true;
+end;
+
+constructor tM3UPlaylist.CreateBuf(buf:pointer);
+var
+ p:PAnsiChar;
+ pp,pd:pWideChar;
+ plBufW:pWideChar;
+ lname,ldescr:pWideChar;
+ finish:boolean;
+ pltNew:boolean;
+begin
+ inherited;
+
+ p:=buf;
+ if (pdword(p)^ and $00FFFFFF)=$00BFBBEF then
+ begin
+ inc(p,3);
+ UTF8ToWide(p,plBufW)
+ end
+ else
+ AnsiToWide(p,plBufW);
+
+ pp:=plBufW;
+ pltNew:=StrCmpW(pp,'#EXTM3U',7)=0;
+ if pltNew then SkipLine(pp);
+
+ ldescr:=nil;
+ finish:=false;
+ repeat
+ if pltNew then
+ begin
+ pd:=StrScanW(pp,',');
+ if pd<>nil then
+ begin
+ ldescr:=pd+1;
+ if not SkipLine(pp) then break;
+ end;
+ end;
+ lname:=pp;
+ finish:=SkipLine(pp);
+ AddLine(lname,ldescr);
+ until not finish;
+
+ mFreeMem(plBufW);
+end;
+
+constructor tM3UPlaylist.Create(fName:pWideChar);
+var
+ f:THANDLE;
+ i:integer;
+ plBuf:pAnsiChar;
+begin
+ f:=Reset(fName);
+
+ if f<>THANDLE(INVALID_HANDLE_VALUE) then
+ begin
+ i:=integer(FileSize(f));
+ if i=-1 then
+ i:=integer(GetFSize(fName));
+ if i<>-1 then
+ begin
+ mGetMem(plBuf,i+1);
+ BlockRead(f,plBuf^,i);
+ CloseHandle(f);
+ plBuf[i]:=#0;
+ CreateBuf(plBuf);
+ mFreeMem(plBuf);
+ end;
+ end;
+
+end;
+
+//----- -----
+
+constructor tPLSPlaylist.CreateBuf(buf:pointer);
+var
+ lname,ldescr:pWideChar;
+ section,storage,sectionlist:pointer;
+ ffile,ftitle:array [0..31] of AnsiChar;
+ f,t:pAnsiChar;
+ i,size:integer;
+begin
+ inherited;
+
+ storage:=OpenStorageBuf(buf);
+ if storage=nil then
+ exit;
+ sectionlist:=GetSectionList(storage);
+ section:=SearchSection(storage,sectionlist);
+ FreeSectionList(sectionlist);
+
+ size:=GetParamSectionInt(section,'NumberOfEntries');
+ f:=StrCopyE(ffile ,'File');
+ t:=StrCopyE(ftitle,'Title');
+ for i:=1 to size do
+ begin
+ IntToStr(f,i);
+ AnsiToWide(GetParamSectionStr(section,ffile),lname);
+
+ IntToStr(t,i);
+ AnsiToWide(GetParamSectionStr(section,ftitle),ldescr);
+
+ AddLine(lname,ldescr,false);
+ end;
+
+ CloseStorage(storage);
+end;
+
+constructor tPLSPlaylist.Create(fName:pWideChar);
+var
+ buf:pAnsiChar;
+ h:THANDLE;
+ size:integer;
+begin
+ if FileExists(fname) then
+ begin
+ h:=Reset(fname);
+ if h<>THANDLE(INVALID_HANDLE_VALUE) then
+ begin
+ size:=FileSize(h);
+ if size>0 then
+ begin
+ GetMem(buf,size+1);
+ BlockRead(h,buf^,size);
+ buf[size]:=#0;
+ CreateBuf(buf);
+ FreeMem(buf);
+ end;
+ CloseHandle(h);
+ end;
+ end;
+end;
+
+//----- -----
+
+constructor tPlaylist.Create(fName:pWideChar);
+begin
+// inherited;
+
+ CurElement:=0;
+ base:=nil;
+ name:=nil;
+ descr:=nil;
+ Shuffle:=false;
+ plSize:=0;
+
+ SetBasePath(fname);
+end;
+
+destructor tPlaylist.Free;
+var
+ i:integer;
+begin
+ PlOrder:=nil;
+
+ mFreeMem(base);
+ mFreeMem(name);
+ mFreeMem(descr);
+
+ for i:=0 to plSize-1 do
+ begin
+ mFreeMem(plStrings[i*2]);
+ mFreeMem(plStrings[i*2+1]);
+ end;
+ plStrings:=nil;
+
+// inherited;
+end;
+
+procedure tPlaylist.AddLine(name,descr:pWideChar;new:boolean=true);
+begin
+ if plCapacity=0 then
+ begin
+ plCapacity:=plSizeStart;
+ SetLength(plStrings,plSizeStart*2);
+ fillChar(plStrings[0],plSizeStart*2*SizeOf(pWideChar),0);
+ end
+ else if plSize=plCapacity then
+ begin
+ inc(plCapacity,plSizeStep);
+ SetLength(plStrings,plCapacity*2);
+ fillChar(plStrings[plSize],plSizeStep*2*SizeOf(pWideChar),0);
+ end;
+ if new then
+ begin
+ StrDupW(plStrings[plSize*2 ],name);
+ StrDupW(plStrings[plSize*2+1],descr);
+ end
+ else
+ begin
+ plStrings[plSize*2 ]:=name;
+ plStrings[plSize*2+1]:=descr;
+ end;
+ inc(plSize);
+end;
+
+procedure tPlaylist.SetBasePath(path:pWideChar);
+var
+ buf:array [0..MAX_PATH-1] of WideChar;
+ p,pp:pWideChar;
+begin
+ mFreeMem(base);
+
+ pp:=ExtractW(path,false);
+ p:=StrCopyEW(buf,pp);
+ mFreeMem(pp);
+
+ if ((p-1)^<>'\') and ((p-1)^<>'/') then
+ begin
+ if StrScanW(buf,'/')<>nil then
+ p^:='/'
+ else
+ p^:='\';
+ inc(p);
+ end;
+ p^:=#0;
+ StrDupW(base,buf);
+end;
+
+function tPlaylist.GetCount:integer;
+begin
+ result:=plSize;
+end;
+
+function tPlaylist.GetTrackNumber:integer;
+begin
+ if fShuffle then
+ result:=CurOrder
+ else
+ result:=CurElement;
+end;
+
+procedure tPlaylist.SetTrackNumber(value:integer);
+begin
+ if value<0 then
+ value:=0
+ else if value>=Integer(plSize) then
+ value:=plSize-1;
+
+ if fShuffle then
+ CurOrder:=value
+ else
+ CurElement:=value;
+end;
+
+function tPlaylist.ProcessElement(num:integer=-1):pWideChar;
+begin
+ if num<0 then
+ num:=Track
+ else if num>=integer(plSize) then
+ num:=plSize-1;
+ if fShuffle then
+ num:=PlOrder[num];
+
+ result:=plStrings[num*2];
+end;
+
+function tPlaylist.GetSong(number:integer=-1):PWideChar;
+var
+ buf:array [0..MAX_PATH-1] of WideChar;
+begin
+ result:=ProcessElement(number);
+
+ if (result<>nil) and not isPathAbsolute(result) and (base<>nil) then
+ begin
+ StrCopyW(StrCopyEW(buf,base),result);
+ StrDupW(result,buf);
+ end
+ else
+ StrDupW(result,result);
+end;
+
+procedure tPlaylist.SetShuffle(value:boolean);
+begin
+ if value then
+ begin
+// if not fShuffle then // need to set Shuffle
+ DoShuffle;
+ end;
+
+ fShuffle:=value;
+end;
+
+function tPlaylist.GetShuffle:boolean;
+begin
+ result:=fShuffle;
+end;
+
+procedure tPlaylist.DoShuffle;
+var
+ i,RandInx: cardinal;
+ SwapItem: cardinal;
+begin
+ SetLength(PlOrder,plSize);
+ Randomize;
+ for i:=0 to plSize-1 do
+ PlOrder[i]:=i;
+ if plSize>1 then
+ begin
+ for i:=0 to plSize-2 do
+ begin
+ RandInx:=cardinal(Random(plSize-i));
+ SwapItem:=PlOrder[i];
+ PlOrder[i ]:=PlOrder[RandInx];
+ PlOrder[RandInx]:=SwapItem;
+ end;
+ end;
+ CurOrder:=0;
+end;
+
+function tPlaylist.Next:PWideChar;
+begin
+ if plSize<>0 then
+ begin
+ if not Shuffle then
+ begin
+ inc(CurElement);
+ if CurElement=plSize then
+ CurElement:=0;
+ end
+ else // if mode=plShuffle then
+ begin
+ inc(CurOrder);
+ if CurOrder=plSize then
+ begin
+ DoShuffle;
+ CurOrder:=0;
+ end;
+ end;
+ result:=GetSong;
+ end
+ else
+ result:=nil;
+end;
+
+function tPlaylist.Previous:PWideChar;
+begin
+ if plSize<>0 then
+ begin
+ if not Shuffle then
+ begin
+ if CurElement=0 then
+ CurElement:=plSize;
+ Dec(CurElement);
+ end
+ else // if mode=plShuffle then
+ begin
+ if CurOrder=0 then
+ begin
+ DoShuffle;
+ CurOrder:=plSize;
+ end;
+ dec(CurOrder);
+ end;
+ result:=GetSong;
+ end
+ else
+ result:=nil;
+end;
+
+end.
diff --git a/plugins/Utils.pas/protocols.pas b/plugins/Utils.pas/protocols.pas new file mode 100644 index 0000000000..8b585c39b4 --- /dev/null +++ b/plugins/Utils.pas/protocols.pas @@ -0,0 +1,610 @@ +unit protocols;
+
+interface
+
+uses windows,m_api;
+
+function FindProto(proto:PAnsiChar):uint_ptr;
+
+function GetStatusNum(status:integer):integer;
+function GetNumProto:cardinal;
+
+function GetProtoSetting(ProtoNum:uint_ptr;param:boolean=false):LPARAM;
+procedure SetProtoSetting(ProtoNum:uint_ptr;mask:LPARAM;param:boolean=false);
+
+function IsTunesSupported (ProtoNum:uint_ptr):bool;
+function IsXStatusSupported(ProtoNum:uint_ptr):bool;
+function IsChatSupported (ProtoNum:uint_ptr):bool;
+
+function GetProtoStatus (ProtoNum:uint_ptr):integer;
+function GetProtoStatusNum(ProtoNum:uint_ptr):integer;
+function GetProtoName (ProtoNum:uint_ptr):PAnsiChar;
+
+procedure FillProtoList (list:hwnd;withIcons:bool=false);
+procedure CheckProtoList (list:hwnd);
+procedure FillStatusList (proto:cardinal;list:hwnd;withIcons:bool=false);
+procedure CheckStatusList(list:hwnd;ProtoNum:cardinal);
+
+function CreateProtoList(deepscan:boolean=false):integer;
+procedure FreeProtoList;
+
+function SetStatus(proto:PAnsiChar;status:integer;txt:PAnsiChar=pointer(-1)):integer;
+function SetXStatus(proto:PAnsiChar;newstatus:integer;
+ txt:pWideChar=nil;title:pWideChar=nil):integer;
+function GetXStatus(proto:PAnsiChar;txt:pointer=nil;title:pointer=nil):integer;
+
+const
+ psf_online = $0001;
+ psf_invisible = $0002;
+ psf_shortaway = $0004;
+ psf_longaway = $0008;
+ psf_lightdnd = $0010;
+ psf_heavydnd = $0020;
+ psf_freechat = $0040;
+ psf_outtolunch = $0080;
+ psf_onthephone = $0100;
+ psf_enabled = $0800;
+ psf_all = $08FF;
+ // protocol properties
+ psf_chat = $1000;
+ psf_icq = $2000;
+ psf_tunes = $4000;
+ psf_deleted = $8000;
+
+implementation
+
+uses commctrl,common,dbsettings;
+
+const
+ defproto = '- default -';
+
+const
+ NumStatus = 10;
+ StatCodes:array [0..NumStatus-1] of integer=(
+ ID_STATUS_OFFLINE,
+ ID_STATUS_ONLINE,
+ ID_STATUS_INVISIBLE,
+ ID_STATUS_AWAY,
+ ID_STATUS_NA,
+ ID_STATUS_OCCUPIED,
+ ID_STATUS_DND,
+ ID_STATUS_FREECHAT,
+ ID_STATUS_OUTTOLUNCH,
+ ID_STATUS_ONTHEPHONE);
+const
+ StatNames:array [0..NumStatus-1] of PWideChar=(
+ 'Default'{'Offline'},'Online','Invisible','Away','N/A','Occupied','DND',
+ 'Free for chat','Out to lunch','On the Phone');
+
+type
+ pMyProto = ^tMyProto;
+ tMyProto = record
+ name :PAnsiChar; // internal account name
+ descr :PWideChar; // public account name
+// xstat :integer; // old ICQ XStatus
+ enabled :integer;
+ status :integer; // mask
+ param :LPARAM;
+ end;
+ pMyProtos = ^tMyProtos;
+ tMyProtos = array [0..100] of tMyProto;
+
+var
+ protos:pMyProtos;
+ NumProto:cardinal;
+ hAccounts:THANDLE;
+
+function FindProto(proto:PAnsiChar):uint_ptr;
+var
+ i:integer;
+begin
+ if uint_ptr(proto)<=100 then
+ begin
+ result:=uint_ptr(proto);
+ exit;
+ end;
+ for i:=1 to NumProto do
+ begin
+ if StrCmp(proto,protos^[i].name)=0 then
+ begin
+ result:=i;
+ exit;
+ end;
+ end;
+ result:=0;
+end;
+
+function IsTunesSupported(ProtoNum:uint_ptr):bool;
+begin
+ ProtoNum:=FindProto(PAnsiChar(ProtoNum));
+ if (ProtoNum<=NumProto) and ((protos^[ProtoNum].status and psf_tunes)<>0) then
+ result:=true
+ else
+ result:=false;
+end;
+
+function IsXStatusSupported(ProtoNum:uint_ptr):bool;
+begin
+ ProtoNum:=FindProto(PAnsiChar(ProtoNum));
+ if (ProtoNum<=NumProto) and ((protos^[ProtoNum].status and psf_icq)<>0) then
+ result:=true
+ else
+ result:=false;
+end;
+
+function IsChatSupported(ProtoNum:uint_ptr):bool;
+begin
+ ProtoNum:=FindProto(PAnsiChar(ProtoNum));
+ if (ProtoNum<=NumProto) and ((protos^[ProtoNum].status and psf_chat)<>0) then
+ result:=true
+ else
+ result:=false;
+end;
+
+function GetProtoSetting(ProtoNum:uint_ptr;param:boolean=false):LPARAM;
+begin
+ ProtoNum:=FindProto(PAnsiChar(ProtoNum));
+ if ProtoNum<=NumProto then
+ begin
+ if param then
+ result:=protos^[ProtoNum].param
+ else
+ result:=protos^[ProtoNum].enabled
+ end
+ else
+ result:=0;
+end;
+
+procedure SetProtoSetting(ProtoNum:uint_ptr;mask:LPARAM;param:boolean=false);
+begin
+ ProtoNum:=FindProto(PAnsiChar(ProtoNum));
+ if ProtoNum<=NumProto then
+ begin
+ if param then
+ protos^[ProtoNum].param:=mask
+ else
+ protos^[ProtoNum].enabled:=mask;
+ end;
+end;
+
+function GetStatusNum(status:integer):integer;
+var
+ i:integer;
+begin
+ for i:=0 to NumStatus-1 do
+ if StatCodes[i]=status then
+ begin
+ result:=i;
+ exit;
+ end;
+ result:=0; //-1
+end;
+
+function GetProtoStatus(ProtoNum:uint_ptr):integer;
+begin
+ ProtoNum:=FindProto(PAnsiChar(ProtoNum));
+ result:=CallProtoService(protos^[ProtoNum].name,PS_GETSTATUS,0,0);
+end;
+
+function GetProtoStatusNum(ProtoNum:uint_ptr):integer;
+begin
+ ProtoNum:=FindProto(PAnsiChar(ProtoNum));
+ result:=GetStatusNum(GetProtoStatus(ProtoNum));
+end;
+
+function GetNumProto:cardinal;
+begin
+ result:=NumProto;
+end;
+
+function GetProtoName(ProtoNum:uint_ptr):PAnsiChar;
+begin
+ if ProtoNum<=NumProto then
+ result:=protos^[ProtoNum].name
+ else
+ result:=nil;
+end;
+
+procedure FillProtoList(list:hwnd;withIcons:bool=false);
+var
+ item:TLVITEMW;
+ lvc:TLVCOLUMN;
+ i,NewItem:integer;
+ cli:PCLIST_INTERFACE;
+begin
+ FillChar(lvc,SizeOf(lvc),0);
+ ListView_SetExtendedListViewStyle(list, LVS_EX_CHECKBOXES);
+ if withIcons then
+ begin
+ cli:=PCLIST_INTERFACE(CallService(MS_CLIST_RETRIEVE_INTERFACE,0,0));
+ SetWindowLongPtrW(list,GWL_STYLE,
+ GetWindowLongPtrW(list,GWL_STYLE) or LVS_SHAREIMAGELISTS);
+ ListView_SetImageList(list,
+ CallService(MS_CLIST_GETICONSIMAGELIST,0,0),LVSIL_SMALL);
+ lvc.mask:=LVCF_FMT+LVCF_IMAGE
+ end
+ else
+ begin
+ cli:=nil;
+ lvc.mask:=LVCF_FMT;
+ end;
+
+ lvc.fmt :={LVCFMT_IMAGE or} LVCFMT_LEFT;
+ ListView_InsertColumn(list,0,lvc);
+
+ FillChar(item,SizeOf(item),0);
+ if withIcons then
+ item.mask:=LVIF_TEXT+LVIF_IMAGE
+ else
+ item.mask:=LVIF_TEXT;
+ for i:=0 to NumProto do
+ begin
+ item.iItem:=i;
+ item.pszText:=protos^[i].descr;
+ if withIcons and (i>0) then
+ item.iImage:=cli^.pfnIconFromStatusMode(protos^[i].name,ID_STATUS_ONLINE,0);
+ newItem:=SendMessageW(list,LVM_INSERTITEMW,0,lParam(@item));
+ if newItem>=0 then
+ ListView_SetCheckState(list,newItem,(protos^[i].enabled and psf_enabled)<>0)
+ end;
+ ListView_SetItemState (list,0,LVIS_FOCUSED or LVIS_SELECTED,LVIS_FOCUSED or LVIS_SELECTED);
+
+ ListView_SetColumnWidth(list,0,LVSCW_AUTOSIZE);
+end;
+
+procedure CheckProtoList(list:hwnd);
+var
+ i:integer;
+begin
+ for i:=1 to ListView_GetItemCount(list) do
+ begin
+ with protos^[i] do
+ if ListView_GetCheckState(list,i)=BST_CHECKED then
+ enabled:=enabled or psf_enabled
+ else
+ enabled:=enabled and not psf_enabled;
+ end;
+end;
+
+procedure FillStatusList(proto:cardinal;list:hwnd;withIcons:bool=false);
+
+ procedure AddString(num:integer;enabled:boolean;cli:PCLIST_INTERFACE);
+ var
+ item:LV_ITEMW;
+ NewItem:integer;
+ begin
+ FillChar(item,SizeOf(item),0);
+ item.iItem :=num;
+ item.lParam :=StatCodes[num];
+ if cli<>nil then
+ begin
+ item.mask :=LVIF_TEXT+LVIF_PARAM+LVIF_IMAGE;
+ item.iImage:=cli^.pfnIconFromStatusMode(protos^[proto].name,item.lParam,0);
+ end
+ else
+ item.mask :=LVIF_TEXT+LVIF_PARAM;
+ item.pszText:=TranslateW(StatNames[num]);
+ newItem:=SendMessageW(list,LVM_INSERTITEMW,0,lparam(@item));
+ if newItem>=0 then
+ ListView_SetCheckState(list,newItem,enabled);
+ end;
+
+var
+ lvc:TLVCOLUMN;
+ cli:PCLIST_INTERFACE;
+begin
+ if proto=0 then
+ withIcons:=false;
+ ListView_DeleteAllItems(list);
+ ListView_DeleteColumn(list,0);
+ FillChar(lvc,SizeOf(lvc),0);
+ ListView_SetExtendedListViewStyle(list, LVS_EX_CHECKBOXES);
+ if withIcons then
+ begin
+ cli:=PCLIST_INTERFACE(CallService(MS_CLIST_RETRIEVE_INTERFACE,0,0));
+ SetWindowLongPtrW(list,GWL_STYLE,
+ GetWindowLongPtrW(list,GWL_STYLE) or LVS_SHAREIMAGELISTS);
+ ListView_SetImageList(list,
+ CallService(MS_CLIST_GETICONSIMAGELIST,0,0),LVSIL_SMALL);
+ lvc.mask:=LVCF_FMT+LVCF_IMAGE
+ end
+ else
+ begin
+ cli:=nil;
+ SetWindowLongPtrW(list,GWL_STYLE,
+ GetWindowLongPtrW(list,GWL_STYLE) and not LVS_SHAREIMAGELISTS);
+// ListView_SetImageList(list,0,LVSIL_SMALL);
+ lvc.mask:=LVCF_FMT;
+ end;
+ lvc.fmt:={LVCFMT_IMAGE or} LVCFMT_LEFT;
+ ListView_InsertColumn(list,0,lvc);
+
+ AddString(0,true,nil);
+ ListView_SetItemState (list,0,LVIS_FOCUSED or LVIS_SELECTED,$000F);
+ with protos^[proto] do
+ begin
+ if (status and psf_online )<>0 then AddString(1,(enabled and psf_online )<>0,cli);
+ if (status and psf_invisible )<>0 then AddString(2,(enabled and psf_invisible )<>0,cli);
+ if (status and psf_shortaway )<>0 then AddString(3,(enabled and psf_shortaway )<>0,cli);
+ if (status and psf_longaway )<>0 then AddString(4,(enabled and psf_longaway )<>0,cli);
+ if (status and psf_lightdnd )<>0 then AddString(5,(enabled and psf_lightdnd )<>0,cli);
+ if (status and psf_heavydnd )<>0 then AddString(6,(enabled and psf_heavydnd )<>0,cli);
+ if (status and psf_freechat )<>0 then AddString(7,(enabled and psf_freechat )<>0,cli);
+ if (status and psf_outtolunch)<>0 then AddString(8,(enabled and psf_outtolunch)<>0,cli);
+ if (status and psf_onthephone)<>0 then AddString(9,(enabled and psf_onthephone)<>0,cli);
+ end;
+ ListView_SetColumnWidth(list,0,LVSCW_AUTOSIZE);
+end;
+
+procedure CheckStatusList(list:hwnd;ProtoNum:cardinal);
+
+ procedure SetStatusMask(stat:integer;state:bool);
+ var
+ i:integer;
+ begin
+ case stat of
+ ID_STATUS_ONLINE: i:=psf_online;
+ ID_STATUS_INVISIBLE: i:=psf_invisible;
+ ID_STATUS_AWAY: i:=psf_shortaway;
+ ID_STATUS_NA: i:=psf_longaway;
+ ID_STATUS_OCCUPIED: i:=psf_lightdnd;
+ ID_STATUS_DND: i:=psf_heavydnd;
+ ID_STATUS_FREECHAT: i:=psf_freechat;
+ ID_STATUS_OUTTOLUNCH: i:=psf_outtolunch;
+ ID_STATUS_ONTHEPHONE: i:=psf_onthephone;
+ else
+ exit;
+ end;
+ with protos^[ProtoNum] do
+ if state then
+ enabled:=enabled or i
+ else
+ enabled:=enabled and not i;
+ end;
+
+var
+ i:integer;
+ Item:TLVITEM;
+begin
+ for i:=1 to ListView_GetItemCount(list)-1 do //skip default
+ begin
+ Item.iItem:=i;
+ Item.mask:=LVIF_PARAM;
+ ListView_GetItem(list,Item);
+ SetStatusMask(Item.lParam,ListView_GetCheckState(list,i)=BST_CHECKED)
+ end;
+end;
+
+function AccListChanged(wParam:WPARAM;lParam:LPARAM):int;cdecl;
+var
+ i:integer;
+begin
+ result:=0;
+ case wParam of
+ PRAC_ADDED: begin
+ end;
+ PRAC_CHANGED: begin
+ i:=FindProto(PPROTOACCOUNT(lParam).szModuleName);
+ if i>0 then
+ protos^[i].descr:=PPROTOACCOUNT(lParam).tszAccountName.w;
+ end;
+ PRAC_REMOVED: begin
+ end;
+ end;
+end;
+
+function CreateProtoList(deepscan:boolean=false):integer;
+var
+ protoCount,i:integer;
+ proto:^PPROTOACCOUNT;
+ buf:array [0..127] of AnsiChar;
+ flag:integer;
+ p:pAnsichar;
+// hContract:THANDLE;
+begin
+ CallService(MS_PROTO_ENUMACCOUNTS,wparam(@protoCount),lparam(@proto));
+
+ mGetMem(protos,(protoCount+1)*SizeOf(tMyProto)); // 0 - default
+ NumProto:=0;
+ with protos^[0] do
+ begin
+ name :=defproto;
+ descr :=defproto;
+ status :=-1;
+ enabled:=-1;
+ end;
+ for i:=1 to protoCount do
+ begin
+ // active and switched off (but not deleted)
+ inc(NumProto);
+ with protos^[NumProto] do
+ begin
+ name :=proto^^.szModuleName;
+ descr:=proto^^.tszAccountName.w;
+
+ enabled:=psf_all;//psf_enabled;
+ status :=0;
+// xstat :=-1;
+ flag:=CallProtoService(name,PS_GETCAPS,PFLAGNUM_2,0);
+ if (flag and PF2_ONLINE) <>0 then status:=status or psf_online;
+ if (flag and PF2_INVISIBLE) <>0 then status:=status or psf_invisible;
+ if (flag and PF2_SHORTAWAY) <>0 then status:=status or psf_shortaway;
+ if (flag and PF2_LONGAWAY) <>0 then status:=status or psf_longaway;
+ if (flag and PF2_LIGHTDND) <>0 then status:=status or psf_lightdnd;
+ if (flag and PF2_HEAVYDND) <>0 then status:=status or psf_heavydnd;
+ if (flag and PF2_FREECHAT) <>0 then status:=status or psf_freechat;
+ if (flag and PF2_OUTTOLUNCH)<>0 then status:=status or psf_outtolunch;
+ if (flag and PF2_ONTHEPHONE)<>0 then status:=status or psf_onthephone;
+
+ flag:=CallProtoService(name,PS_GETCAPS,PFLAGNUM_1,0);
+ if ((flag and PF1_CHAT)<>0) or
+ (DBReadByte(0,name,'CtcpChatAccept',13)<>13) or // IRC
+ (DBReadByte(0,name,'Jud',13)<>13) then // Jabber
+// flag:=CallProtoService(name,PS_GETCAPS,PFLAGNUM_1,0);
+// if (flag and PF1_CHAT)<>0 then
+ status:=status or psf_chat;
+ p:=StrCopyE(buf,name);
+ StrCopy(p,PS_ICQ_GETCUSTOMSTATUS);
+ if ServiceExists(buf)<>0 then
+ status:=status or psf_icq;
+
+ StrCopy(p,PS_SET_LISTENINGTO);
+ if ServiceExists(buf)<>0 then
+ status:=status or psf_tunes;
+
+ end;
+ inc(proto);
+ end;
+
+{
+ if deepscan then
+ begin
+ hContact:=CallService(MS_DB_CONTACT_FINDFIRST,0,0);
+ while hContact<>0 do
+ begin
+ i:=NumProto;
+ while i>0 do
+ begin
+ if StrCmp()=0 then
+ break;
+ dec(i);
+ end;
+
+ hContact:=CallService(MS_DB_CONTACT_FINDNEXT,hContact,0);
+ end;
+ end;
+}
+ result:=NumProto;
+
+ hAccounts:=HookEvent(ME_PROTO_ACCLISTCHANGED,@AccListChanged);
+end;
+
+procedure FreeProtoList;
+begin
+ UnhookEvent(hAccounts);
+ mFreeMem(protos);
+ NumProto:=0;
+end;
+
+function SetStatus(proto:PAnsiChar;status:integer;txt:PAnsiChar=pointer(-1)):integer;
+//var nas:TNAS_PROTOINFO;
+begin
+ if status>0 then
+ result:=CallProtoService(proto,PS_SETSTATUS,status,0)
+ else
+ result:=-1;
+ if txt<>PAnsiChar(-1) then
+ begin
+// if ServiceExists(MS_NAS_SETSTATEA)=0 then
+ result:=CallProtoService(proto,PS_SETAWAYMSG,abs(status),lparam(txt))
+(*
+ else
+ begin
+ {
+ nas.Msg.w:=mmi.malloc((StrLenW(txt)+1)*SizeOf(WideChar));
+ nas.Msg.w^:=#0;
+ StrCopyW(nas.Msg.w,txt);
+ }
+ StrDup(nas.Msg.a,txt);
+ nas.Flags :=0;
+ nas.cbSize :=SizeOf(nas);
+ nas.szProto:=proto;
+ nas.status :=abs(status){0};
+ result:=CallService(MS_NAS_SETSTATEA,LPARAM(@nas),1);
+ end;
+*)
+ end;
+end;
+
+function SetXStatus(proto:PAnsiChar;newstatus:integer;
+ txt:pWideChar=nil;title:pWideChar=nil):integer;
+var
+ ics:TICQ_CUSTOM_STATUS;
+begin
+ result:=0;
+ if IsXStatusSupported(uint_ptr(proto)) then
+ begin
+ with ics do
+ begin
+ cbSize:=SizeOf(ics);
+ flags:=CSSF_UNICODE;
+ if newstatus>=0 then
+ begin
+ flags:=flags or CSSF_MASK_STATUS;
+ status:=@newstatus;
+ end;
+ if title<>PWideChar(-1) then
+ begin
+ flags:=flags or CSSF_MASK_NAME;
+ szName.w:=title;
+ end;
+ if txt<>PWideChar(-1) then
+ begin
+ flags:=flags or CSSF_MASK_MESSAGE;
+ szMessage.w:=txt;
+ end;
+ end;
+ result:=CallProtoService(proto,PS_ICQ_SETCUSTOMSTATUSEX,0,lparam(@ics));
+ end;
+end;
+
+function GetXStatus(proto:PAnsiChar;txt:pointer=nil;title:pointer=nil):integer;
+var
+ buf:array [0..127] of AnsiChar;
+ pc:PAnsiChar;
+ param:array [0..63] of AnsiChar;
+
+// ics:TICQ_CUSTOM_STATUS;
+// i,j:integer;
+begin
+ result:=0;
+ if IsXStatusSupported(uint_ptr(proto)) then
+ begin
+{
+ with ics do
+ begin
+ cbSize:=SizeOf(ics);
+ flags:=CSSF_STR_SIZES;
+ wParam:=@i;
+ lParam:=@j;
+ end;
+ CallProtoService(0,PS_ICQ_GETCUSTOMSTATUSEX,0,dword(@ics));
+ if title<>nil then
+ mGetMem(title^,(i+1)*SizeOf(WideChar));
+ if txt<>nil then
+ mGetMem(txt^,(j+1)*SizeOf(WideChar));
+
+ with ics do
+ begin
+ cbSize:=SizeOf(ics);
+ flags:=CSSF_MASK_STATUS or CSSF_MASK_NAME or CSSF_MASK_MESSAGE or CSSF_UNICODE;
+ status:=@result;
+ szName.w :=pdword(title)^;
+ szMessage.w:=pdword(txt)^;
+ end;
+ CallProtoService(0,PS_ICQ_GETCUSTOMSTATUSEX,0,dword(@ics));
+}
+
+ StrCopy(buf,proto);
+ StrCat (buf,PS_ICQ_GETCUSTOMSTATUS);
+ result:=CallService(buf,0,0);
+ if (txt<>nil) or (title<>nil) then
+ begin
+ move('XStatus',param,7);
+ IntToStr(param+7,result);
+ pc:=strend(param);
+
+ if txt<>nil then
+ begin
+ StrCopy(pc,'Msg'); pWideChar(txt^):=DBReadUnicode(0,proto,param,nil);
+ end;
+ if title<>nil then
+ begin
+ StrCopy(pc,'Name'); pWideChar(title^):=DBReadUnicode(0,proto,param,nil);
+ end;
+ end;
+
+ end;
+end;
+
+end.
diff --git a/plugins/Utils.pas/sedit.pas b/plugins/Utils.pas/sedit.pas new file mode 100644 index 0000000000..c216cecc09 --- /dev/null +++ b/plugins/Utils.pas/sedit.pas @@ -0,0 +1,1331 @@ +{structure editor}
+unit SEdit;
+
+interface
+
+uses windows;
+
+function EditStructure(struct:pAnsiChar;parent:HWND=0):pAnsiChar;
+
+implementation
+
+uses io,messages, commctrl, common, wrapper, strans, memini
+ {$IFDEF Miranda}, m_api, mirutils{$ENDIF};
+{
+ <STE_* set> <len> <data>
+}
+{$r structopts.res}
+{$include i_struct_const.inc}
+
+{$IFDEF Miranda}
+const
+ ACI_NEW :PAnsiChar = 'ACI_New';
+ ACI_UP :PAnsiChar = 'ACI_Up';
+ ACI_DOWN :PAnsiChar = 'ACI_Down';
+ ACI_DELETE :PAnsiChar = 'ACI_Delete';
+
+const
+ API_STRUCT_FILE = 'plugins\services.ini';
+ namespace = 'Structure';
+{$ENDIF}
+
+type
+ pint_ptr = ^int_ptr;
+ TWPARAM = WPARAM;
+ TLPARAM = LPARAM;
+
+const
+ col_alias=0;
+ col_type =1;
+ col_len =2;
+{$IFDEF Miranda}
+ col_flag =3;
+ col_data =4;
+{$ELSE}
+ col_data =3;
+{$ENDIF}
+var
+ OldLVProc:pointer;
+ storage:pointer;
+
+function GetTypeIndex(etype:integer):integer;
+var
+ j:integer;
+begin
+ j:=0;
+ while j<MaxStructTypes do
+ begin
+ if StructElems[j].typ=etype then break;
+ inc(j);
+ end;
+ if j<MaxStructTypes then
+ result:=j
+ else
+ result:=SST_UNKNOWN;
+end;
+
+procedure InsertString(wnd:HWND;num:dword;str:PAnsiChar);
+var
+ buf:array [0..127] of WideChar;
+begin
+ SendMessageW(wnd,CB_SETITEMDATA,
+ SendMessageW(wnd,CB_ADDSTRING,0,
+{$IFDEF Miranda}
+ lparam(TranslateW(FastAnsiToWideBuf(str,buf)))),
+{$ELSE}
+ lparam(FastAnsiToWideBuf(str,buf))),
+{$ENDIF}
+ num);
+end;
+
+{$IFDEF Miranda}
+procedure RegisterIcon(var sid:TSKINICONDESC;id,name:PAnsiChar;descr:PAnsiChar);
+var
+ buf:array [0..63] of WideChar;
+begin
+ sid.hDefaultIcon :=LoadImageA(hInstance,id,IMAGE_ICON,16,16,0);
+ sid.pszName :=name;
+ sid.szDescription.w:=FastAnsiToWideBuf(descr,buf);
+ Skin_AddIcon(@sid);
+ DestroyIcon(sid.hDefaultIcon);
+end;
+
+procedure RegisterIcons;
+var
+ sid:TSKINICONDESC;
+begin
+ if CallService(MS_SKIN2_GETICON,0,LPARAM(ACI_NEW))<>0 then
+ exit;
+
+ FillChar(sid,SizeOf(TSKINICONDESC),0);
+ sid.cbSize :=SizeOf(TSKINICONDESC);
+ sid.cx :=16;
+ sid.cy :=16;
+ sid.flags :=SIDF_UNICODE;
+ sid.szSection.w:='Actions';
+
+ RegisterIcon(sid,'IDI_NEW' ,ACI_NEW ,'New');
+ RegisterIcon(sid,'IDI_DELETE' ,ACI_DELETE ,'Delete');
+ RegisterIcon(sid,'IDI_UP' ,ACI_UP ,'Up');
+ RegisterIcon(sid,'IDI_DOWN' ,ACI_DOWN ,'Down');
+end;
+{$ENDIF}
+procedure SetDataButtonIcons(Dialog:HWND);
+var
+ ti:TTOOLINFOW;
+ hwndTooltip:HWND;
+begin
+ hwndTooltip:=CreateWindowW(TOOLTIPS_CLASS,nil,TTS_ALWAYSTIP,
+ integer(CW_USEDEFAULT),integer(CW_USEDEFAULT),
+ integer(CW_USEDEFAULT),integer(CW_USEDEFAULT),
+ Dialog,0,hInstance,nil);
+ FillChar(ti,SizeOf(ti),0);
+ ti.cbSize :=sizeof(TOOLINFO);
+ ti.uFlags :=TTF_IDISHWND or TTF_SUBCLASS;
+ ti.hwnd :=dialog;
+ ti.hinst :=hInstance;
+ ti.uId :=GetDlgItem(Dialog,IDC_DATA_NEW);
+{$IFDEF Miranda}
+ ti.lpszText:=TranslateW('New');
+ SetButtonIcon(ti.uId,ACI_NEW);
+ SendMessageW(hwndTooltip,TTM_ADDTOOLW,0,lparam(@ti));
+ ti.uId :=GetDlgItem(Dialog,IDC_DATA_UP);
+ ti.lpszText:=TranslateW('Up');
+ SetButtonIcon(ti.uId,ACI_UP);
+ SendMessageW(hwndTooltip,TTM_ADDTOOLW,0,lparam(@ti));
+ ti.uId :=GetDlgItem(Dialog,IDC_DATA_DOWN);
+ ti.lpszText:=TranslateW('Down');
+ SetButtonIcon(ti.uId,ACI_DOWN);
+ SendMessageW(hwndTooltip,TTM_ADDTOOLW,0,lparam(@ti));
+ ti.uId :=GetDlgItem(Dialog,IDC_DATA_DELETE);
+ ti.lpszText:=TranslateW('Delete');
+ SetButtonIcon(ti.uId,ACI_DELETE);
+{$ELSE}
+ ti.lpszText:='New';
+ SendMessageW(ti.uId, BM_SETIMAGE, IMAGE_ICON,
+ LoadImage(hInstance,'IDI_NEW',IMAGE_ICON,16,16,0));
+ SendMessageW(hwndTooltip,TTM_ADDTOOLW,0,lparam(@ti));
+ ti.uId :=GetDlgItem(Dialog,IDC_DATA_UP);
+ ti.lpszText:='Up';
+ SendMessageW(ti.uId, BM_SETIMAGE, IMAGE_ICON,
+ LoadImage(hInstance,'IDI_UP',IMAGE_ICON,16,16,0));
+ SendMessageW(hwndTooltip,TTM_ADDTOOLW,0,lparam(@ti));
+ ti.uId :=GetDlgItem(Dialog,IDC_DATA_DOWN);
+ ti.lpszText:='Down';
+ SendMessageW(ti.uId, BM_SETIMAGE, IMAGE_ICON,
+ LoadImage(hInstance,'IDI_DOWN',IMAGE_ICON,16,16,0));
+ SendMessageW(hwndTooltip,TTM_ADDTOOLW,0,lparam(@ti));
+ ti.uId :=GetDlgItem(Dialog,IDC_DATA_DELETE);
+ ti.lpszText:='Delete';
+ SendMessageW(ti.uId, BM_SETIMAGE, IMAGE_ICON,
+ LoadImage(hInstance,'IDI_DELETE',IMAGE_ICON,16,16,0));
+{$ENDIF}
+ SendMessageW(hwndTooltip,TTM_ADDTOOLW,0,lparam(@ti));
+end;
+
+function NewLVProc(Dialog:HWnd;hMessage:uint;wParam:WPARAM;lParam:LPARAM):lresult; stdcall;
+begin
+ result:=0;
+ case hMessage of
+ WM_KEYDOWN: begin
+ if (lParam and (1 shl 30))=0 then
+ begin
+ case wParam of
+ VK_UP: begin
+ if (GetKeyState(VK_CONTROL) and $8000)<>0 then
+ begin
+ SendMessage(GetParent(Dialog),WM_COMMAND,(BN_CLICKED shl 16)+IDC_DATA_UP,0);
+ exit;
+ end;
+ end;
+ VK_DOWN: begin
+ if (GetKeyState(VK_CONTROL) and $8000)<>0 then
+ begin
+ SendMessage(GetParent(Dialog),WM_COMMAND,(BN_CLICKED shl 16)+IDC_DATA_DOWN,0);
+ exit;
+ end;
+ end;
+ VK_INSERT: begin
+ SendMessage(GetParent(Dialog),WM_COMMAND,(BN_CLICKED shl 16)+IDC_DATA_NEW,0);
+ exit;
+ end;
+ VK_DELETE: begin
+ SendMessage(GetParent(Dialog),WM_COMMAND,(BN_CLICKED shl 16)+IDC_DATA_DELETE,0);
+ exit;
+ end;
+ end;
+ end;
+ end;
+ end;
+ result:=CallWindowProc(OldLVProc,Dialog,hMessage,wParam,lParam);
+end;
+
+function MakeLVStructList(list:HWND):HWND;
+var
+ lv:LV_COLUMNW;
+begin
+ SendMessage(list,LVM_SETUNICODEFORMAT,1,0);
+ SendMessage(list,LVM_SETEXTENDEDLISTVIEWSTYLE,
+ LVS_EX_FULLROWSELECT or LVS_EX_GRIDLINES or LVS_EX_CHECKBOXES,
+ LVS_EX_FULLROWSELECT or LVS_EX_GRIDLINES or LVS_EX_CHECKBOXES);
+
+ zeromemory(@lv,sizeof(lv));
+ lv.mask:=LVCF_TEXT or LVCF_WIDTH;
+ lv.cx :=22; lv.pszText:={$IFDEF Miranda}TranslateW{$ENDIF}('alias');
+ SendMessageW(list,LVM_INSERTCOLUMNW,col_alias,lparam(@lv)); // alias
+ lv.cx :=62; lv.pszText:={$IFDEF Miranda}TranslateW{$ENDIF}('type');
+ SendMessageW(list,LVM_INSERTCOLUMNW,col_type ,lparam(@lv)); // type
+ lv.cx :=32; lv.pszText:={$IFDEF Miranda}TranslateW{$ENDIF}('length');
+ SendMessageW(list,LVM_INSERTCOLUMNW,col_len ,lparam(@lv)); // length
+{$IFDEF Miranda}
+ lv.cx :=20; lv.pszText:={$IFDEF Miranda}TranslateW{$ENDIF}('');
+ SendMessageW(list,LVM_INSERTCOLUMNW,col_flag ,lparam(@lv)); // variables flag
+{$ENDIF}
+ lv.cx :=72; lv.pszText:={$IFDEF Miranda}TranslateW{$ENDIF}('data');
+ SendMessageW(list,LVM_INSERTCOLUMNW,col_data ,lparam(@lv)); // value
+
+ SendMessageW(list,LVM_SETCOLUMNWIDTH,col_data,LVSCW_AUTOSIZE_USEHEADER);
+
+ OldLVProc:=pointer(SetWindowLongPtrW(list,GWL_WNDPROC,long_ptr(@NewLVProc)));
+ result:=list;
+end;
+
+procedure FillDataTypeList(wnd:HWND);
+var
+ i:integer;
+begin
+ SendMessage(wnd,CB_RESETCONTENT,0,0);
+
+ for i:=0 to MaxStructTypes-1 do
+ InsertString(wnd,StructElems[i].typ,StructElems[i].full);
+
+ SendMessage(wnd,CB_SETCURSEL,0,0);
+end;
+
+procedure FillAlignTypeList(wnd:HWND);
+begin
+ SendMessage(wnd,CB_RESETCONTENT,0,0);
+
+ InsertString(wnd,0,'Native' );
+ InsertString(wnd,1,'Packed' );
+ InsertString(wnd,2,'2 bytes');
+ InsertString(wnd,4,'4 bytes');
+ InsertString(wnd,8,'8 bytes');
+
+ SendMessage(wnd,CB_SETCURSEL,0,0);
+end;
+
+//----- Data show -----
+
+function InsertLVLine(list:HWND):integer;
+var
+ li:TLVITEMW;
+begin
+ li.mask :=0;//LVIF_PARAM;
+ li.iItem :=SendMessage(list,LVM_GETNEXTITEM,-1,LVNI_FOCUSED)+1;
+ li.iSubItem:=0;
+ result:=SendMessageW(list,LVM_INSERTITEMW,0,lparam(@li));
+end;
+
+// fill table line by data from structure
+procedure FillLVLine(list:HWND;item:integer;const element:tOneElement);
+var
+ tmp1:array [0..31] of WideChar;
+ li:TLVITEMW;
+ i,llen:integer;
+ p,pc:pAnsiChar;
+ pw:pWideChar;
+begin
+ if (element.flags and EF_RETURN)<>0 then
+ ListView_SetCheckState(list,item,true);
+
+ li.iItem:=item;
+ li.mask:=LVIF_TEXT;
+
+ // type
+ p:=StructElems[GetTypeIndex(element.etype)].short;
+ llen:=0;
+ while p^<>#0 do
+ begin
+ tmp1[llen]:=WideChar(p^);
+ inc(p);
+ inc(llen);
+ end;
+ tmp1[llen]:=#0;
+ li.iSubItem:=col_type;
+ li.pszText :=@tmp1;
+ SendMessageW(list,LVM_SETITEMW,0,lparam(@li));
+
+ // flags
+{$IFDEF Miranda}
+ llen:=0;
+ if (element.flags and EF_SCRIPT)<>0 then
+ begin
+ tmp1[llen]:=char_script; inc(llen);
+ end;
+ if (element.flags and EF_MMI)<>0 then
+ begin
+ tmp1[llen]:=char_mmi; inc(llen);
+ end;
+ tmp1[llen]:=#0;
+ li.iSubItem:=col_flag;
+ li.pszText :=@tmp1;
+ SendMessageW(list,LVM_SETITEMW,0,lparam(@li));
+{$ENDIF}
+
+ // alias
+ if element.alias[0]<>#0 then
+ begin
+ pc:=@element.alias;
+ while pc^<>#0 do
+ begin
+ tmp1[llen]:=WideChar(pc^);
+ inc(llen);
+ inc(pc);
+ end;
+ tmp1[llen]:=#0;
+ li.iSubItem:=col_alias;
+ li.pszText :=@tmp1;
+ SendMessageW(list,LVM_SETITEMW,0,lparam(@li));
+ end;
+
+ case element.etype of
+ SST_LAST,SST_PARAM: begin
+ llen:=0;
+ end;
+
+ SST_BYTE,SST_WORD,SST_DWORD,
+ SST_QWORD,SST_NATIVE: begin
+{$IFDEF Miranda}
+ if (element.flags and EF_SCRIPT)<>0 then
+ begin
+ li.iSubItem:=col_data;
+ UTF8ToWide(element.text,pw);
+ llen:=StrLenW(pw);
+ li.pszText :=pw;
+ SendMessageW(list,LVM_SETITEMW,0,lparam(@li));
+ mFreeMem(pw);
+ end
+ else
+{$ENDIF}
+ begin
+ pc:=@element.svalue;
+ llen:=0;
+ while pc^<>#0 do
+ begin
+ tmp1[llen]:=WideChar(pc^);
+ inc(llen);
+ inc(pc);
+ end;
+ if llen>0 then //??
+ begin
+ tmp1[llen]:=#0;
+ li.iSubItem:=col_data;
+ li.pszText :=@tmp1;
+ SendMessageW(list,LVM_SETITEMW,0,lparam(@li));
+ end;
+ end;
+ end;
+
+ SST_BARR,SST_WARR,SST_BPTR,SST_WPTR: begin
+ // like for numbers, array length
+ if element.len>0 then //??
+ begin
+ IntToStr(tmp1,element.len);
+ li.iSubItem:=col_len;
+ li.pszText :=@tmp1;
+ SendMessageW(list,LVM_SETITEMW,0,lparam(@li));
+ end;
+
+ if element.text<>nil then
+ begin
+ li.iSubItem:=col_data;
+ if (element.etype in [SST_WARR,SST_WPTR])
+{$IFDEF Miranda}
+ or ((element.flags and EF_SCRIPT)<>0)
+{$ENDIF}
+ then
+ begin
+ UTF8ToWide(element.text,pw);
+ end
+ else
+ begin
+ AnsiToWide(element.text,pw);
+ end;
+ li.pszText :=pw;
+ llen:=StrLenW(pw);
+ SendMessageW(list,LVM_SETITEMW,0,lparam(@li));
+ mFreeMem(pw);
+ end;
+ end;
+ end;
+
+ i:=element.etype+(llen shl 16);
+ LV_SetLParam(list,i,item);
+
+ ListView_SetItemState(list,item,LVIS_FOCUSED or LVIS_SELECTED,
+ LVIS_FOCUSED or LVIS_SELECTED);
+end;
+
+// Fill table by structure
+procedure FillLVStruct(list:HWND;txt:PAnsiChar);
+var
+ p:pansiChar;
+ element:tOneElement;
+begin
+ SendMessage(list,LVM_DELETEALLITEMS,0,0);
+ if txt^ in sNum then
+ txt:=StrScan(txt,char_separator)+1;
+ while txt^<>#0 do
+ begin
+ p:=StrScan(txt,char_separator);
+ GetOneElement(txt,element,false);
+ FillLVLine(list,InsertLVLine(list),element);
+ FreeElement(element);
+
+ if p=nil then break;
+ txt:=p+1;
+ end;
+ ListView_SetItemState(list,0,LVIS_FOCUSED or LVIS_SELECTED,
+ LVIS_FOCUSED or LVIS_SELECTED);
+end;
+
+//----- Data save -----
+
+function GetLVRow(var dst:pAnsiChar;list:HWND;item:integer):integer;
+var
+ li:TLVITEMW;
+ buf:array [0..63] of WideChar;
+ pc:pWideChar;
+ pc1:pAnsiChar;
+ len:integer;
+ {$IFDEF Miranda}isScript:boolean;{$ENDIF}
+begin
+ li.iItem:=item;
+
+ // result value check and element type
+ li.mask :=LVIF_PARAM or LVIF_STATE;
+ li.iSubItem :=0;
+ li.stateMask :=LVIS_STATEIMAGEMASK;
+ SendMessageW(list,LVM_GETITEMW,item,lparam(@li));
+ result:=loword(li.lParam); // element type
+ len :=hiword(li.lParam); // text length
+
+ if (li.state shr 12)>1 then // "return" value
+ begin
+ dst^:=char_return;
+ inc(dst);
+ end;
+
+{$IFDEF Miranda}
+ li.mask :=LVIF_TEXT;
+ li.iSubItem :=col_flag;
+ li.cchTextMax:=32;
+ li.pszText :=@buf;
+ isScript:=false;
+ if SendMessage(list,LVM_GETITEMTEXTW,item,lparam(@li))>0 then
+ begin
+ if StrScanW(buf,char_script)<>nil then
+ begin
+ dst^:=char_script;
+ inc(dst);
+ isScript:=true;
+ end;
+
+ if StrScanW(buf,char_mmi)<>nil then
+ begin
+ dst^:=char_mmi;
+ inc(dst);
+ end;
+ end;
+{$ENDIF}
+{
+ // type text (can skip and use type code)
+ li.mask :=LVIF_TEXT;
+ li.cchTextMax:=HIGH(buf);
+ li.pszText :=@buf;
+ li.iSubItem :=col_type;
+ SendMessageW(list,LVM_GETITEMTEXTW,item,lparam(@li));
+ dst:=StrEnd(FastWideToAnsiBuf(@buf,dst));
+}
+ dst:=StrCopyE(dst,StructElems[GetTypeIndex(result)].short);
+ // alias
+ li.mask :=LVIF_TEXT;
+ li.cchTextMax:=HIGH(buf);
+ li.pszText :=@buf;
+
+ li.iSubItem :=col_alias;
+ if SendMessageW(list,LVM_GETITEMTEXTW,item,lparam(@li))>0 then
+ begin
+ dst^:=' '; inc(dst);
+ pc:=@buf;
+ while pc^<>#0 do
+ begin
+ dst^:=AnsiChar(pc^); inc(dst); inc(pc);
+ end;
+ end;
+
+ case result of
+ SST_LAST,SST_PARAM: exit;
+
+ SST_BYTE,SST_WORD,SST_DWORD,
+ SST_QWORD,SST_NATIVE: begin
+ li.iSubItem :=col_data;
+ li.cchTextMax:=32;
+{$IFDEF Miranda}
+ if isScript then
+ begin
+ mGetMem(pc,(len+1)*SizeOf(WideChar));
+ li.pszText:=pc;
+ end
+ else
+{$ENDIF}
+ li.pszText :=@buf;
+ if SendMessage(list,LVM_GETITEMTEXTW,item,lparam(@li))>0 then
+ begin
+ dst^:=' '; inc(dst);
+{$IFDEF Miranda}
+ if isScript then
+ begin
+ WideToUTF8(pc,pc1);
+ dst:=StrCopyE(dst,pc1);
+ mFreeMem(pc1);
+ mFreeMem(pc);
+ end
+ else
+{$ENDIF}
+ begin
+ pc:=@buf;
+ while pc^<>#0 do
+ begin
+ dst^:=AnsiChar(pc^); inc(dst); inc(pc);
+ end;
+// StrCopyW(dst,buf);
+ end;
+ end;
+ end;
+
+ SST_BARR,SST_WARR,SST_BPTR,SST_WPTR: begin
+ // length
+ li.iSubItem :=col_len;
+ li.cchTextMax:=32;
+ li.pszText :=@buf;
+ if SendMessage(list,LVM_GETITEMTEXTW,item,lparam(@li))>0 then
+ begin
+ dst^:=' '; inc(dst);
+ pc:=@buf;
+ while pc^<>#0 do
+ begin
+ dst^:=AnsiChar(pc^); inc(dst); inc(pc);
+ end;
+ end
+ else
+ dst:=StrEnd(IntToStr(dst,len));
+
+ if len>0 then
+ begin
+// dst:=StrEnd(dst);
+ li.iSubItem :=col_data;
+ li.cchTextMax:=len+1;
+ mGetMem(pc,(len+1)*SizeOf(WideChar));
+ li.pszText :=pc;
+ SendMessage(list,LVM_GETITEMTEXTW,item,lparam(@li));
+ if pc^<>#0 then
+ begin
+ dst^:=' '; inc(dst);
+ if (result in [SST_WARR,SST_WPTR])
+{$IFDEF Miranda}
+ or isScript
+{$ENDIF}
+ then
+ WideToUTF8(pc,pc1)
+ else
+ WideToAnsi(pc,pc1);
+
+ dst:=StrCopyE(dst,pc1);
+ mFreeMem(pc1);
+ end;
+ mFreeMem(pc);
+ end;
+ end;
+ end;
+// dst:=StrEnd(dst);
+end;
+
+function SaveStructure(list:HWND;align:integer):pAnsiChar;
+var
+ p:PAnsiChar;
+ i:integer;
+begin
+ mGetMem(p,32768);
+ result:=p;
+ FillChar(p^,32768,0);
+ IntToStr(result,align);
+ inc(result);
+ result^:=char_separator;
+ inc(result);
+
+ for i:=0 to SendMessage(list,LVM_GETITEMCOUNT,0,0)-1 do
+ begin
+ GetLVRow(result,list,i);
+ result^:=char_separator; inc(result);
+ end;
+ dec(result); result^:=#0;
+ i:=(result+2-p);
+ mGetMem(result,i);
+ move(p^,result^,i);
+ mFreeMem(p);
+end;
+{$IFDEF Miranda}
+function StructEditDlgResizer(Dialog:HWND;lParam:LPARAM;urc:PUTILRESIZECONTROL):int; cdecl;
+begin
+ case urc^.wId of
+ IDC_DATA_FULL: result:=RD_ANCHORX_WIDTH or RD_ANCHORY_HEIGHT;
+ IDC_DATA_TMPL: result:=RD_ANCHORX_WIDTH or RD_ANCHORY_BOTTOM;
+ IDC_DATA_EDIT: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_HEIGHT;
+ IDC_DATA_EDTN: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_TOP;
+ IDC_DATA_TYPE: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_TOP;
+ IDC_DATA_LEN: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_TOP;
+ IDC_DATA_SLEN: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_TOP;
+
+ IDC_DATA_VARS: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_BOTTOM;
+ IDC_DATA_MMI: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_BOTTOM;
+
+ IDC_DATA_NEW: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_TOP;
+ IDC_DATA_UP: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_TOP;
+ IDC_DATA_DOWN: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_TOP;
+ IDC_DATA_DELETE: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_TOP;
+ IDC_DATA_INFO: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_BOTTOM;
+ IDC_DATA_PASTE: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_BOTTOM;
+
+ IDC_DATA_ALIGN : result:=RD_ANCHORX_RIGHT or RD_ANCHORY_TOP;
+ IDC_DATA_SALGN : result:=RD_ANCHORX_RIGHT or RD_ANCHORY_TOP;
+ IDC_DATA_SEP : result:=RD_ANCHORX_RIGHT or RD_ANCHORY_TOP;
+
+ IDC_DATA_CHANGE: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_BOTTOM;
+ IDOK: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_BOTTOM;
+ IDCANCEL: result:=RD_ANCHORX_RIGHT or RD_ANCHORY_BOTTOM;
+ else
+ result:=0;
+ end;
+end;
+{$ENDIF}
+procedure CheckReturns(wnd:HWND;item:integer);
+var
+ li:TLVITEMW;
+ i:integer;
+begin
+ li.mask :=LVIF_STATE;
+ li.iSubItem :=0;
+ li.stateMask:=LVIS_STATEIMAGEMASK;
+ li.state :=1 shl 12;
+ for i:=0 to SendMessageW(wnd,LVM_GETITEMCOUNT,0,0)-1 do
+ begin
+ if i<>item then
+ begin
+ SendMessageW(wnd,LVM_SETITEMSTATE,i,lparam(@li));
+{
+ li.iItem:=i;
+ SendMessageW(list,LVM_GETITEMSTATE,i,dword(@li));
+ if (li.state shr 12)>1 then
+ begin
+ li.state:=1 shl 12;
+ SendMessageW(wnd,LVM_SETITEMSTATE,i,dword(@li));
+ end;
+}
+ end;
+ end;
+end;
+
+// enable/disable navigation chain buttons
+procedure CheckList(Dialog:HWND; num:integer=-1);
+begin
+ if num<0 then
+ num:=SendDlgItemMessage(Dialog,IDC_DATA_FULL,LVM_GETNEXTITEM,WPARAM(-1),LVNI_FOCUSED);
+ EnableWindow(GetDlgItem(Dialog,IDC_DATA_UP),num>0);
+ EnableWindow(GetDlgItem(Dialog,IDC_DATA_DOWN),
+ (num+1)<SendDlgItemMessage(Dialog,IDC_DATA_FULL,LVM_GETITEMCOUNT,0,0));
+end;
+
+procedure FillLVData(Dialog:HWND;list:HWND;item:integer);
+var
+ buf:array [0..15] of WideChar;
+ i:integer;
+ p:pWideChar;
+ b,b1:boolean;
+ idcshow,idchide:integer;
+ li:TLVITEMW;
+ {$IFDEF Miranda}vflag,mflag,{$ENDIF}
+ len:integer;
+ wnd:HWND;
+begin
+ len:=LV_GetLParam(list,item);
+ i :=loword(len);
+ len:=hiword(len);
+ idcshow:=IDC_DATA_EDIT;
+ idchide:=IDC_DATA_EDTN;
+
+ buf[0]:=#0;
+ case i of
+ SST_BYTE,SST_WORD,SST_DWORD,
+ SST_QWORD,SST_NATIVE: begin
+ idchide:=IDC_DATA_EDIT;
+ idcshow:=IDC_DATA_EDTN;
+ b :=true;
+ b1:=false;
+ end;
+
+ SST_BARR,SST_WARR,SST_BPTR,SST_WPTR: begin
+ b :=true;
+ b1:=true;
+
+ li.iSubItem :=col_len;
+ li.cchTextMax:=15;
+ li.pszText :=@buf;
+ SendMessage(list,LVM_GETITEMTEXTW,item,lparam(@li));
+ end;
+ else
+ b :=false;
+ b1:=false;
+ end;
+ SetDlgItemTextW(Dialog,IDC_DATA_LEN,@buf);
+
+ p:=@buf;
+ li.cchTextMax:=15;
+ li.pszText :=@buf;
+ if b then
+ begin
+{$IFDEF Miranda}
+ li.iSubItem:=col_flag;
+ vflag:=BST_UNCHECKED;
+ i:=SW_HIDE;
+ mflag:=BST_UNCHECKED;
+ if SendMessage(list,LVM_GETITEMTEXTW,item,lparam(@li))>0 then
+ begin
+ if StrScanW(p,char_script)<>nil then
+ begin
+ b1:=true;
+ vflag:=BST_CHECKED;
+ i:=SW_SHOW;
+
+ idchide:=IDC_DATA_EDTN;
+ idcshow:=IDC_DATA_EDIT;
+ end;
+
+ if StrScanW(p,char_mmi)<>nil then
+ mflag:=BST_CHECKED;
+ end;
+ ShowWindow(GetDlgItem(Dialog,IDC_VAR_HELP),i);
+ CheckDlgButton(Dialog,IDC_DATA_VARS,vflag);
+ CheckDlgButton(Dialog,IDC_DATA_MMI ,mflag);
+{$ENDIF}
+ if b1 then
+ begin
+ mGetMem(p,(len+1)*SizeOf(WideChar));
+ li.cchTextMax:=len+1;
+ li.pszText :=p;
+ end;
+ li.iSubItem:=col_data;
+ SendMessage(list,LVM_GETITEMTEXTW,item,lparam(@li));
+ end;
+ SetDlgItemTextW(Dialog,idchide,'');
+ SetDlgItemTextW(Dialog,idcshow,p);
+
+ if b1 then
+ mFreeMem(p);
+
+ wnd:=GetDlgItem(Dialog,IDC_DATA_TYPE);
+ CB_SelectData(wnd,i);
+ SendMessage(Dialog,WM_COMMAND,(CBN_SELENDOK shl 16)+IDC_DATA_TYPE,wnd);
+end;
+
+// Fill table row by data from edit fields
+procedure FillLVRow(Dialog:hwnd;list:HWND;item:integer);
+var
+ ltype,j,idc:integer;
+{$IFDEF Miranda}
+ idx:integer;
+{$ENDIF}
+ wnd:HWND;
+ buf:array [0..63] of WideChar;
+ tmp:pWideChar;
+begin
+ // type
+ wnd:=GetDlgItem(Dialog,IDC_DATA_TYPE);
+ ltype:=SendMessage(wnd,CB_GETITEMDATA,SendMessage(wnd,CB_GETCURSEL,0,0),0);
+ j:=GetTypeIndex(ltype);
+
+ LV_SetItemW(list,FastAnsiToWideBuf(StructElems[j].short,buf),item,col_type);
+
+ // flags
+{$IFDEF Miranda}
+ idx:=0;
+ if IsDlgButtonChecked(Dialog,IDC_DATA_VARS)<>BST_UNCHECKED then
+ begin
+ buf[idx]:=char_script; inc(idx);
+ end;
+
+ if IsDlgButtonChecked(Dialog,IDC_DATA_MMI)<>BST_UNCHECKED then
+ begin
+ buf[idx]:=char_mmi; inc(idx);
+ end;
+ buf[idx]:=#0;
+ LV_SetItemW(list,@buf,item,col_flag);
+{$ENDIF}
+
+ // values
+ tmp:=nil;
+ case ltype of
+ SST_LAST,SST_PARAM: begin
+ j:=0;
+ end;
+
+ SST_BYTE,SST_WORD,SST_DWORD,
+ SST_QWORD,SST_NATIVE: begin
+{$IFDEF Miranda}
+ if IsDlgButtonChecked(Dialog,IDC_DATA_VARS)<>BST_UNCHECKED then
+ idc:=IDC_DATA_EDIT
+ else
+{$ENDIF}
+ idc:=IDC_DATA_EDTN;
+
+ tmp:=GetDlgText(Dialog,idc);
+ j:=StrLenW(tmp);
+ LV_SetItemW(list,tmp,item,col_data);
+ end;
+
+ SST_BARR,SST_WARR,SST_BPTR,SST_WPTR: begin
+
+ SendDlgItemMessageW(Dialog,IDC_DATA_LEN,WM_GETTEXT,15,lparam(@buf));
+ LV_SetItemW(list,buf,item,col_len);
+
+ tmp:=GetDlgText(Dialog,IDC_DATA_EDIT);
+ j:=StrLenW(tmp);
+ LV_SetItemW(list,tmp,item,col_data);
+ end;
+ end;
+ ltype:=ltype or (j shl 16);
+ mFreeMem(tmp);
+ LV_SetLParam(list,ltype,item);
+end;
+
+{$IFDEF Miranda}
+procedure FillTemplates(wnd:HWND;lstorage:pointer);
+var
+ p,pp:pAnsiChar;
+ i:integer;
+begin
+ SendMessage(wnd,CB_RESETCONTENT,0,0);
+
+ p:=GetSectionList(lstorage,namespace);
+ pp:=p;
+ i:=0;
+ while p^<>#0 do
+ begin
+ CB_AddStrData(wnd,p,int_ptr(SearchSection(lstorage,p,namespace)), i);
+
+ while p^<>#0 do inc(p); inc(p);
+ inc(i);
+ end;
+ FreeSectionList(pp);
+ if i>0 then
+ SendMessage(wnd,CB_SETCURSEL,0,0);
+end;
+{$ENDIF}
+
+procedure ReadableForm(wnd:HWND; struct:pAnsiChar);
+var
+ p,pc,buf:pAnsiChar;
+ element:tOneElement;
+begin
+ GetMem(buf,StrLen(struct)*2);
+ pc:=buf;
+
+ struct:=StrScan(struct,char_separator)+1;
+ while struct^<>#0 do
+ begin
+ p:=StrScan(struct,char_separator);
+ GetOneElement(struct,element,false);
+
+ pc:=StrCopyE(pc,element.talias);
+ if element.etype in [SST_BARR,SST_WARR] then
+ begin
+ pc^:=' '; inc(pc);
+ pc^:='['; inc(pc);
+ pc:=StrEnd(IntToStr(pc,element.len));
+ pc^:=']'; inc(pc);
+ end;
+ pc^:=' '; inc(pc);
+ pc:=StrCopyE(pc,element.alias);
+{
+// if (element.typ IN [SST_BYTE,SST_WORD,SST_DWORD, SST_QWORD, SST_NATIVE]) then
+ pc^:=' '; inc(pc);
+ pc^:='='; inc(pc);
+ pc^:=' '; inc(pc);
+ pc:=StrCopyE(pc,element.sValue);
+}
+ pc^:=#13; inc(pc);
+ pc^:=#10; inc(pc);
+
+ FreeElement(element);
+
+ if p=nil then break;
+ struct:=p+1;
+ end;
+ pc^:=#0;
+
+ SendMessageA(wnd,WM_SETTEXT,0,LPARAM(buf));
+ FreeMem(buf);
+end;
+
+function StructHelp(Dialog:HWnd;hMessage:uint;wParam:WPARAM;lParam:LPARAM):lresult; stdcall;
+var
+ tmp:pWideChar;
+ pc:pAnsiChar;
+begin
+ result:=0;
+ case hMessage of
+ WM_CLOSE: begin
+ DestroyWindow(Dialog); //??
+ end;
+
+ WM_INITDIALOG: begin
+{$IFDEF Miranda}
+ TranslateDialogDefault(Dialog);
+{$ENDIF}
+ result:=1;
+
+ if lParam<>0 then
+ begin
+ SetDlgItemTextA(Dialog,IDC_HLP_NAME,GetSectionName(pointer(lParam)));
+
+ SetDlgItemTextA(Dialog,IDC_HLP_PLUGIN,GetParamSectionStr(pointer(lParam),'plugin'));
+
+ FastAnsiToWide(GetParamSectionStr(pointer(lParam),'descr','Undefined'),tmp);
+ SetDlgItemTextW(Dialog,IDC_HLP_DESCR,{$IFDEF Miranda}TranslateW{$ENDIF}(tmp));
+ mFreeMem(tmp);
+
+ pc:=GetParamSectionStr(pointer(lParam),'full',nil);
+ if pc=nil then
+ pc:=GetParamSectionStr(pointer(lParam),'short',nil);
+ if pc<>nil then
+ ReadableForm(GetDlgItem(Dialog,IDC_HLP_STRUCT),pc);
+ end;
+ end;
+
+ WM_COMMAND: begin
+ if (wParam shr 16)=BN_CLICKED then
+ begin
+ case loword(wParam) of
+ IDOK,IDCANCEL: begin
+ DestroyWindow(Dialog);
+ end;
+ end;
+ end;
+ end;
+ else
+//!! result:=DefWindowProc(Dialog,hMessage,wParam,lParam);
+ end;
+end;
+
+function StructEdit(Dialog:HWnd;hMessage:uint;wParam:WPARAM;lParam:LPARAM):lresult; stdcall;
+var
+ wnd:HWND;
+ i:integer;
+ li:TLVITEMW;
+ b,b1:boolean;
+ idchide,idcshow:integer;
+{$IFDEF Miranda}
+ pc:pAnsiChar;
+ urd:TUTILRESIZEDIALOG;
+{$ELSE}
+ rc,rc1:TRECT;
+{$ENDIF}
+begin
+ result:=0;
+ case hMessage of
+
+ WM_DESTROY: begin
+{$IFDEF Miranda}
+ CloseStorage(storage);
+{$ENDIF}
+ end;
+
+ WM_INITDIALOG: begin
+ result:=1;
+{$IFDEF Miranda}
+ TranslateDialogDefault(Dialog);
+ RegisterIcons;
+ storage:=OpenStorage(API_STRUCT_FILE);
+ if storage<>nil then
+ FillTemplates(GetDlgItem(Dialog,IDC_DATA_TMPL),storage);
+ if isVarsInstalled then
+ SendDlgItemMessage(Dialog,IDC_VAR_HELP,BM_SETIMAGE,IMAGE_ICON,
+ CallService(MS_VARS_GETSKINITEM,0,VSI_HELPICON));
+{$ENDIF}
+ wnd:=GetDlgItem(Dialog,IDC_DATA_FULL);
+ MakeLVStructList(wnd);
+ SetDataButtonIcons(Dialog);
+ FillDataTypeList (GetDlgItem(Dialog,IDC_DATA_TYPE));
+ FillAlignTypeList(GetDlgItem(Dialog,IDC_DATA_ALIGN));
+ if lParam<>0 then
+ begin
+ FillLVStruct(wnd,pAnsiChar(lParam)) // fill lv with current structure
+ end
+ else
+ SendMessage(Dialog,WM_COMMAND,(CBN_SELCHANGE shl 16)+IDC_DATA_TYPE,
+ GetDlgItem(Dialog,IDC_DATA_TYPE));
+ CheckList(Dialog,-1);
+ SendMessage(Dialog,WM_COMMAND,(CBN_SELENDOK shl 16)+IDC_DATA_TYPE,
+ GetDlgItem(Dialog,IDC_DATA_TYPE));
+ end;
+
+ WM_GETMINMAXINFO: begin
+ with PMINMAXINFO(lParam)^ do
+ begin
+ ptMinTrackSize.x:=500;
+ ptMinTrackSize.y:=300;
+ end;
+ end;
+
+ WM_SIZE: begin
+{$IFDEF Miranda}
+ FillChar(urd,SizeOf(TUTILRESIZEDIALOG),0);
+ urd.cbSize :=SizeOf(urd);
+ urd.hwndDlg :=Dialog;
+ urd.hInstance :=hInstance;
+ urd.lpTemplate:='IDD_STRUCTURE';//MAKEINTRESOURCEA(IDD_STRUCTURE);
+ urd.lParam :=0;
+ urd.pfnResizer:=@StructEditDlgResizer;
+ CallService(MS_UTILS_RESIZEDIALOG,0,tlparam(@urd));
+{$ELSE}
+ GetWindowRect(Dialog,rc);
+
+ wnd:=GetDlgItem(Dialog,IDC_DATA_EDIT);
+ GetWindowRect(wnd,rc1);
+ SetWindowPos(wnd,0,0,0,rc.right-rc1.left-8,rc1.bottom-rc1.top,
+ SWP_NOMOVE or SWP_NOZORDER or SWP_SHOWWINDOW);
+
+ wnd:=GetDlgItem(Dialog,IDC_DATA_FULL);
+ GetWindowRect(wnd,rc1);
+ SetWindowPos(wnd,0,0,0,rc1.right-rc1.left, rc.bottom-rc1.top-8,
+ SWP_NOMOVE or SWP_NOZORDER or SWP_SHOWWINDOW);
+{$ENDIF}
+ end;
+
+ WM_COMMAND: begin
+ case wParam shr 16 of
+
+ CBN_SELENDOK{CBN_SELCHANGE}: begin
+ case loword(wParam) of
+{$IFDEF Miranda}
+ IDC_DATA_TMPL: begin
+ end;
+{$ENDIF}
+ IDC_DATA_TYPE: begin
+ i:=CB_GetData(lParam);
+ case i of
+ SST_LAST,SST_PARAM: begin
+ b :=false;
+ b1:=false;
+ end;
+
+ SST_BYTE,SST_WORD,SST_DWORD,
+ SST_QWORD,SST_NATIVE: begin
+ b :=true;
+ b1:=false;
+ end;
+
+ SST_BARR,SST_WARR,SST_BPTR,SST_WPTR: begin
+ b :=true;
+ b1:=true;
+ end;
+ else
+ b :=false;
+ b1:=false;
+ end;
+ EnableWindow(GetDlgItem(Dialog,IDC_DATA_EDIT),b);
+ EnableWindow(GetDlgItem(Dialog,IDC_DATA_EDTN),b);
+ EnableWindow(GetDlgItem(Dialog,IDC_DATA_LEN ),b1);
+
+ if b then
+ begin
+ if i IN [SST_BYTE,SST_WORD,SST_DWORD,SST_QWORD,SST_NATIVE] then
+ begin
+{$IFDEF Miranda}
+ if IsDlgButtonChecked(Dialog,IDC_DATA_VARS)<>BST_UNCHECKED then
+ begin
+ idchide:=IDC_DATA_EDTN;
+ idcshow:=IDC_DATA_EDIT;
+ end
+ else
+{$ENDIF}
+ begin
+ idchide:=IDC_DATA_EDIT;
+ idcshow:=IDC_DATA_EDTN;
+ end;
+ end
+ else
+ begin
+ idchide:=IDC_DATA_EDTN;
+ idcshow:=IDC_DATA_EDIT;
+ end;
+ ShowWindow(GetDlgItem(Dialog,idcshow),SW_SHOW);
+ ShowWindow(GetDlgItem(Dialog,idchide),SW_HIDE);
+ end;
+
+{$IFDEF Miranda}
+ if i IN [SST_PARAM,SST_LAST] then
+ ShowWindow(GetDlgItem(Dialog,IDC_DATA_VARS),SW_HIDE)
+ else
+ ShowWindow(GetDlgItem(Dialog,IDC_DATA_VARS),SW_SHOW);
+
+ if i IN [SST_BPTR,SST_WPTR] then
+ ShowWindow(GetDlgItem(Dialog,IDC_DATA_MMI),SW_SHOW)
+ else
+ ShowWindow(GetDlgItem(Dialog,IDC_DATA_MMI),SW_HIDE);
+{$ENDIF}
+ end;
+ end;
+ end;
+
+ BN_CLICKED: begin
+ case loword(wParam) of
+{$IFDEF Miranda}
+ IDC_DATA_INFO: begin
+ CreateDialogParamW(hInstance,'IDD_STRUCTHELP',//MAKEINTRESOURCEW(IDD_HELP),
+ 0{Dialog},@StructHelp,CB_GetData(GetDlgItem(Dialog,IDC_DATA_TMPL)));
+ end;
+
+ IDC_DATA_PASTE: begin
+ wnd:=GetDlgItem(Dialog,IDC_DATA_TMPL);
+ pc:=GetParamSectionStr(pointer(CB_GetData(wnd)),'full',nil);
+ if pc=nil then
+ pc:=GetParamSectionStr(pointer(CB_GetData(wnd)),'short',nil);
+ if pc<>nil then
+ begin
+ FillLVStruct(GetDlgItem(Dialog,IDC_DATA_FULL),pc); // fill lv with current structure
+ end;
+ end;
+
+ IDC_VAR_HELP: begin
+ ShowVarHelp(Dialog,IDC_DATA_EDIT);
+ end;
+ IDC_DATA_VARS: begin
+ if (not isVarsInstalled) or
+ (IsDlgbuttonChecked(Dialog,IDC_DATA_VARS)=BST_UNCHECKED) then
+ idcshow:=SW_HIDE
+ else
+ idcshow:=SW_SHOW;
+ ShowWindow(GetDlgItem(Dialog,IDC_VAR_HELP),idcshow);
+
+
+ i:=CB_GetData(GetDlgItem(Dialog,IDC_DATA_TYPE));
+ if i IN [SST_BYTE,SST_WORD,SST_DWORD,SST_QWORD,SST_NATIVE] then
+ begin
+ if IsDlgButtonChecked(Dialog,IDC_DATA_VARS)<>BST_UNCHECKED then
+ begin
+ idchide:=IDC_DATA_EDTN;
+ idcshow:=IDC_DATA_EDIT;
+ end
+ else
+ begin
+ idchide:=IDC_DATA_EDIT;
+ idcshow:=IDC_DATA_EDTN;
+ end;
+ ShowWindow(GetDlgItem(Dialog,idcshow),SW_SHOW);
+ ShowWindow(GetDlgItem(Dialog,idchide),SW_HIDE);
+ end;
+ end;
+{$ENDIF}
+ IDC_DATA_NEW: begin
+ wnd:=GetDlgItem(Dialog,IDC_DATA_FULL);
+ i:=InsertLVLine(wnd);
+ FillLVRow(Dialog,wnd,i);
+ EnableWindow(GetDlgItem(Dialog,IDC_DATA_DELETE),true);
+// CheckList(Dialog,i);
+// if SendMessage(wnd,LVM_GETITEMCOUNT,0,0)=1 then
+ begin
+ li.mask :=LVIF_STATE;
+ li.iItem :=i;
+ li.iSubItem :=0;
+ li.StateMask:=LVIS_FOCUSED+LVIS_SELECTED;
+ li.State :=LVIS_FOCUSED+LVIS_SELECTED;
+ SendMessageW(wnd,LVM_SETITEMW,0,tlparam(@li));
+ end;
+ CheckList(Dialog);
+ end;
+
+ IDC_DATA_DELETE: begin
+ wnd:=GetDlgItem(Dialog,IDC_DATA_FULL);
+ i:=SendMessage(wnd,LVM_GETNEXTITEM,-1,LVNI_FOCUSED); //??
+ if i<>-1 then
+ begin
+ SendMessage(wnd,LVM_DELETEITEM,i,0);
+ CheckList(Dialog,-1);
+ end;
+
+// SendMessageW(Dialog,LVM_DELETEITEM,ListView_GetNextItem(Dialog,-1,LVNI_FOCUSED),0);
+//select next and set field (auto?)
+{
+ i:=SendMessage(wnd,LVM_GETITEMCOUNT,0,0);
+ if i>0 then
+ begin
+ if next=i then
+ dec(next);
+ ListView_SetItemState(wnd,next,LVIS_FOCUSED or LVIS_SELECTED,
+ LVIS_FOCUSED or LVIS_SELECTED);
+}
+ end;
+
+ IDC_DATA_UP: begin
+ wnd:=GetDlgItem(Dialog,IDC_DATA_FULL);
+ li.iItem:=SendMessage(wnd,LVM_GETNEXTITEM,-1,LVNI_FOCUSED);
+// if li.iItem>0 then
+ LV_MoveItem(wnd,-1,li.iItem);
+ CheckList(Dialog);
+ end;
+
+ IDC_DATA_DOWN: begin
+ wnd:=GetDlgItem(Dialog,IDC_DATA_FULL);
+ li.iItem:=SendMessage(wnd,LVM_GETNEXTITEM,-1,LVNI_FOCUSED);
+// if li.iItem<(SendMessage(wnd,LVM_GETITEMCOUNT,0,0)-1) then
+ LV_MoveItem(wnd,1,li.iItem);
+ CheckList(Dialog);
+ end;
+
+ IDOK: begin // save result
+ EndDialog(Dialog,int_ptr(
+ SaveStructure(GetDlgItem(Dialog,IDC_DATA_FULL),
+ CB_GetData(GetDlgItem(Dialog,IDC_DATA_ALIGN))
+ )));
+ end;
+
+ IDCANCEL: begin // clear result / restore old value
+ EndDialog(Dialog,0);
+ end;
+
+ IDC_DATA_CHANGE: begin
+ wnd:=GetDlgItem(Dialog,IDC_DATA_FULL);
+ if SendMessage(wnd,LVM_GETITEMCOUNT,0,0)=0 then
+ begin
+ PostMessage(Dialog,hMessage,IDC_DATA_NEW,lParam);
+ exit;
+ end;
+ i:=SendMessage(wnd,LVM_GETNEXTITEM,-1,LVNI_FOCUSED); //??
+ if i<>-1 then
+ FillLVRow(Dialog,wnd,i);
+ end;
+
+ end;
+ end;
+ end;
+ end;
+
+ WM_NOTIFY: begin
+ if integer(PNMHdr(lParam)^.code)=PSN_APPLY then
+ begin
+ end
+ else if wParam=IDC_DATA_FULL then
+ begin
+ case integer(PNMHdr(lParam)^.code) of
+ LVN_ITEMCHANGED: begin
+ i:=(PNMLISTVIEW(lParam)^.uOldState and LVNI_FOCUSED)-
+ (PNMLISTVIEW(lParam)^.uNewState and LVNI_FOCUSED);
+ if i>0 then // old focus - do nothing
+ else if i<0 then // new focus - fill fields
+ begin
+ //save
+ FillLVData(Dialog,PNMHdr(lParam)^.hwndFrom,PNMLISTVIEW(lParam)^.iItem);
+ CheckList(Dialog,PNMLISTVIEW(lParam)^.iItem);
+ end
+ else
+ begin
+ if (PNMLISTVIEW(lParam)^.uOldState or PNMLISTVIEW(lParam)^.uNewState)=$3000 then
+ begin
+ if PNMLISTVIEW(lParam)^.uOldState=$1000 then // check
+ CheckReturns(GetDlgItem(Dialog,IDC_DATA_FULL),PNMLISTVIEW(lParam)^.iItem);
+ end;
+ end;
+ end;
+
+ LVN_ENDLABELEDITW: begin
+ with PLVDISPINFO(lParam)^ do
+ begin
+ if item.pszText<>nil then
+ begin
+ item.mask:=LVIF_TEXT;
+ SendMessageW(hdr.hWndFrom,LVM_SETITEMW,0,tlparam(@item));
+ result:=1;
+ end;
+ end;
+ end;
+
+ NM_DBLCLK: begin
+ if PNMListView(lParam)^.iItem>=0 then
+ begin
+ SendMessage(PNMHdr(lParam)^.hWndFrom,LVM_EDITLABEL,
+ PNMListView(lParam)^.iItem,0);
+ end;
+ end;
+
+ end;
+ end;
+ end;
+ else
+//!! result:=DefWindowProc(Dialog,hMessage,wParam,lParam);
+ end;
+end;
+
+function EditStructure(struct:pAnsiChar;parent:HWND=0):pAnsiChar;
+begin
+ InitCommonControls;
+
+ result:=pAnsiChar(uint_ptr(DialogBoxParamW(hInstance,'IDD_STRUCTURE',
+ parent,@StructEdit,LPARAM(struct))));
+
+ if uint_ptr(result)=uint_ptr(-1) then
+ result:=nil;
+end;
+
+end.
diff --git a/plugins/Utils.pas/strans.pas b/plugins/Utils.pas/strans.pas new file mode 100644 index 0000000000..b70057c33c --- /dev/null +++ b/plugins/Utils.pas/strans.pas @@ -0,0 +1,828 @@ +{}
+unit strans;
+
+interface
+
+uses windows{$IFDEF Miranda}, m_api{$ENDIF};
+// <align>|[<key>]<type> [(<type alias>)] [<alias>] [arr.len] [value]|
+const
+ char_separator = '|';
+ char_hex = '$';
+ char_return = '*';
+ char_script = '%';
+{$IFDEF Miranda}
+ char_mmi = '&';
+{$ENDIF}
+const
+ SST_BYTE = 0;
+ SST_WORD = 1;
+ SST_DWORD = 2;
+ SST_QWORD = 3;
+ SST_NATIVE = 4;
+ SST_BARR = 5;
+ SST_WARR = 6;
+ SST_BPTR = 7;
+ SST_WPTR = 8;
+ SST_LAST = 9;
+ SST_PARAM = 10;
+ SST_UNKNOWN = -1;
+const
+ EF_RETURN = $00000001;
+ EF_SCRIPT = $00000002;
+ EF_MMI = $00000004;
+ EF_LAST = $00000080;
+type
+ // int_ptr = to use aligned structure data at start
+ PStructResult = ^TStructResult;
+ TStructResult = record
+ typ :int_ptr;
+ len :int_ptr;
+ offset:int_ptr;
+ end;
+type
+ TStructType = record
+ typ :integer;
+ short:PAnsiChar;
+ full :PAnsiChar;
+ end;
+const
+ MaxStructTypes = 11;
+const
+ StructElems: array [0..MaxStructTypes-1] of TStructType = (
+ (typ:SST_BYTE ; short:'byte' ; full:'Byte'),
+ (typ:SST_WORD ; short:'word' ; full:'Word'),
+ (typ:SST_DWORD ; short:'dword' ; full:'DWord'),
+ (typ:SST_QWORD ; short:'qword' ; full:'QWord'),
+ (typ:SST_NATIVE; short:'native'; full:'NativeInt'),
+ (typ:SST_BARR ; short:'b.arr' ; full:'Byte Array'),
+ (typ:SST_WARR ; short:'w.arr' ; full:'Word Array'),
+ (typ:SST_BPTR ; short:'b.ptr' ; full:'Pointer to bytes'),
+ (typ:SST_WPTR ; short:'w.ptr' ; full:'Pointer to words'),
+{$IFDEF Miranda}
+ (typ:SST_LAST ; short:'last' ; full:'Last result'),
+ (typ:SST_PARAM ; short:'param' ; full:'Parameter')
+{$ELSE}
+ (typ:SST_LAST ; short:'last' ; full:'Parameter 1'),
+ (typ:SST_PARAM ; short:'param' ; full:'Parameter 2')
+{$ENDIF}
+ );
+
+
+type
+ tOneElement = record
+ etype :integer;
+ flags :integer; // EF_MMI,EF_SCRIPT,EF_RETURN
+ len :integer; // value length (for arrays and pointers)
+ align :integer;
+ alias :array [0..63] of AnsiChar;
+ talias:array [0..63] of AnsiChar; // type alias
+ svalue:array [0..31] of AnsiChar; // numeric value text
+ case boolean of
+ false: (value:int64);
+ true : (text :pointer);
+ end;
+
+
+function GetOneElement(txt:pAnsiChar;var res:tOneElement;
+ SizeOnly:boolean;num:integer=0):integer;
+procedure FreeElement(var element:tOneElement);
+
+{$IFDEF Miranda}
+const
+ rtInt = 1;
+ rtWide = 2;
+{$ENDIF}
+
+function MakeStructure(txt:pAnsiChar;aparam,alast:LPARAM
+ {$IFDEF Miranda}; restype:integer=rtInt{$ENDIF}):pointer;
+
+function GetStructureResult(var struct;atype:pinteger=nil;alen:pinteger=nil):int_ptr;
+
+procedure FreeStructure(var struct);
+
+implementation
+
+uses common{$IFDEF Miranda}, mirutils{$ENDIF};
+
+type
+ pint_ptr = ^int_ptr;
+ TWPARAM = WPARAM;
+ TLPARAM = LPARAM;
+
+type
+ pShortTemplate = ^tShortTemplate;
+ tShortTemplate = packed record
+ etype :byte;
+ flags :byte;
+ offset:word;
+ end;
+
+// adjust offset to field
+function AdjustSize(var summ:int_ptr;eleadjust:integer;adjust:integer):integer;
+var
+ rest,lmod:integer;
+begin
+ // packed, byte or array of byte
+ if adjust=0 then
+ adjust:={$IFDEF WIN32}4{$ELSE}8{$ENDIF}; // SizeOf(int_ptr);
+
+ if (adjust=1) or (eleadjust=1) then
+ else
+ begin
+ case adjust of
+ 2: begin
+ lmod:=2;
+ end;
+ 4: begin
+ if eleadjust>2 then
+ lmod:=4
+ else
+ lmod:=2;
+ end;
+ 8: begin
+ if eleadjust>4 then
+ lmod:=8
+ else if eleadjust>2 then
+ lmod:=4
+ else
+ lmod:=2;
+ end;
+ else
+ lmod:=2;
+ end;
+ rest:=summ mod lmod;
+ if rest>0 then
+ begin
+ summ:=summ+(lmod-rest);
+ end;
+ end;
+
+ result:=summ;
+end;
+
+procedure SkipSpace(var txt:pAnsiChar); {$IFDEF FPC}inline;{$ENDIF}
+begin
+ while (txt^ in [' ',#9]) do inc(txt);
+end;
+
+function GetOneElement(txt:pAnsiChar;var res:tOneElement;
+ SizeOnly:boolean;num:integer=0):integer;
+var
+ pc,pc1:pAnsiChar;
+ i,llen:integer;
+begin
+ FillChar(res,SizeOf(res),0);
+
+ if num>0 then // Skip needed element amount
+ begin
+ end;
+
+ SkipSpace(txt);
+ // process flags
+ while not (txt^ in sWordOnly) do
+ begin
+ case txt^ of
+ char_return: res.flags:=res.flags or EF_RETURN;
+{$IFDEF Miranda}
+ char_script: res.flags:=res.flags or EF_SCRIPT;
+ char_mmi : res.flags:=res.flags or EF_MMI;
+{$ENDIF}
+ end;
+ inc(txt);
+ end;
+
+ SkipSpace(txt);
+ // element type
+ pc:=txt;
+ llen:=0;
+ repeat
+ inc(pc);
+ inc(llen);
+ until pc^ IN [#0,#9,' ',char_separator];
+ // recogninze data type
+ i:=0;
+ while i<MaxStructTypes do
+ begin
+ if StrCmp(txt,StructElems[i].short,llen)=0 then //!!
+ break;
+ inc(i);
+ end;
+ if i>=MaxStructTypes then
+ begin
+ result :=SST_UNKNOWN;
+ res.etype:=SST_UNKNOWN;
+ exit;
+ end;
+ result:=StructElems[i].typ;
+ res.etype:=result;
+
+ if (not SizeOnly) or (result in [SST_WARR,SST_BARR,SST_WPTR,SST_BPTR]) then
+ begin
+ // type alias, inside parentheses
+ SkipSpace(pc);
+ if not (pc^ in [#0,char_separator]) then
+ begin
+ if (pc^='(') and ((pc+1)^ in sIdFirst) then
+ begin
+ inc(pc); // skip space and parenthesis
+ pc1:=@res.talias;
+ repeat
+ pc1^:=pc^;
+ inc(pc1);
+ inc(pc);
+ until (pc^=')'){ or (pc^=' ')} or (pc^=char_separator);
+ if pc^=')' then inc(pc);
+ end;
+ end;
+
+ // alias, starting from letter
+ // start: points to separator or space
+ SkipSpace(pc);
+ if not (pc^ in [#0,char_separator]) then
+ begin
+ if pc^ in sIdFirst then
+ begin
+// inc(pc); // skip space
+ pc1:=@res.alias;
+ repeat
+ pc1^:=pc^;
+ inc(pc1);
+ inc(pc);
+ until (pc^=' ') or (pc^=char_separator);
+ end;
+ end;
+
+ // next - values
+ // if has empty simple value, then points to next element but text-to-number will return 0 anyway
+// if pc^=' ' then inc(pc); // points to value or nothing if no args
+ SkipSpace(pc);
+ case result of
+ SST_LAST,SST_PARAM: ;
+
+ SST_BYTE,SST_WORD,SST_DWORD,SST_QWORD,SST_NATIVE: begin
+ begin
+ if (res.flags and EF_SCRIPT)=0 then
+ begin
+ pc1:=@res.svalue;
+ if pc^=char_hex then
+ begin
+ inc(pc);
+ while pc^ in sHexNum do
+ begin
+ pc1^:=pc^;
+ inc(pc1);
+ inc(pc);
+ end;
+ res.value:=HexToInt(res.svalue)
+ end
+ else
+ begin
+ while pc^ in sNum do
+ begin
+ pc1^:=pc^;
+ inc(pc1);
+ inc(pc);
+ end;
+ res.value:=StrToInt(res.svalue);
+ end;
+ end
+ else
+ begin
+ txt:=pc;
+ //!!
+ while not (pc^ in [#0,char_separator]) do inc(pc);
+ if txt<>pc then
+ StrDup(pAnsiChar(res.text),txt,pc-txt)
+ else
+ res.text:=nil;
+ end;
+ end;
+ end;
+
+ SST_BARR,SST_WARR,SST_BPTR,SST_WPTR: begin
+ // if pc^ in sNum then
+ res.len:=StrToInt(pc);
+ if not SizeOnly then
+ begin
+ while pc^ in sNum do inc(pc);
+
+ // skip space
+// if pc^=' ' then inc(pc);
+ SkipSpace(pc);
+
+ //!!
+ if not (pc^ in [#0,char_separator]) then
+ begin
+ txt:=pc;
+ while not (pc^ in [#0,char_separator]) do inc(pc);
+ if txt<>pc then
+ StrDup(pAnsiChar(res.text),txt,pc-txt)
+ else
+ res.text:=nil;
+ end;
+ end;
+ end;
+ end;
+ end;
+
+ case result of
+ SST_LAST,
+ SST_PARAM : begin res.len:=SizeOf(LPARAM); res.align:=SizeOf(LPARAM); end;
+ SST_BYTE : begin res.len:=1; res.align:=1; end;
+ SST_WORD : begin res.len:=2; res.align:=2; end;
+ SST_DWORD : begin res.len:=4; res.align:=4; end;
+ SST_QWORD : begin res.len:=8; res.align:=8; end;
+ SST_NATIVE: begin res.len:=SizeOf(LPARAM); res.align:=SizeOf(LPARAM); end; // SizeOf(NativeInt)
+ SST_BARR : res.align:=1;
+ SST_WARR : res.align:=2;
+ SST_BPTR : res.align:=SizeOf(pointer);
+ SST_WPTR : res.align:=SizeOf(pointer);
+ end;
+end;
+
+// within translation need to check array size limit
+// "limit" = array size, elements, not bytes!
+procedure TranslateBlob(dst:pByte;const element:tOneElement);
+var
+ datatype:integer;
+ clen,len:integer;
+ src:pAnsiChar;
+ srcw:pWideChar absolute src;
+ buf:array [0..9] of AnsiChar;
+ bufw:array [0..4] of WideChar absolute buf;
+begin
+ if element.text=nil then exit;
+
+ if element.etype in [SST_WARR,SST_WPTR] then
+ begin
+ if (element.flags and EF_SCRIPT)<>0 then
+ datatype:=2 // Wide to Wide (if script done)
+ else
+ datatype:=1; // UTF to Wide
+ end
+ else // Ansi to Ansi
+ datatype:=0;
+
+ pint64(@buf)^:=0;
+
+ src:=element.text;
+ case datatype of
+ 0: begin // Ansi source for ansi
+ len:=StrLen(src);
+ if (element.len<>0) and (element.len<len) then
+ len:=element.len;
+
+ if StrScan(src,char_hex)=nil then
+ begin
+ move(src^,dst^,len);
+ end
+ else
+ begin
+ while (src^<>#0) and (len>0) do
+ begin
+ if (src^=char_hex) and ((src+1)^ in sHexNum) and ((src+2)^ in sHexNum) then
+ begin
+ buf[0]:=(src+1)^;
+ buf[1]:=(src+2)^;
+ inc(src,2+1);
+ dst^:=HexToInt(buf);
+ end
+ else
+ begin
+ dst^:=ord(src^);
+ inc(src);
+ end;
+ inc(dst);
+ dec(len);
+ end;
+ end;
+ end;
+
+ 1: begin // UTF8 source for unicode
+ // char_hex not found in UTF8 as Ansi - no reason to check as UTF8
+ // right, if char_hex is in ASCI7 only
+{
+ if StrScan(src,char_hex)=nil then
+ begin
+ // convert UTF8 to Wide without zero
+ end
+ else
+}
+ begin
+ len:=element.len;
+ while (src^<>#0) and (len>0) do
+ begin
+ if (src^=char_hex) and
+ ((src+1)^ in sHexNum) and
+ ((src+2)^ in sHexNum) then
+ begin
+ buf[0]:=(src+1)^;
+ buf[1]:=(src+2)^;
+ if ((src+3)^ in sHexNum) and
+ ((src+4)^ in sHexNum) then
+ begin
+ buf[2]:=(src+3)^;
+ buf[3]:=(src+4)^;
+ pWord(dst)^:=HexToInt(buf);
+ inc(src,4+1);
+ inc(dst,2);
+ end
+ else
+ begin
+ buf[2]:=#0;
+ dst^:=HexToInt(buf);
+ inc(dst);
+ inc(src,2+1);
+ end;
+ end
+ else
+ begin
+ pWideChar(dst)^:=CharUTF8ToWide(src,@clen);
+ inc(src,clen{CharUTF8Len(src)});
+ inc(dst,2);
+ dec(len);
+ end;
+ end;
+ end;
+ end;
+{$IFDEF Miranda}
+ 2: begin // Unicode source for unicode
+ len:=StrLenW(srcw);
+ if (element.len<>0) and (element.len<len) then
+ len:=element.len;
+
+ if StrScanW(srcw,char_hex)=nil then
+ begin
+ move(srcw^,dst^,len*SizeOf(WideChar));
+ end
+ else
+ begin
+ while (srcw^<>#0) and (len>0) do
+ begin
+ if (srcw^=char_hex) and
+ (ord(srcw[1])<255) and (AnsiChar(srcw[1]) in sHexNum) and
+ (ord(srcw[2])<255) and (AnsiChar(srcw[2]) in sHexNum) then
+ begin
+ bufw[0]:=srcw[1];
+ bufw[1]:=srcw[2];
+ if (ord(srcw[3])<255) and (AnsiChar(srcw[3]) in sHexNum) and
+ (ord(srcw[4])<255) and (AnsiChar(srcw[4]) in sHexNum) then
+ begin
+ bufw[2]:=srcw[3];
+ bufw[3]:=srcw[4];
+ pWord(dst)^:=HexToInt(bufw);
+ inc(src,4);
+ end
+ else
+ begin
+ bufw[2]:=#0;
+ dst^:=HexToInt(bufw);
+ dec(dst);
+ inc(srcw,2);
+ end;
+ end
+ else
+ pWideChar(dst)^:=srcw^;
+ inc(srcw);
+ inc(dst,2);
+ dec(len);
+ end;
+ end;
+ end;
+{$ENDIF}
+ end;
+end;
+
+procedure FreeElement(var element:tOneElement);
+begin
+ case element.etype of
+ SST_PARAM,SST_LAST: begin
+ end;
+ SST_BYTE,SST_WORD,SST_DWORD,
+ SST_QWORD,SST_NATIVE: begin
+ if (element.flags and EF_SCRIPT)<>0 then
+ mFreeMem(element.text);
+ end;
+ SST_BARR,SST_WARR,
+ SST_BPTR,SST_WPTR: begin
+ mFreeMem(element.text);
+ end;
+ end;
+end;
+
+function MakeStructure(txt:pAnsiChar;aparam,alast:LPARAM
+ {$IFDEF Miranda}; restype:integer=rtInt{$ENDIF}):pointer;
+var
+ summ:int_ptr;
+ lsrc:pAnsiChar;
+ res:pByte;
+ ppc,p,pc:pAnsiChar;
+{$IFDEF Miranda}
+ buf:array [0..31] of WideChar;
+ pLast: pWideChar;
+ valuein,value:pWideChar;
+{$ENDIF}
+ amount,align:integer;
+ lmod,code,alen,ofs:integer;
+ element:tOneElement;
+ tmpl:pShortTemplate;
+ addsize:integer;
+begin
+ result:=nil;
+ if (txt=nil) or (txt^=#0) then
+ exit;
+
+ pc:=txt;
+
+ ppc:=pc;
+ summ:=0;
+
+ if pc^ in sNum then
+ begin
+ align:=ord(pc^)-ord('0');//StrToInt(pc);
+ lsrc:=StrScan(pc,char_separator)+1; // not just +2 for future features
+ end
+ else
+ begin
+ align:=0;
+ lsrc:=pc;
+ end;
+
+ code:=SST_UNKNOWN;
+ alen:=0;
+ ofs :=0;
+
+ amount:=0;
+ // size calculation
+ while lsrc^<>#0 do
+ begin
+ p:=StrScan(lsrc,char_separator);
+// if p<>nil then p^:=#0;
+
+ GetOneElement(lsrc,element,true);
+ AdjustSize(summ,element.align,align);
+
+ if ((element.flags and EF_RETURN)<>0) and (code=SST_UNKNOWN) then
+ begin
+ code:=element.etype;
+ alen:=element.len;
+ ofs :=summ;
+ end;
+
+ if (element.etype=SST_BPTR) or (element.etype=SST_WPTR) then
+ inc(summ,SizeOf(pointer))
+ else
+ inc(summ,element.len);
+
+ inc(amount);
+
+ if p=nil then break;
+ lsrc:=p+1;
+ end;
+
+ // memory allocation with result record and template
+ addsize:=SizeOF(TStructResult)+SizeOF(tShortTemplate)*amount+SizeOf(dword);
+ lmod:=addsize mod SizeOf(pointer);
+ if lmod<>0 then
+ inc(addsize,SizeOf(pointer)-lmod);
+
+ inc(summ,addsize);
+
+ mGetMem (tmpl,summ);
+ FillChar(tmpl^,summ,0);
+
+ res:=pByte(pAnsiChar(tmpl)+addsize-SizeOf(tStructResult)-SizeOf(dword));
+ pdword(res)^:=amount; inc(res,SizeOf(dword));
+ with PStructResult(res)^ do
+ begin
+ typ :=code;
+ len :=alen;
+ offset:=ofs;
+ end;
+
+ inc(res,SizeOf(tStructResult));
+ result:=res;
+
+ pc:=ppc;
+
+ // translation
+ if pc^ in sNum then
+ // pc:=pc+2;
+ pc:=StrScan(pc,char_separator)+1;
+
+ while pc^<>#0 do
+ begin
+ p:=StrScan(pc,char_separator);
+ GetOneElement(pc,element,false);
+
+ if (element.flags and EF_SCRIPT)<>0 then
+ begin
+{$IFDEF Miranda}
+ if restype=rtInt then
+ pLast:=IntToStr(buf,alast)
+ else
+ pLast:=pWideChar(alast);
+ // BPTR,BARR - Ansi
+ // WPTR,WARR - Unicode
+ // BYTE,WORD,DWORD,QWORD,NATIVE - ???
+ // in value must be converted to unicode/ansi but not UTF8
+ UTF8ToWide(element.text,valuein);
+ value:=ParseVarString(valuein,aparam,pLast);
+ mFreeMem(valuein);
+ case element.etype of
+ // Numbers - just get number values
+ SST_BYTE,
+ SST_WORD,
+ SST_DWORD,
+ SST_QWORD,
+ SST_NATIVE: begin
+ {
+ StrCopy(element.svalue,value,31);
+ element.value:=StrToInt(element.svalue);
+ }
+ element.value:=StrToInt(value);
+ mFreeMem(value);
+ end;
+ // Byte strings - replace Ansi value
+ SST_BARR,
+ SST_BPTR: begin
+ mFreeMem(element.text);
+ WideToAnsi(value,pAnsiChar(element.text),MirandaCP);
+ mFreeMem(value);
+ end;
+ // Wide strings - replace UTF8 by Wide
+ SST_WARR,
+ SST_WPTR: begin
+ // really, need to translate Wide to UTF8 again?
+ mFreeMem(element.text);
+ element.text:=value;
+ end;
+ end;
+{$ENDIF}
+ end;
+
+ AdjustSize(int_ptr(res),element.align,align);
+
+ tmpl^.etype :=element.etype;
+ tmpl^.flags :=element.flags;
+ tmpl^.offset:=uint_ptr(res)-uint_ptr(result);
+
+ case element.etype of
+ SST_LAST: begin
+ pint_ptr(res)^:=alast;
+ end;
+ SST_PARAM: begin
+ pint_ptr(res)^:=aparam;
+ end;
+ SST_BYTE: begin
+ pByte(res)^:=element.value;
+ end;
+ SST_WORD: begin
+ pWord(res)^:=element.value;
+ end;
+ SST_DWORD: begin
+ pDWord(res)^:=element.value;
+ end;
+ SST_QWORD: begin
+ pint64(res)^:=element.value;
+ end;
+ SST_NATIVE: begin
+ pint_ptr(res)^:=element.value;
+ end;
+ SST_BARR: begin
+ TranslateBlob(pByte(res),element);
+ end;
+ SST_WARR: begin
+ TranslateBlob(pByte(res),element);
+ end;
+ SST_BPTR: begin
+ if element.len=0 then
+ element.len:=StrLen(element.text);
+
+ if element.len=0 then
+ pint_ptr(res)^:=0
+ else
+ begin
+ inc(element.len); // with Zero at the end
+{$IFDEF Miranda}
+ if (element.flags and EF_MMI)<>0 then
+ lsrc:=mir_alloc(element.len*SizeOf(AnsiChar))
+ else
+{$ENDIF}
+ mGetMem (lsrc ,element.len*SizeOf(AnsiChar));
+ FillChar(lsrc^,element.len*SizeOf(AnsiChar),0);
+ TranslateBlob(pByte(lsrc),element);
+ pint_ptr(res)^:=uint_ptr(lsrc);
+ end;
+ end;
+ SST_WPTR: begin
+ if element.len=0 then
+ begin
+{$IFDEF Miranda}
+ if (element.flags and EF_SCRIPT)<>0 then
+ element.len:=StrLenW(element.text)
+ else
+{$ENDIF}
+ element.len:=UTF8Len(element.text);
+ end;
+
+ if element.len=0 then
+ pint_ptr(res)^:=0
+ else
+ begin
+ inc(element.len); // with Zero at the end
+{$IFDEF Miranda}
+ if (element.flags and EF_MMI)<>0 then
+ lsrc:=mir_alloc(element.len*SizeOf(WideChar))
+ else
+{$ENDIF}
+ mGetMem (lsrc ,element.len*SizeOf(WideChar));
+ FillChar(lsrc^,element.len*SizeOf(WideChar),0);
+//!!!!! variables script gives unicode, need to recognize it
+ TranslateBlob(pByte(lsrc),element);
+ pint_ptr(res)^:=uint_ptr(lsrc);
+ end;
+ end;
+ end;
+ if (element.etype=SST_BPTR) or (element.etype=SST_WPTR) then
+ inc(int_ptr(res),SizeOf(pointer))
+ else
+ inc(int_ptr(res),element.len);
+
+ FreeElement(element);
+ if p=nil then break;
+ pc:=p+1;
+ inc(tmpl);
+ end;
+ tmpl^.flags:=tmpl^.flags or EF_LAST;
+end;
+
+function GetStructureResult(var struct;atype:pinteger=nil;alen:pinteger=nil):int_ptr;
+var
+ loffset,ltype:integer;
+begin
+ with PStructResult(pAnsiChar(struct)-SizeOF(TStructResult))^ do
+ begin
+ ltype :=typ ;
+ loffset:=offset;
+ if atype<>nil then atype^:=typ;
+ if alen <>nil then alen ^:=len;
+ end;
+
+ case ltype of
+ SST_LAST : result:=0;
+ SST_PARAM: result:=0;
+
+ SST_BYTE : result:=pByte (pAnsiChar(struct)+loffset)^;
+ SST_WORD : result:=pWord (pAnsiChar(struct)+loffset)^;
+ SST_DWORD : result:=pDword (pAnsiChar(struct)+loffset)^;
+ SST_QWORD : result:=pint64 (pAnsiChar(struct)+loffset)^;
+ SST_NATIVE: result:=pint_ptr(pAnsiChar(struct)+loffset)^;
+
+ SST_BARR: result:=int_ptr(pAnsiChar(struct)+loffset); //??
+ SST_WARR: result:=int_ptr(pAnsiChar(struct)+loffset); //??
+
+ SST_BPTR: result:=pint_ptr(pAnsiChar(struct)+loffset)^; //??
+ SST_WPTR: result:=pint_ptr(pAnsiChar(struct)+loffset)^; //??
+ else
+ result:=0;
+ end;
+end;
+
+procedure FreeStructure(var struct);
+var
+ value:pAnsiChar;
+ tmpl:pShortTemplate;
+ num,lmod:integer;
+ tmp:pointer;
+begin
+ tmp:=pointer(pAnsiChar(struct)-SizeOF(TStructResult)-SizeOf(dword));
+ num:=pdword(tmp)^;
+ tmpl:=pointer(pAnsiChar(tmp)-num*SizeOf(tShortTemplate));
+ lmod:=uint_ptr(tmpl) mod SizeOf(pointer);
+ // align to pointer size border
+ if lmod<>0 then
+ tmpl:=pointer(pAnsiChar(tmpl)-(SizeOf(pointer)-lmod));
+
+ tmp:=tmpl;
+
+ repeat
+ case tmpl^.etype of
+ SST_BPTR,SST_WPTR: begin
+ //??
+ value:=pAnsiChar(pint_ptr(pAnsiChar(struct)+tmpl^.offset)^);
+{$IFDEF Miranda}
+ if (tmpl^.flags and EF_MMI)<>0 then
+ mir_free(value)
+ else
+{$ENDIF}
+ mFreeMem(value);
+ end;
+ end;
+ inc(tmpl);
+ until (tmpl^.flags and EF_LAST)<>0;
+
+ mFreeMem(tmp);
+end;
+
+end.
diff --git a/plugins/Utils.pas/structopts.rc b/plugins/Utils.pas/structopts.rc new file mode 100644 index 0000000000..f9fa75e0d1 --- /dev/null +++ b/plugins/Utils.pas/structopts.rc @@ -0,0 +1,83 @@ +#include "i_struct_const.inc"
+
+LANGUAGE 0,0
+
+IDD_STRUCTURE DIALOGEX 0, 0, 348,184, 0
+STYLE DS_SETFONT | DS_FIXEDSYS | WS_VISIBLE | WS_THICKFRAME
+CAPTION "Structure Editor"
+EXSTYLE WS_EX_CONTROLPARENT
+FONT 8, "MS Shell Dlg", 0, 0
+{
+ CONTROL "" , IDC_DATA_FULL, "SysListView32",
+ WS_BORDER | WS_TABSTOP |
+ LVS_SHOWSELALWAYS | LVS_EDITLABELS | // LVS_NOCOLUMNHEADER |
+ LVS_SINGLESEL | LVS_REPORT,
+ 2, 2, 160, 162, WS_EX_CONTROLPARENT
+ COMBOBOX IDC_DATA_TMPL , 2, 168, 140, 56, CBS_DROPDOWNLIST | WS_VSCROLL
+
+#ifdef Miranda
+ CONTROL "New" ,IDC_DATA_NEW ,"MButtonClass",WS_TABSTOP,166, 2,16,16,$18000000// | WS_GROUP
+ CONTROL "Up" ,IDC_DATA_UP ,"MButtonClass",WS_TABSTOP,166, 22,16,16,$18000000
+ CONTROL "Down" ,IDC_DATA_DOWN ,"MButtonClass",WS_TABSTOP,166, 40,16,16,$18000000
+ CONTROL "Delete",IDC_DATA_DELETE,"MButtonClass",WS_TABSTOP,166, 60,16,16,$18000000
+
+ CONTROL "?" ,IDC_DATA_INFO ,"MButtonClass",WS_TABSTOP,146,167,16,16,$18000000
+ CONTROL "!" ,IDC_DATA_PASTE ,"MButtonClass",WS_TABSTOP,166,167,16,16,$18000000
+#else
+ PUSHBUTTON "New" ,IDC_DATA_NEW ,166, 2,16,16, BS_ICON | BS_FLAT
+ PUSHBUTTON "Up" ,IDC_DATA_UP ,166, 22,16,16, BS_ICON | BS_FLAT
+ PUSHBUTTON "Down" ,IDC_DATA_DOWN ,166, 40,16,16, BS_ICON | BS_FLAT
+ PUSHBUTTON "Delete",IDC_DATA_DELETE,166, 60,16,16, BS_ICON | BS_FLAT
+
+ PUSHBUTTON "?" ,IDC_DATA_INFO ,146,167,16,16, BS_ICON | BS_FLAT
+ PUSHBUTTON "!" ,IDC_DATA_PASTE ,166,167,16,16, BS_ICON | BS_FLAT
+#endif
+
+ RTEXT "Data align",IDC_DATA_SALGN, 186, 2, 86, 14, SS_CENTERIMAGE
+ COMBOBOX IDC_DATA_ALIGN , 274, 2, 72, 56, CBS_DROPDOWNLIST | WS_VSCROLL
+ CONTROL "", IDC_DATA_SEP, "STATIC", SS_ETCHEDHORZ, 186, 20, 160, 2
+
+ COMBOBOX IDC_DATA_TYPE, 186, 24, 160, 96, CBS_DROPDOWNLIST | WS_VSCROLL
+ EDITTEXT IDC_DATA_LEN , 186, 40, 40, 11
+ LTEXT "Data length" , IDC_DATA_SLEN, 230, 40, 116, 11, SS_CENTERIMAGE
+ EDITTEXT IDC_DATA_EDIT, 186, 55, 160, 82,
+ ES_MULTILINE | ES_AUTOVSCROLL | ES_WANTRETURN
+ EDITTEXT IDC_DATA_EDTN, 186, 55, 160, 11
+#ifdef Miranda
+ CONTROL "V" ,IDC_VAR_HELP ,"MButtonClass",WS_TABSTOP,328,137,16,16,$18000000
+ AUTOCHECKBOX "Use Variables", IDC_DATA_VARS, 186, 138, 142, 14
+ AUTOCHECKBOX "Use MMI" , IDC_DATA_MMI , 186, 152, 160, 14
+#endif
+
+ DEFPUSHBUTTON "&Change", IDC_DATA_CHANGE, 186, 168, 46, 14//, WS_GROUP
+ PUSHBUTTON "&OK" , IDOK , 250, 168, 46, 14
+ PUSHBUTTON "C&ancel", IDCANCEL , 300, 168, 46, 14
+
+}
+
+IDD_STRUCTHELP DIALOGEX 0, 0, 256, 174, 0
+STYLE DS_SETFONT | DS_FIXEDSYS | WS_VISIBLE | WS_CAPTION | WS_SYSMENU
+EXSTYLE WS_EX_CONTROLPARENT
+CAPTION "Structure help"
+FONT 8, "MS Shell Dlg", 0, 0
+{
+ DEFPUSHBUTTON "OK", IDOK, 4, 154, 26, 16
+
+ RTEXT "Name", -1 , 4, 4, 60, 14, SS_CENTERIMAGE
+ EDITTEXT IDC_HLP_NAME, 70, 5, 180, 12, ES_READONLY
+
+ RTEXT "Plugin", -1 , 4, 20, 60, 14, SS_CENTERIMAGE
+ EDITTEXT IDC_HLP_PLUGIN , 70, 21, 180, 12, ES_READONLY
+
+ RTEXT "Descr", -1 , 4, 36, 60, 14, SS_CENTERIMAGE
+ EDITTEXT IDC_HLP_DESCR , 70, 36, 180, 42, ES_MULTILINE | ES_READONLY | ES_AUTOVSCROLL
+
+ CONTROL "", -1, "STATIC", SS_ETCHEDHORZ, 2, 80, 252, 2
+
+ EDITTEXT IDC_HLP_STRUCT , 70, 84, 180, 88, ES_MULTILINE | ES_READONLY | ES_AUTOVSCROLL
+}
+
+IDI_NEW ICON "ico\new.ico"
+IDI_UP ICON "ico\up.ico"
+IDI_DOWN ICON "ico\down.ico"
+IDI_DELETE ICON "ico\delete.ico"
diff --git a/plugins/Utils.pas/structopts.res b/plugins/Utils.pas/structopts.res Binary files differnew file mode 100644 index 0000000000..65df5f8a67 --- /dev/null +++ b/plugins/Utils.pas/structopts.res diff --git a/plugins/Utils.pas/syswin.pas b/plugins/Utils.pas/syswin.pas new file mode 100644 index 0000000000..7cc646184a --- /dev/null +++ b/plugins/Utils.pas/syswin.pas @@ -0,0 +1,725 @@ +unit syswin;
+{$include compilers.inc}
+
+interface
+
+uses windows;
+
+type
+ tFFWFilterProc = function(fname:pWideChar):boolean;
+
+const
+ ThreadTimeout = 50;
+const
+ gffdMultiThread = 1;
+ gffdOld = 2;
+
+function GetWorkOfflineStatus:integer;
+
+function SendString(wnd:HWND;astr:PWideChar):integer; overload;
+function SendString(wnd:HWND;astr:PAnsiChar):integer; overload;
+procedure ProcessMessages;
+function GetFocusedChild(wnd:HWND):HWND;
+function GetAssoc(key:PAnsiChar):PAnsiChar;
+function GetFileFromWnd(wnd:HWND;Filter:tFFWFilterProc;
+ flags:dword=gffdMultiThread+gffdOld;timeout:cardinal=ThreadTimeout):pWideChar;
+
+function WaitFocusedWndChild(Wnd:HWnd):HWnd;
+
+function ExecuteWaitW(AppPath:pWideChar; CmdLine:pWideChar=nil; DfltDirectory:PWideChar=nil;
+ Show:DWORD=SW_SHOWNORMAL; TimeOut:DWORD=0; ProcID:PDWORD=nil):dword;
+function ExecuteWait(AppPath:PAnsiChar; CmdLine:PAnsiChar=nil; DfltDirectory:PAnsiChar=nil;
+ Show:DWORD=SW_SHOWNORMAL; TimeOut:DWORD=0; ProcID:PDWORD=nil):dword;
+
+function GetEXEbyWnd(w:HWND; var dst:pWideChar):pWideChar; overload;
+function GetEXEbyWnd(w:HWND; var dst:PAnsiChar):PAnsiChar; overload;
+function IsExeRunning(exename:PWideChar):boolean; {hwnd}
+
+implementation
+
+uses
+ {$IFNDEF FPC}shellapi,{$ENDIF}
+{$IFDEF COMPILER_16_UP}
+ WinAPI.PsApi,
+{$ELSE}
+ psapi,
+{$ENDIF}
+ common,messages;
+
+{$IFDEF COMPILER_16_UP}
+type pqword = ^int64;
+{$ENDIF}
+
+function ExecuteWaitW(AppPath:pWideChar; CmdLine:pWideChar=nil; DfltDirectory:PWideChar=nil;
+ Show:DWORD=SW_SHOWNORMAL; TimeOut:DWORD=0; ProcID:PDWORD=nil):dword;
+var
+ Flags: DWORD;
+ {$IFDEF FPC}
+ Startup: StartupInfo;
+ {$ELSE}
+ Startup: StartupInfoW;
+ {$ENDIF}
+ ProcInf: TProcessInformation;
+ App: array [0..1023] of widechar;
+ p:PWideChar;
+ ext1,ext2:array [0..7] of widechar;
+begin
+ Result := cardinal(-1);
+ if FindExecutableW(AppPath,DfltDirectory,App)<=32 then
+ exit;
+ if lstrcmpiw(GetExt(AppPath,ext1,7),GetExt(App,ext2,7))<>0 then
+ CmdLine:=AppPath;
+ Flags := CREATE_NEW_CONSOLE;
+ if Show = SW_HIDE then
+ Flags := Flags or CREATE_NO_WINDOW;
+ FillChar(Startup, SizeOf(Startup),0);
+ with Startup do
+ begin
+ cb :=SizeOf(Startup);
+ wShowWindow:=Show;
+ dwFlags :=STARTF_USESHOWWINDOW;
+ end;
+ if ProcID <> nil then
+ ProcID^ := 0;
+ p:=StrEndW(App);
+ if (CmdLine<>nil) and (CmdLine^<>#0) then
+ begin
+ p^:=' ';
+ inc(p);
+ StrCopyW(p,CmdLine);
+ end;
+ if CreateProcessW(nil,App,nil,nil,FALSE,Flags,nil,DfltDirectory,Startup,ProcInf) then
+ begin
+ if TimeOut<>0 then
+ begin
+ if WaitForSingleObject(ProcInf.hProcess,TimeOut)=WAIT_OBJECT_0 then
+ begin
+ GetExitCodeProcess(ProcInf.hProcess,result);
+ CloseHandle(ProcInf.hProcess);
+ end
+ else
+ begin
+ result:=1;
+ if ProcID<>nil then
+ ProcID^:=ProcInf.hProcess;
+ end;
+ end
+ else
+ begin
+ GetExitCodeProcess(ProcInf.hProcess,result);
+ CloseHandle(ProcInf.hProcess);
+ end;
+ CloseHandle(ProcInf.hThread);
+ end;
+end;
+
+function ExecuteWait(AppPath:PAnsiChar; CmdLine:PAnsiChar=nil; DfltDirectory:PAnsiChar=nil;
+ Show:DWORD=SW_SHOWNORMAL; TimeOut:DWORD=0; ProcID:PDWORD=nil):dword;
+var
+ Flags: DWORD;
+ {$IFDEF FPC}
+ Startup: StartupInfo;
+ {$ELSE}
+ Startup: StartupInfoA;
+ {$ENDIF}
+ ProcInf: TProcessInformation;
+ App: array [0..1023] of AnsiChar;
+ p:PAnsiChar;
+ ext1,ext2:array [0..7] of AnsiChar;
+begin
+ Result := cardinal(-1);
+ if FindExecutableA(AppPath,DfltDirectory,App)<=32 then
+ exit;
+ if lstrcmpia(GetExt(AppPath,ext1,7),GetExt(App,ext2,7))<>0 then
+ CmdLine:=AppPath;
+ Flags := CREATE_NEW_CONSOLE;
+ if Show = SW_HIDE then
+ Flags := Flags or CREATE_NO_WINDOW;
+ FillChar(Startup, SizeOf(Startup),0);
+ with Startup do
+ begin
+ cb :=SizeOf(Startup);
+ wShowWindow:=Show;
+ dwFlags :=STARTF_USESHOWWINDOW;
+ end;
+ if ProcID <> nil then
+ ProcID^ := 0;
+ p:=StrEnd(App);
+ if (CmdLine<>nil) and (CmdLine^<>#0) then
+ begin
+ p^:=' ';
+ inc(p);
+ StrCopy(p,CmdLine);
+ end;
+ if CreateProcessA(nil,App,nil,nil,FALSE,Flags,nil,DfltDirectory,Startup,ProcInf) then
+ begin
+ if TimeOut<>0 then
+ begin
+ if WaitForSingleObject(ProcInf.hProcess,TimeOut)=WAIT_OBJECT_0 then
+ begin
+ GetExitCodeProcess(ProcInf.hProcess,result);
+ CloseHandle(ProcInf.hProcess);
+ end
+ else
+ begin
+ result:=1;
+ if ProcID<>nil then
+ ProcID^:=ProcInf.hProcess;
+ end;
+ end
+ else
+ begin
+ GetExitCodeProcess(ProcInf.hProcess,result);
+ CloseHandle(ProcInf.hProcess);
+ end;
+ CloseHandle(ProcInf.hThread);
+ end;
+end;
+
+//----- Information functions -----
+
+function GetWorkOfflineStatus:integer;
+var
+ lKey:HKEY;
+ len,typ:dword;
+begin
+ result:=0;
+ if RegOpenKeyEx(HKEY_CURRENT_USER,
+ 'Software\Microsoft\Windows\CurrentVersion\Internet Settings',0,
+ KEY_READ,lKey)=ERROR_SUCCESS then
+ begin
+ len:=4;
+ typ:=REG_DWORD;
+ if RegQueryValueEx(lKey,'GlobalUserOffline',NIL,@typ,@result,@len)=ERROR_SUCCESS then
+ ;
+ RegCloseKey(lKey);
+ end;
+end;
+
+function GetAssoc(key:PAnsiChar):PAnsiChar;
+var
+ lKey:HKEY;
+ tmpbuf:array [0..511] of AnsiChar;
+ len:integer;
+begin
+ result:=nil;
+ if RegOpenKeyExA(HKEY_CLASSES_ROOT,key,0,
+ KEY_READ,lKey)=ERROR_SUCCESS then
+ begin
+ len:=511;
+ if (RegQueryValueExA(lKey,NIL,NIL,NIL,@tmpbuf,@len)=ERROR_SUCCESS) then
+ begin
+ StrDup(result,tmpbuf);
+// only path
+// while result[len]<>'\' do dec(len);
+// StrCopy(result,result+2,len-3);
+ end;
+ RegCloseKey(lKey);
+ end;
+end;
+
+function GetFocusedChild(wnd:HWND):HWND;
+var
+ dwTargetOwner:DWORD;
+ dwThreadID:DWORD;
+ res:boolean;
+begin
+ dwTargetOwner:=GetWindowThreadProcessId(wnd,nil);
+ dwThreadID:=GetCurrentThreadId();
+ res:=false;
+ if (dwTargetOwner<>dwThreadID) then
+ res:=AttachThreadInput(dwThreadID,dwTargetOwner,TRUE);
+ result:=GetFocus;
+ if res then
+ AttachThreadInput(dwThreadID,dwTargetOwner,FALSE);
+end;
+
+function WaitFocusedWndChild(Wnd:HWnd):HWnd;
+var
+ T1,T2:Integer;
+ W:HWnd;
+begin
+ Sleep(50);
+ T1:=GetTickCount;
+ repeat
+ W:=GetTopWindow(Wnd);
+ if W=0 then W:=Wnd;
+ W:=GetFocusedChild(W);
+ if W<>0 then
+ begin
+ Wnd:=W;
+ break;
+ end;
+ T2:=GetTickCount;
+ if Abs(T1-T2)>100 then break;
+ until false;
+ Result:=Wnd;
+end;
+
+function SendString(wnd:HWND;astr:PWideChar):integer;
+var
+ s,s0:PWideChar;
+ style:integer;
+begin
+ result:=0;
+ if (astr=nil) or (astr^=#0) then exit;
+ if wnd=0 then
+ begin
+ wnd:=WaitFocusedWndChild(GetForegroundWindow);
+ if wnd=0 then Exit;
+ end;
+ style:=GetWindowLongW(wnd,GWL_STYLE);
+ if (style and (WS_DISABLED or ES_READONLY))=0 then
+ begin
+ StrDupW(s,astr); //??
+ s0:=s;
+ while s^<>#0 do
+ begin
+ if s^<>#10 then
+ PostMessageW(wnd,WM_CHAR,ord(s^),1);
+ Inc(s);
+ end;
+ mFreeMem(s0); //??
+ result:=1;
+ end;
+end;
+
+function SendString(wnd:HWND;astr:PAnsiChar):integer;
+var
+ s,s0:PAnsiChar;
+ style:integer;
+begin
+ result:=0;
+ if (astr=nil) or (astr^=#0) then exit;
+ if wnd=0 then
+ begin
+ wnd:=WaitFocusedWndChild(GetForegroundWindow);
+ if wnd=0 then Exit;
+ end;
+ style:=GetWindowLongA(wnd,GWL_STYLE);
+ if (style and (WS_DISABLED or ES_READONLY))=0 then
+ begin
+ StrDup(s,astr); //??
+ s0:=s;
+ while s^<>#0 do
+ begin
+ if s^<>#10 then
+ PostMessageA(wnd,WM_CHAR,ord(s^),1);
+ Inc(s);
+ end;
+ mFreeMem(s0); //??
+ result:=1;
+ end;
+end;
+
+procedure ProcessMessages;
+var
+ Unicode: Boolean;
+ MsgExists: Boolean;
+ Msg:tMsg;
+begin
+ repeat
+ if PeekMessageA(Msg,0,0,0,PM_NOREMOVE) then
+ begin
+ Unicode:=(Msg.hwnd<>0) and IsWindowUnicode(Msg.hwnd);
+ if Unicode then
+ MsgExists:=PeekMessageW(Msg,0,0,0,PM_REMOVE)
+ else
+ MsgExists:=PeekMessageA(Msg,0,0,0,PM_REMOVE);
+ if not MsgExists then break;
+
+ if Msg.Message<>WM_QUIT then
+ begin
+ TranslateMessage({$IFDEF FPC}@{$ENDIF}Msg);
+ if Unicode then
+ DispatchMessageW({$IFDEF FPC}@{$ENDIF}Msg)
+ else
+ DispatchMessageA({$IFDEF FPC}@{$ENDIF}Msg);
+ end;
+ end
+ else
+ break;
+ until false;
+end;
+
+//----- work with EXE -----
+
+function GetEXEbyWnd(w:HWND; var dst:pWideChar):pWideChar;
+var
+ hProcess:THANDLE;
+ ProcID:DWORD;
+ ModuleName: array [0..300] of WideChar;
+begin
+ dst:=nil;
+ GetWindowThreadProcessId(w,@ProcID);
+ if ProcID<>0 then
+ begin
+ hProcess:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,False,ProcID);
+ if hProcess<>0 then
+ begin
+ ModuleName[0]:=#0;
+ GetModuleFilenameExW(hProcess,0,ModuleName,SizeOf(ModuleName));
+ StrDupW(dst,ModuleName);
+ CloseHandle(hProcess);
+ end;
+ end;
+ result:=dst;
+end;
+
+function GetEXEbyWnd(w:HWND; var dst:PAnsiChar):PAnsiChar;
+var
+ hProcess:THANDLE;
+ ProcID:DWORD;
+ ModuleName: array [0..300] of AnsiChar;
+begin
+ dst:=nil;
+ GetWindowThreadProcessId(w,@ProcID);
+ if ProcID<>0 then
+ begin
+ hProcess:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,False,ProcID);
+ if hProcess<>0 then
+ begin
+ ModuleName[0]:=#0;
+ GetModuleFilenameExA(hProcess,0,ModuleName,SizeOf(ModuleName));
+ StrDup(dst,ModuleName);
+ CloseHandle(hProcess);
+ end;
+ end;
+ result:=dst;
+end;
+
+function IsExeRunning(exename:PWideChar):boolean;{hwnd}
+const
+ nCount = 4096;
+var
+ Processes:array [0..nCount-1] of dword;
+ nProcess:dword;
+ hProcess:THANDLE;
+ ModuleName: array [0..300] of WideChar;
+ i:integer;
+begin
+ result:=false;
+ EnumProcesses(pointer(@Processes),nCount*SizeOf(DWORD),nProcess);
+ nProcess:=(nProcess div 4)-1;
+ for i:=2 to nProcess do //skip Idle & System
+ begin
+ hProcess:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
+ False,Processes[i]);
+ if hProcess<>0 then
+ begin
+ GetModuleFilenameExW(hProcess,0,ModuleName,SizeOf(ModuleName));
+ result:=lstrcmpiw(ExtractW(ModuleName,true),exename)=0;
+ CloseHandle(hProcess);
+ if result then exit;
+ end;
+ end;
+end;
+
+//----- work with handles -----
+function GetProcessHandleCount(hProcess:THANDLE;var pdwHandleCount:dword):bool; stdcall; external 'kernel32.dll';
+
+function NtQueryObject(ObjectHandle:THANDLE;ObjectInformationClass:integer;
+ ObjectInformation:pointer;Length:ulong;var ResultLength:longint):cardinal; stdcall; external 'ntdll.dll';
+
+const
+ ObjectNameInformation = 1; // +4 bytes
+ ObjectTypeInformation = 2; // +$60 bytes
+const
+ STATUS_INFO_LENGTH_MISMATCH = $C0000004;
+
+function TranslatePath(fn:PWideChar):PWideChar;
+const
+ LANPrefix:PWideChar = '\Device\LanmanRedirector\';
+var
+ szTemp:array [0..511] of WideChar;
+ szName:array [0..511] of WideChar;
+ p:PWideChar;
+ uNameLen:word;
+ szTempFile:array [0..511] of WideChar;
+begin
+ if StrPosW(fn,LANPrefix)=fn then
+ begin
+ uNameLen:=StrLenW(LANPrefix);
+ mGetMem(result,(StrLenW(fn)-uNameLen+3)*SizeOf(WideChar));
+ result[0]:='\';
+ result[1]:='\';
+ StrCopyW(result+2,fn+uNameLen);
+ exit;
+ end;
+ if GetLogicalDriveStringsW(255,@szTemp)<>0 then
+ begin
+ p:=szTemp;
+ repeat
+ p[2]:=#0;
+ if QueryDosDeviceW(p,szName,255)<>0 then
+ begin
+ uNameLen:=StrLenW(szName)+1;
+ if uNameLen<255 then
+ begin
+ StrCopyW(szTempFile,fn,uNameLen-1);
+ if lstrcmpiw(szTempFile,szName)=0 then
+ begin
+ mGetMem(result,(StrLenW(fn+uNameLen)+4)*SizeOf(WideChar));
+ result[0]:=WideChar(ORD(p[0]));
+ result[1]:=':';
+ result[2]:='\';
+ StrCopyW(result+3,fn+uNameLen);
+ exit;
+ end;
+ end;
+ end;
+ inc(p,4);
+ until p^=#0;
+ end;
+ StrDupW(result,fn);
+end;
+
+const
+ maxhandles = 15;
+var
+ har,hold:array [0..maxhandles-1] of PWideChar;
+ harcnt:integer;
+const
+ oldcnt:integer=0;
+
+procedure ArSwitch(idx:integer);
+var
+ h:pWideChar;
+begin
+//clear old
+ while oldcnt>0 do
+ begin
+ dec(oldcnt);
+ FreeMem(hold[oldcnt]);
+ end;
+//copy new to old
+ move(har,hold,SizeOf(har));
+ oldcnt:=harcnt;
+// move active to begin
+ if idx<>0 then
+ begin
+ h :=hold[idx];
+ hold[idx]:=hold[0];
+ hold[0] :=h;
+ end;
+end;
+
+function CheckHandles(ReturnNew:bool):integer;
+var
+ i,j:integer;
+ flg:boolean;
+begin
+ result:=0;
+ if oldcnt=0 then //first time
+ begin
+ ArSwitch(0);
+ exit;
+ end;
+ i:=0;
+ if ReturnNew then
+ begin
+ while i<harcnt do
+ begin
+ flg:=false;
+ j:=0;
+ while j<oldcnt do
+ begin
+ if StrCmpW(har[i],hold[j])=0 then
+ begin
+ flg:=true; //old=new
+ break;
+ end;
+ inc(j);
+ end;
+ if not flg then // new!!
+ begin
+ ArSwitch(i);
+ exit;
+ end;
+ inc(i);
+ end;
+ end
+ else
+ begin
+ while i<oldcnt do
+ begin
+ j:=0;
+ while j<harcnt do
+ begin
+ if StrCmpW(hold[i],har[j])=0 then
+ begin
+ ArSwitch(j);
+ exit;
+ end;
+ inc(j);
+ end;
+ inc(i);
+ end;
+ end;
+ ArSwitch(0);
+ result:=-1;
+end;
+
+const
+ MaxHandle = $2000;
+
+type
+ ptrec = ^trec;
+ trec = record
+ handle:thandle;
+ fname:pWideChar;
+ end;
+
+type
+ pint_ptr = ^int_ptr;
+
+function GetName(param:pointer):integer; //stdcall;
+const
+ BufSize = $800;
+ // depends of record align
+ offset=SizeOf(Pointer) div 2; // 4 for win64, 2 for win32
+var
+ TmpBuf:array [0..BufSize-1] of WideChar;
+var
+ dummy:longint;
+ size:integer;
+ pc:pWideChar;
+begin
+ result:=0;
+
+ if NtQueryObject(ptrec(param)^.handle,ObjectNameInformation,
+ @TmpBuf,BufSize*SizeOf(WideChar),dummy)=0 then
+ begin
+ // UNICODE_STRING: 2b - length, 2b - maxlen, (align), next - pWideChar
+ size:=pword(@TmpBuf)^; // length in bytes
+ if size>=0 then
+ begin
+ GetMem(ptrec(param)^.fname,size+SizeOf(WideChar)); // length in bytes
+
+ pc:=pWideChar(pint_ptr(@TmpBuf[offset])^);
+ move(pc^,ptrec(param)^.fname^,size); // can be without zero
+ pword(pAnsiChar(ptrec(param)^.fname)+size)^:=0;
+ end
+ else
+ ptrec(param)^.fname:=nil;
+ end;
+end;
+
+function TestHandle(Handle:THANDLE;MultiThread:bool;timeout:cardinal):pWideChar;
+var
+ hThread:THANDLE;
+ rec:trec;
+// dummy:longint;
+ res:{$IFDEF COMPILER_16_UP}Longword{$ELSE}uint_ptr{$ENDIF};
+begin
+ result:=nil;
+{
+ // check what it - file
+ if (NtQueryObject(Handle,ObjectTypeInformation,
+ @TmpBuf,BufSize*SizeOf(WideChar),dummy)<>0) or
+ (StrCmpW(TmpBuf+$30,'File')<>0) then
+ Exit;
+}
+ // check what it disk file
+//!!! need to check again
+ if GetFileType(Handle)<>FILE_TYPE_DISK then exit;
+
+ rec.handle:=Handle;
+ rec.fname:=nil;
+
+ if not MultiThread then
+ begin
+ GetName(@rec);
+ result:=rec.fname;
+ end
+ else
+ begin
+ hThread:=BeginThread(nil,0,@GetName,@rec,0,res);
+ if WaitForSingleObject(hThread,timeout)=WAIT_TIMEOUT then
+ begin
+ TerminateThread(hThread,0);
+ end
+ else
+ result:=rec.fname;
+ CloseHandle(hThread);
+ end;
+end;
+
+function GetFileFromWnd(wnd:HWND;Filter:tFFWFilterProc;
+ flags:dword=gffdMultiThread+gffdOld;timeout:cardinal=ThreadTimeout):pWideChar;
+var
+ hProcess,h:THANDLE;
+ pid:THANDLE;
+ i:THANDLE;
+ c:THANDLE;
+ handles:dword;
+ pc:pWideChar;
+begin
+ result:=nil;
+ GetWindowThreadProcessId(wnd,@c);
+ pid:=OpenProcess(//PROCESS_VM_READ or
+ PROCESS_DUP_HANDLE or PROCESS_QUERY_INFORMATION {or PROCESS_QUERY_LIMITED_INFORMATION},
+ true,c);
+ if pid=0 then exit;
+ harcnt:=0;
+ if GetProcessHandleCount(pid,handles) then
+ begin
+ handles:=handles*4; // count no matter, check "every 4th" handle
+// Handles:=Handles*SizeOf(THANDLE);
+ hProcess:=GetCurrentProcess;
+ i:=SIZEOF(THANDLE); // skip first
+
+ while true do
+ begin
+ if DuplicateHandle(pid,i,hProcess,@h,GENERIC_READ,false,0) then
+ begin
+ pc:=TestHandle(h,(flags and gffdMultiThread)<>0,timeout);
+ if pc<>nil then
+ begin
+ // if GetFileType(h)=FILE_TYPE_DISK then
+ begin
+ if (@Filter=nil) or Filter(pc) and (harcnt<maxhandles) then
+ begin
+ har[harcnt]:=pc;
+ inc(harcnt);
+ end
+ else
+ FreeMem(pc);
+ end;
+ end;
+ CloseHandle(h);
+ end
+ else
+ begin
+// inc(handles,SizeOf(THANDLE)); //????skip empty number and non-duplicates
+ inc(handles,4); //????skip empty number and non-duplicates
+ if handles>MaxHandle then break; //file not found
+ end;
+ inc(i,4);
+//!! inc(i,SizeOf(THANDLE));
+ if i>handles then
+ break;
+ end;
+ end;
+
+ CloseHandle(pid);
+ if harcnt>0 then
+ begin
+ CheckHandles((flags and gffdOld)=0);
+ result:=TranslatePath(hold[0]);
+ end
+end;
+
+procedure ClearHandles;
+begin
+ while oldcnt>0 do
+ begin
+ dec(oldcnt);
+ FreeMem(hold[oldcnt]);
+ end;
+end;
+
+initialization
+finalization
+ ClearHandles;
+end.
diff --git a/plugins/Utils.pas/tb_chunk.inc b/plugins/Utils.pas/tb_chunk.inc new file mode 100644 index 0000000000..e3fa2ac068 --- /dev/null +++ b/plugins/Utils.pas/tb_chunk.inc @@ -0,0 +1,640 @@ +{Text Chunk processing: frame text output}
+
+const
+ colors:array [0..15] of dword = (
+ $00FFFFFF,$00000000,$007F0000,$00009300,
+ $000000FF,$0000007F,$009C009C,$00007FFC,
+ $0000FFFF,$0000FC00,$00939300,$00FFFF00,
+ $00FC0000,$00FF00FF,$007F7F7F,$00D2D2D2
+ );
+
+const // chunk type
+ CT_TEXT = $01;
+ CT_TAB = $09;
+ CT_SPACE = $20;
+ CT_NEWLINE = $0D;
+
+const // macro codes
+ ctOpenBold = $0001;
+ ctCloseBold = $0002;
+ ctOpenItalic = $0004;
+ ctCloseItalic = $0008;
+ ctOpenUnderline = $0010;
+ ctCloseUnderline = $0020;
+ ctOpenTextColor = $0040;
+ ctCloseTextColor = $0080;
+ ctOpenBkColor = $0100;
+ ctCloseBkColor = $0200;
+ ctRGB = $1000; // special code for RGB color values
+
+ ctFontChanging =
+ ctOpenBold or ctCloseBold or
+ ctOpenItalic or ctCloseItalic or
+ ctOpenUnderline or ctCloseUnderline;
+
+procedure ProcessMacro(dc:hdc;Chunk:pChunk);
+var
+ lf:TLOGFONT;
+ i:integer;
+begin
+ if dc=0 then
+ exit;
+ if Chunk._Type=CT_NEWLINE then
+ exit;
+
+ case Chunk^._type shr 16 of
+
+ ctCloseTextColor: begin
+ SetTextColor(dc,Chunk^.add);
+ end;
+
+ ctCloseBkColor: begin
+ SetBkColor(dc,Chunk^.add);
+ SetBkMode (dc,TRANSPARENT);
+ end;
+
+ ctOpenTextColor: begin
+ case Chunk^.val of
+ 0: i:=Chunk^.add; //back
+ 1..16: i:=colors[Chunk^.val-1];
+ else
+ i:=Chunk^.dir; // text
+ end;
+ SetTextColor(dc,i);
+ end;
+
+ ctOpenBkColor: begin
+ SetBkMode(dc,OPAQUE);
+ case Chunk^.val of
+ 0: i:=Chunk^.add; // back
+ 1..16: i:=colors[Chunk^.val-1];
+ else
+ i:=Chunk^.dir; // text
+ end;
+ SetBkColor(dc,i);
+ end;
+
+ ctOpenTextColor or ctRGB: begin
+ SetTextColor(dc,Chunk^.val);
+ end;
+
+ ctOpenBkColor or ctRGB: begin
+ SetBkMode(dc,OPAQUE);
+ SetBkColor(dc,Chunk^.val);
+ end;
+
+ else
+ begin
+ GetObject(GetCurrentObject(dc,OBJ_FONT),SizeOf(lf),@lf);
+ case Chunk^._type shr 16 of
+ ctOpenBold : lf.lfWeight :=FW_BOLD;
+ ctCloseBold : lf.lfWeight :=FW_NORMAL;
+ ctOpenItalic : lf.lfItalic :=1;
+ ctCloseItalic : lf.lfItalic :=0;
+ ctOpenUnderline : lf.lfUnderline:=1;
+ ctCloseUnderline: lf.lfUnderline:=0;
+ end;
+ DeleteObject(SelectObject(dc,CreateFontIndirect(lf)));
+ end;
+ end;
+end;
+
+function Macro(var src:pWideChar;var Chunk:pChunk;TextColor,BkColor:TCOLORREF):boolean;
+const
+ NumMacro = 10;
+ macros:array [0..NumMacro-1] of record txt:pWideChar; len:integer; code:integer; end = (
+ (txt:'{b}' ; len:3; code:ctOpenBold ),
+ (txt:'{/b}' ; len:4; code:ctCloseBold ),
+ (txt:'{i}' ; len:3; code:ctOpenItalic ),
+ (txt:'{/i}' ; len:4; code:ctCloseItalic ),
+ (txt:'{u}' ; len:3; code:ctOpenUnderline ),
+ (txt:'{/u}' ; len:4; code:ctCloseUnderline),
+ (txt:'{/cf}'; len:5; code:ctCloseTextColor),
+ (txt:'{/bg}'; len:5; code:ctCloseBkColor ),
+ (txt:'{cf' ; len:3; code:ctOpenTextColor ),
+ (txt:'{bg' ; len:3; code:ctOpenBkColor ));
+var
+ pc,pc1:pWideChar;
+ typ,i,lval,ldir,ladd:integer;
+ c:WideChar;
+begin
+ result:=false;
+ if src^<>'{' then exit;
+ pc:=src;
+ lval:=0;
+ ldir:=ppLeft;
+ ladd:=0;
+ typ :=0;
+ for i:=0 to NumMacro-1 do
+ begin
+ if StrCmpW(pc,macros[i].txt,macros[i].len)=0 then
+ begin
+ typ:=macros[i].code;
+ case typ of
+ ctOpenBkColor,
+ ctOpenTextColor: begin
+ inc(pc,macros[i].len);
+ if (pc^='#') or ((pc^>='0') and (pc^<='9')) then
+ begin
+ pc1:=pc;
+ if pc^='#' then
+ repeat
+ inc(pc1);
+ c:=pc1^;
+ until ((c<'0') or (c>'9')) and
+ ((c<'A') or (c>'F')) and
+ ((c<'a') or (c>'f'))
+ else
+ repeat
+ inc(pc1);
+ until (pc1^<'0') or (pc1^>'9');
+ if pc1^='}' then
+ begin
+ result:=true;
+ ldir:=TextColor;
+ ladd:=BkColor;
+ if (pc^='#') then // RGB
+ begin
+ typ:=typ or ctRGB;
+ lval:=HexToInt(pc+1);
+ end
+ else
+ begin
+ lval:=StrToInt(pc) mod 18;
+ end;
+ src:=pc1+1;
+ end;
+ end;
+ end;
+
+ ctCloseTextColor: begin
+ ladd:=TextColor;
+ inc(src,macros[i].len);
+ result:=true;
+ end;
+
+ ctCloseBkColor: begin
+ ladd:=BkColor;
+ inc(src,macros[i].len);
+ result:=true;
+ end;
+ else
+ inc(src,macros[i].len);
+ result:=true;
+ end;
+(*
+ if (typ=ctOpenBkColor) or (typ=ctOpenTextColor) then // processing color codes
+ begin
+ inc(pc,macros[i].len);
+ if (pc^='#') or ((pc^>='0') and (pc^<='9')) then
+ begin
+ pc1:=pc;
+ if pc^='#' then
+ repeat
+ inc(pc1);
+ c:=pc1^;
+ until ((c<'0') or (c>'9')) and
+ ((c<'A') or (c>'F')) and
+ ((c<'a') or (c>'f'))
+ else
+ repeat
+ inc(pc1);
+ until (pc1^<'0') or (pc1^>'9');
+ if pc1^='}' then
+ begin
+ result:=true;
+ if (pc^='#') then // RGB
+ begin
+ typ:=typ or ctRGB;
+ lval:=HexToInt(pc+1);
+ end
+ else
+ begin
+ lval:=StrToInt(pc) mod 18;
+ end;
+ src:=pc1+1;
+ end;
+ end;
+ end
+ else
+ begin
+ inc(src,macros[i].len);
+ result:=true;
+ end;
+*)
+ break;
+ end;
+ end;
+ if result then
+ begin
+ with Chunk^ do
+ begin
+ _type:=typ shl 16;
+ val :=lval;
+ dir :=ldir;
+ add :=ladd;
+ end;
+ inc(Chunk);
+ end;
+end;
+
+function CreateTextChunk(var Chunk:pChunk;src:pWideChar):pWideChar;
+var
+ i:integer;
+begin
+ result:=src;
+ while ((result^>='A') and (result^<='Z')) or
+ ((result^>='a') and (result^<='z')) or
+ ((result^>='0') and (result^<='9')) or
+ (ORD(result^)>127) do
+ inc(result);
+ i:=result-src;
+ if i>0 then // if no text (but what is this then?)
+ begin
+ with Chunk^ do
+ begin
+ _type:=CT_TEXT;
+ dir :=ppLeft;
+ txt :=src;
+ val :=i;
+ end;
+ inc(Chunk);
+ end;
+end;
+
+function CreateSignChunk(var Chunk:pChunk;src:PWideChar):PWideChar;
+begin
+ with Chunk^ do
+ begin
+ _type:=ord(src^);
+ add :=0;
+ dir :=ppLeft;
+ val :=1;
+ end;
+ result:=src;
+ inc(result);
+ inc(Chunk);
+end;
+
+procedure MeasureChunk(dc:HDC;Chunk:pChunk;var sz:TSIZE;block:Boolean);
+var
+ p:pWideChar;
+begin
+ if ((Chunk^._type shr 16)=0) and (Chunk^._type<>CT_NEWLINE) then
+ begin
+ if Chunk^._type=CT_TEXT then
+ p:=Chunk^.txt
+ else
+ begin
+ p:=PWideChar(@Chunk^._type);
+ end;
+ GetTextExtentPoint32W(dc,p,Chunk^.val,sz);
+ end
+ else
+ begin
+ if block and ((Chunk._type and ctFontChanging)<>0) then
+ ProcessMacro(dc,Chunk);
+ sz.cx:=0;
+ sz.cy:=0;
+ end;
+end;
+
+procedure MeasureLine(dc:HDC;Chunk:pChunk;var sz:TSIZE;limit:integer=4096);
+var
+ csz:TSIZE;
+// fnt1:HFONT;
+ lf:TLOGFONT;
+ txtcolor,bkcolor:COLORREF;
+ bkmode:integer;
+begin
+ sz.cx:=0;
+ sz.cy:=0;
+{
+ fnt1:=SelectObject(dc,CreateFontIndirect(FrameLF));
+
+ DeleteObject(SelectObject(dc,fnt1));
+}
+ txtcolor:=GetTextColor(dc);
+ bkcolor :=GetBkColor(dc);
+ bkmode :=GetBkMode(dc);
+ GetObject(GetCurrentObject(dc,OBJ_FONT),SizeOf(lf),@lf);
+
+ while (Chunk^._type<>0) and (Chunk^._type<>CT_NEWLINE) do
+ begin
+ MeasureChunk(dc,Chunk,csz,true);
+ if (sz.cx+csz.cx)<limit then
+ begin
+ inc(sz.cx,csz.cx);
+ if sz.cy<csz.cy then
+ sz.cy:=csz.cy;
+ end
+//!!
+ else if limit<>4096 then
+ break;
+ inc(Chunk);
+ end;
+
+ DeleteObject(SelectObject(dc,CreateFontIndirect(lf)));
+ SetTextColor(dc,txtcolor);
+ SetBkColor (dc,bkcolor);
+ SetBkMode (dc,bkmode);
+end;
+
+procedure DrawChunk(dc:HDC;Chunk:pChunk;rc:TRECT);
+var
+ p:pWideChar;
+begin
+ if (Chunk^._type shr 16)=0 then
+ begin
+ if Chunk^._type=CT_TEXT then
+ p:=Chunk^.txt
+ else
+ p:=PWideChar(@Chunk^._type);
+
+ DrawTextW(dc,p,Chunk^.val,rc,
+ DT_LEFT or DT_TOP or DT_SINGLELINE or DT_NOPREFIX or DT_EXPANDTABS)
+ end
+ else
+ ProcessMacro(dc,Chunk); //!! textcolor, bkcolor
+end;
+
+procedure DrawLine(dc:HDC;var Chunk:pChunk;rc:TRECT);
+var
+ sz:TSIZE;
+begin
+ while (Chunk^._type<>0) and (Chunk^._type<>CT_NEWLINE) do
+ begin
+ MeasureChunk(dc,Chunk,sz,false);
+ if (rc.left<rc.right) and ((rc.left+sz.cx)>0) then
+ DrawChunk(dc,Chunk,rc)
+ else if (Chunk^._type shr 16)<>0 then
+ ProcessMacro(dc,Chunk); //!! textcolor, bkcolor
+ inc(rc.left,sz.cx);
+ inc(Chunk);
+ end;
+end;
+
+procedure tTextBlock.DrawLines(dc:HDC;Chunk:pChunk;rc:TRECT;justpaint:boolean);
+var
+ sz:TSIZE;
+ rc1:TRECT;
+ w:integer;
+ rgn:HRGN;
+ ch:pChunk;
+ D:pTextData;
+begin
+ D:=pTextData(CustomData);
+// InflateRect(rc,-10,-3);
+ rgn:=CreateRectRgnIndirect(rc);
+ CopyRect(rc1,rc);
+ SelectClipRgn(dc,rgn);
+ w:=rc.Right-rc.left;
+ while Chunk^._type<>0 do
+ begin
+ MeasureLine(dc,Chunk,sz);
+ if sz.cx>0 then
+ begin
+ rc1.left:=rc.left;
+ if sz.cx<w then
+ begin
+ //!!
+ rc1.top:=rc.top;
+ if (D.TextEffect and effCenter)<>0 then
+ inc(rc1.left,(w-sz.cx) div 2);
+
+ DrawLine(dc,Chunk,rc1)
+ end
+ else
+ begin
+ rc1.top:=rc.top;
+ if Lo(D.TextEffect)=effRoll then
+ begin
+// direction!!
+// sz - linesize ; w - frame width, chunk^add = chunk size
+ inc(sz.cx,D.RollGap);
+ rc1.left:=rc.left-Chunk^.add;
+ if (sz.cx-Chunk^.add)<w then
+ begin
+ ch:=Chunk;
+ DrawLine(dc,ch,rc1);
+ rc1.left:=rc1.left+sz.cx;
+ end;
+ if not justpaint then
+ begin
+ inc(Chunk^.add,D.RollStep);
+ if Chunk^.add>=sz.cx then
+ Chunk^.add:=0;
+ end;
+{
+ inc(sz.cx,RollGap);
+ rc1.left:=rc.left-Chunk^.add;
+ if (sz.cx-Chunk^.add)<w then
+ begin
+ ch:=Chunk;
+ DrawLine(dc,ch,rc1);
+ rc1.left:=rc1.left+sz.cx;
+ end;
+ if not justpaint then
+ begin
+ inc(Chunk^.add,RollStep);
+ if Chunk^.add>=sz.cx then
+ Chunk^.add:=0;
+ end;
+}
+ end
+ else
+ begin
+ if not justpaint then
+ begin
+ if Chunk^.dir=ppLeft then
+ begin
+ inc(Chunk^.add,D.RollStep);
+ if (sz.cx-Chunk^.add)<(w-D.RollGap) then
+ begin
+ Chunk^.dir:=ppRight;
+ end;
+ end
+ else
+ begin
+ dec(Chunk^.add,D.RollStep);
+ if Chunk^.add<=-D.RollGap then
+ begin
+ Chunk^.dir:=ppLeft;
+ end;
+ end;
+ end;
+ rc1.left:=rc.left-Chunk^.add;
+ end;
+ DrawLine(dc,Chunk,rc1) // with offset
+ end;
+ end
+ else
+ DrawChunk(dc,Chunk,rc1);
+ inc(rc.top,sz.cy);
+
+ if rc.top>rc.bottom then
+ break;
+ if Chunk^._type<>0 then
+ inc(Chunk);
+ end;
+ SelectClipRgn(dc,0);
+ DeleteObject(rgn);
+end;
+
+procedure tTextBlock.DrawChunks(dc:HDC;Chunk:pChunk;rc:TRECT;justpaint:boolean);
+var
+ sz:TSIZE;
+ rc1:TRECT;
+ h:integer;
+ w:integer;
+ D:pTextData;
+begin
+ D:=pTextData(CustomData);
+
+ SetBkMode(dc,Windows.TRANSPARENT);
+ case Lo(D.TextEffect) of
+ effRoll,effPong: begin
+ DrawLines(dc,Chunk,rc,justpaint);
+ end;
+ else
+ CopyRect(rc1,rc);
+ w:=rc.right-rc.left;
+ h:=0;
+ //!!
+ if (D.TextEffect and effCenter)<>0 then
+ begin
+ MeasureLine(dc,Chunk,sz,w);
+ inc(rc1.left,(w-sz.cx) div 2);
+ end;
+ while Chunk^._type<>0 do
+ begin
+ MeasureChunk(dc,Chunk,sz,false);
+ if sz.cx>0 then
+ begin
+ rc1.right:=rc1.left+sz.cx;
+ if rc1.right>rc.right then //!!!
+ begin
+ case Lo(D.TextEffect) of
+ effCut: begin
+
+ if rc1.left<rc.right then
+ begin
+ rc1.right:=rc.right;
+ DrawChunk(dc,Chunk,rc1);
+ end;
+
+ inc(Chunk);
+ inc(rc1.left,sz.cx);
+ continue;
+ end;
+
+ effWrap: begin
+ if sz.cx>=w then
+ begin
+ while (Chunk<>nil) and (Chunk^._type<>CT_NEWLINE) do
+ begin
+ if (Chunk^._type shr 16)<>0 then
+ ProcessMacro(dc,Chunk); //!! textcolor, bkcolor
+ inc(Chunk);
+ end;
+ if Chunk=nil then
+ exit;
+ end;
+ inc(rc1.top,h);
+ rc1.left:=rc.left;
+ //!!
+ if (D.TextEffect and effCenter)<>0 then
+ begin
+ MeasureLine(dc,Chunk,sz,w);
+ inc(rc1.left,(w-sz.cx) div 2);
+ continue;
+ end;
+ end;
+ end;
+ end;
+ rc1.bottom:=rc1.top+sz.cy;
+ if rc1.bottom>rc.bottom then
+ begin
+ break;
+ end;
+ DrawChunk(dc,Chunk,rc1);
+ inc(rc1.left,sz.cx);
+ if h<sz.cy then
+ h:=sz.cy;
+ end
+ else
+ begin
+ if Chunk^._type=CT_NEWLINE then
+ begin
+ inc(rc1.top,h);
+ rc1.left:=rc.left;
+ //!!
+ if (D.TextEffect and effCenter)<>0 then
+ begin
+ inc(Chunk);
+ MeasureLine(dc,Chunk,sz,w);
+ // if sz.cx<w then
+ inc(rc1.left,(w-sz.cx) div 2);
+ continue;
+ end;
+ end
+ else
+ ProcessMacro(dc,Chunk); //!! textcolor, bkcolor
+ // DrawChunk(dc,Chunk,rc1);
+ end;
+ inc(Chunk);
+ end;
+ end;
+end;
+
+function tTextBlock.Split(src:pWideChar):pChunkArray;
+var
+ Chunk:pChunk;
+ i:integer;
+begin
+ result:=nil;
+ if (src=nil) or (src^=#0) then exit;
+
+ i:=(StrLenW(src)+1)*SizeOf(tChunk); // last = 0 (powered finalization)
+ GetMem(result,i);
+ FillChar(result^,i,0);
+ Chunk:=@result[0];
+
+ while src^<>#0 do
+ begin
+ // signes
+ while not (((src^>='A') and (src^<='Z')) or
+ ((src^>='a') and (src^<='z')) or
+ ((src^>='0') and (src^<='9'))) do
+ begin
+ if (ORD(src^)>127) or (src^='{') then
+ break;
+ if src^<>#10 then
+ src:=CreateSignChunk(Chunk,src)
+ else
+ inc(src);
+ if src^=#0 then exit;
+ end;
+ // [b][/b][i][/i][u][/u][cf][/cf][bg][/bg]
+ if Macro(src,Chunk,pTextData(CustomData).TextColor,pTextData(CustomData).BkColor) then
+ begin
+ end
+ // "{" sign
+ else if src^='{' then // if not macro
+ begin
+ src:=CreateSignChunk(Chunk,src);
+ end
+ // Unicode/text
+ else
+ begin
+ src:=CreateTextChunk(Chunk,src);
+ end;
+ end;
+end;
+
+procedure DeleteChunks(var Chunk:pChunkArray);
+begin
+ if Chunk<>nil then
+ FreeMem(Chunk);
+ Chunk:=nil;
+end;
diff --git a/plugins/Utils.pas/utils.pas b/plugins/Utils.pas/utils.pas new file mode 100644 index 0000000000..8c16e03f81 --- /dev/null +++ b/plugins/Utils.pas/utils.pas @@ -0,0 +1,44 @@ +unit Utils;
+
+interface
+
+uses windows;
+
+function SaveTemporaryW(ptr:pointer;size:dword;ext:PWideChar=nil):pWideChar;
+function SaveTemporary (ptr:pointer;size:dword;ext:PAnsiChar=nil):PAnsiChar;
+
+implementation
+
+uses common,io;
+
+function SaveTemporaryW(ptr:pointer;size:dword;ext:PWideChar=nil):pWideChar;
+var
+ buf,buf1:array [0..MAX_PATH-1] of WideChar;
+ f:THANDLE;
+begin
+ GetTempPathW(MAX_PATH,buf);
+ GetTempFileNameW(buf,'wat',GetCurrentTime,buf1);
+ ChangeExtW(buf1,ext);
+
+ f:=ReWrite(buf1);
+ BlockWrite(f,pByte(ptr)^,size);
+ CloseHandle(f);
+ StrDupW(result,buf1);
+end;
+
+function SaveTemporary(ptr:pointer;size:dword;ext:PAnsiChar=nil):PAnsiChar;
+var
+ buf,buf1:array [0..MAX_PATH-1] of AnsiChar;
+ f:THANDLE;
+begin
+ GetTempPathA(SizeOf(buf),buf);
+ GetTempFileNameA(buf,'wat',GetCurrentTime,buf1);
+ ChangeExt(buf1,ext);
+
+ f:=ReWrite(buf1);
+ BlockWrite(f,pByte(ptr)^,size);
+ CloseHandle(f);
+ StrDup(result,buf1);
+end;
+
+end.
\ No newline at end of file diff --git a/plugins/Utils.pas/wrapdlgs.pas b/plugins/Utils.pas/wrapdlgs.pas new file mode 100644 index 0000000000..fed2490f85 --- /dev/null +++ b/plugins/Utils.pas/wrapdlgs.pas @@ -0,0 +1,130 @@ +{$include compilers.inc}
+unit wrapdlgs;
+
+interface
+
+uses Windows;
+
+function SelectDirectory(Caption:PAnsiChar;var Directory:PAnsiChar;
+ Parent:HWND=0):Boolean; overload;
+function SelectDirectory(Caption:PWideChar;var Directory:PWideChar;
+ Parent:HWND=0):Boolean; overload;
+
+implementation
+
+uses common, messages;
+
+type
+ PSHItemID = ^TSHItemID;
+ TSHItemID = packed record
+ cb: Word; { Size of the ID (including cb itself) }
+ abID: array[0..0] of Byte; { The item ID (variable length) }
+ end;
+
+ PItemIDList = ^TItemIDList;
+ TItemIDList = record
+ mkid: TSHItemID;
+ end;
+
+ TBrowseInfoA = record
+ hwndOwner: HWND;
+ pidlRoot: PItemIDList;
+ pszDisplayName: PAnsiChar; { Return display name of item selected. }
+ lpszTitle: PAnsiChar; { text to go in the banner over the tree. }
+ ulFlags: UINT; { Flags that control the return stuff }
+ lpfn: Pointer; //TFNBFFCallBack;
+ lParam: LPARAM; { extra info that's passed back in callbacks }
+ iImage: Integer; { output var: where to return the Image index. }
+ end;
+ TBrowseInfoW = record
+ hwndOwner: HWND;
+ pidlRoot: PItemIDList;
+ pszDisplayName: PWideChar; { Return display name of item selected. }
+ lpszTitle: PWideChar; { text to go in the banner over the tree. }
+ ulFlags: UINT; { Flags that control the return stuff }
+ lpfn: Pointer; //TFNBFFCallBack;
+ lParam: LPARAM; { extra info that's passed back in callbacks }
+ iImage: Integer; { output var: where to return the Image index. }
+ end;
+
+function SHBrowseForFolderA(var lpbi: TBrowseInfoA): PItemIDList; stdcall;
+ external 'shell32.dll' name 'SHBrowseForFolderA';
+function SHBrowseForFolderW(var lpbi: TBrowseInfoW): PItemIDList; stdcall;
+ external 'shell32.dll' name 'SHBrowseForFolderW';
+function SHGetPathFromIDListA(pidl: PItemIDList; pszPath: PAnsiChar): BOOL; stdcall;
+ external 'shell32.dll' name 'SHGetPathFromIDListA';
+function SHGetPathFromIDListW(pidl: PItemIDList; pszPath: PWideChar): BOOL; stdcall;
+ external 'shell32.dll' name 'SHGetPathFromIDListW';
+procedure CoTaskMemFree(pv: Pointer); stdcall; external 'ole32.dll'
+ name 'CoTaskMemFree';
+
+const
+ BIF_RETURNONLYFSDIRS = $0001; { For finding a folder to start document searching }
+ BIF_DONTGOBELOWDOMAIN = $0002; { For starting the Find Computer }
+ BIF_STATUSTEXT = $0004;
+ BIF_RETURNFSANCESTORS = $0008;
+ BIF_EDITBOX = $0010;
+ BIF_VALIDATE = $0020; { insist on valid result (or CANCEL) }
+ BIF_NEWDIALOGSTYLE = $0040; { Use the new dialog layout with the ability to resize }
+ { Caller needs to call OleInitialize() before using this API (c) JVCL }
+ BIF_BROWSEFORCOMPUTER = $1000; { Browsing for Computers. }
+ BIF_BROWSEFORPRINTER = $2000; { Browsing for Printers }
+ BIF_BROWSEINCLUDEFILES = $4000; { Browsing for Everything }
+
+ BFFM_INITIALIZED = 1;
+ BFFM_SELCHANGED = 2;
+
+ BFFM_SETSTATUSTEXT = WM_USER + 100;
+ BFFM_ENABLEOK = WM_USER + 101;
+ BFFM_SETSELECTION = WM_USER + 102;
+ BFFM_SETSELECTIONW = WM_USER + 103;
+
+function SelectDirectory(Caption:PAnsiChar;var Directory:PAnsiChar;Parent:HWND=0):Boolean;
+var
+ BrowseInfo:TBrowseInfoA;
+ Buffer:array [0..MAX_PATH-1] of AnsiChar;
+ ItemIDList:PItemIDList;
+begin
+ Result:=False;
+ FillChar(BrowseInfo,SizeOf(BrowseInfo),0);
+
+ BrowseInfo.hwndOwner :=Parent;
+ BrowseInfo.pszDisplayName:=@Buffer;
+ BrowseInfo.lpszTitle :=Caption;
+ BrowseInfo.ulFlags :=BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
+
+ ItemIDList:=ShBrowseForFolderA(BrowseInfo);
+ if ItemIDList<>nil then
+ begin
+ ShGetPathFromIDListA(ItemIDList,Buffer);
+ StrDup(Directory,Buffer);
+ CoTaskMemFree(ItemIDList);
+ result:=true;
+ end;
+end;
+
+function SelectDirectory(Caption:PWideChar;var Directory:PWideChar;Parent:HWND=0):Boolean;
+var
+ BrowseInfo:TBrowseInfoW;
+ Buffer:array [0..MAX_PATH-1] of WideChar;
+ ItemIDList:PItemIDList;
+begin
+ Result:=False;
+ FillChar(BrowseInfo,SizeOf(BrowseInfo),0);
+
+ BrowseInfo.hwndOwner :=Parent;
+ BrowseInfo.pszDisplayName:=@Buffer;
+ BrowseInfo.lpszTitle :=Caption;
+ BrowseInfo.ulFlags :=BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
+
+ ItemIDList:=ShBrowseForFolderW(BrowseInfo);
+ if ItemIDList<>nil then
+ begin
+ ShGetPathFromIDListW(ItemIDList,Buffer);
+ StrDupW(Directory,Buffer);
+ CoTaskMemFree(ItemIDList);
+ result:=true;
+ end;
+end;
+
+end.
diff --git a/plugins/Utils.pas/wrapper.pas b/plugins/Utils.pas/wrapper.pas new file mode 100644 index 0000000000..91f7b23b0b --- /dev/null +++ b/plugins/Utils.pas/wrapper.pas @@ -0,0 +1,513 @@ +{$include compilers.inc}
+unit wrapper;
+
+interface
+
+uses windows;
+
+function CreateHiddenWindow(proc:pointer=nil):HWND;
+
+function DoInitCommonControls(dwICC:DWORD):boolean;
+
+function GetScreenRect:TRect;
+procedure SnapToScreen(var rc:TRect;dx:integer=0;dy:integer=0{;
+ minw:integer=240;minh:integer=100});
+
+function GetDlgText(Dialog:HWND;idc:integer;getAnsi:boolean=false):pointer; overload;
+function GetDlgText(wnd:HWND;getAnsi:boolean=false):pointer; overload;
+
+function StringToGUID(const astr:PAnsiChar):TGUID; overload;
+function StringToGUID(const astr:PWideChar):TGUID; overload;
+
+// Comboboxes
+function CB_SelectData(cb:HWND;data:dword):lresult; overload;
+function CB_SelectData(Dialog:HWND;id:cardinal;data:dword):lresult; overload;
+function CB_GetData (cb:HWND;idx:integer=-1):lresult;
+function CB_AddStrData (cb:HWND;astr:pAnsiChar;data:integer=0;idx:integer=-1):HWND;
+function CB_AddStrDataW(cb:HWND;astr:pWideChar;data:integer=0;idx:integer=-1):HWND;
+
+// CommCtrl - ListView
+Procedure ListView_GetItemTextA(hwndLV:hwnd;i:WPARAM;iSubItem:integer;pszText:Pointer;cchTextMax:integer);
+Procedure ListView_GetItemTextW(hwndLV:hwnd;i:WPARAM;iSubItem:integer;pszText:Pointer;cchTextMax:integer);
+function LV_GetLParam (list:HWND;item:integer=-1):lresult;
+function LV_SetLParam (list:HWND;lParam:LPARAM;item:integer=-1):lresult;
+function LV_ItemAtPos(wnd:HWND;pt:TPOINT;var SubItem:dword):Integer; overload;
+function LV_ItemAtPos(wnd:HWND;x,y:integer;var SubItem:dword):Integer; overload;
+procedure LV_SetItem (handle:hwnd;str:PAnsiChar;item:integer;subitem:integer=0);
+procedure LV_SetItemW(handle:hwnd;str:PWideChar;item:integer;subitem:integer=0);
+function LV_MoveItem(list:hwnd;direction:integer;item:integer=-1):integer;
+function LV_GetColumnCount(list:HWND):lresult;
+function LV_CheckDirection(list:HWND):integer; // bit 0 - can move up, bit 1 - down
+
+// CommDLG - Dialogs
+function ShowDlg (dst:PAnsiChar;fname:PAnsiChar=nil;Filter:PAnsiChar=nil;open:boolean=true):boolean;
+function ShowDlgW(dst:PWideChar;fname:PWideChar=nil;Filter:PWideChar=nil;open:boolean=true):boolean;
+
+implementation
+
+uses messages,common,commctrl,commdlg;
+
+const
+ EmptyGUID:TGUID = '{00000000-0000-0000-0000-000000000000}';
+
+{$IFNDEF FPC}
+const
+ LVM_SORTITEMSEX = LVM_FIRST + 81;
+{$ENDIF}
+
+{$IFNDEF DELPHI_7_UP}
+const
+ SM_XVIRTUALSCREEN = 76;
+ SM_YVIRTUALSCREEN = 77;
+ SM_CXVIRTUALSCREEN = 78;
+ SM_CYVIRTUALSCREEN = 79;
+{$ENDIF}
+
+//----- Hidden Window functions -----
+const
+ HWND_MESSAGE = HWND(-3);
+const
+ hiddenwindow:HWND = 0;
+ hwndcount:integer=0;
+
+function HiddenWindProc(wnd:HWnd; msg:UINT;wParam:WPARAM;lParam:LPARAM):lresult; stdcall;
+begin
+ if msg=WM_CLOSE then
+ begin
+ dec(hwndcount);
+ if hwndcount>0 then // not all references gone
+ begin
+ result:=0;
+ exit
+ end
+ else
+ hiddenwindow:=0
+ end;
+
+ result:=DefWindowProcW(wnd,msg,wParam,lParam);
+end;
+
+function CreateHiddenWindow(proc:pointer=nil):HWND;
+begin
+ if proc=nil then
+ begin
+ if hiddenwindow<>0 then
+ begin
+ result:=hiddenwindow;
+ inc(hwndcount); // one reference more
+ end
+ else
+ begin
+ result:=CreateWindowExW(0,'STATIC',nil,0,
+ 1,1,1,1,HWND_MESSAGE,0,hInstance,nil);
+ if result<>0 then
+ SetWindowLongPtrW(result,GWL_WNDPROC,LONG_PTR(@HiddenWindProc));
+
+ hiddenwindow:=result;
+ end
+ end
+ else
+ begin
+ result:=CreateWindowExW(0,'STATIC',nil,0,
+ 1,1,1,1,HWND_MESSAGE,0,hInstance,nil);
+ if result<>0 then
+ SetWindowLongPtrW(result,GWL_WNDPROC,LONG_PTR(proc));
+ end;
+end;
+//----- End of hidden window functions -----
+
+function DoInitCommonControls(dwICC:DWORD):boolean;
+var
+ ICC: TInitCommonControlsEx;
+begin
+ if dwICC=0 then
+ dwICC:=ICC_STANDARD_CLASSES or ICC_WIN95_CLASSES;
+ ICC.dwSize:= Sizeof(ICC);
+ ICC.dwICC := dwICC;
+ result:=InitCommonControlsEx(ICC);
+end;
+
+function GetScreenRect:TRect;
+begin
+ result.left := GetSystemMetrics( SM_XVIRTUALSCREEN );
+ result.top := GetSystemMetrics( SM_YVIRTUALSCREEN );
+ result.right := GetSystemMetrics( SM_CXVIRTUALSCREEN ) + result.left;
+ result.bottom:= GetSystemMetrics( SM_CYVIRTUALSCREEN ) + result.top;
+end;
+
+procedure SnapToScreen(var rc:TRect;dx:integer=0;dy:integer=0{;
+ minw:integer=240;minh:integer=100});
+var
+ rect:TRect;
+begin
+ rect:=GetScreenRect;
+ if rc.right >rect.right then rc.right :=rect.right -dx;
+ if rc.bottom>rect.bottom then rc.bottom:=rect.bottom-dy;
+ if rc.left <rect.left then rc.left :=rect.left;
+ if rc.top <rect.top then rc.top :=rect.top;
+end;
+
+function GetDlgText(wnd:HWND;getAnsi:boolean=false):pointer;
+var
+ a:cardinal;
+begin
+ result:=nil;
+ if getAnsi then
+ begin
+ a:=SendMessageA(wnd,WM_GETTEXTLENGTH,0,0)+1;
+ if a>1 then
+ begin
+ mGetMem(PAnsiChar(result),a);
+ SendMessageA(wnd,WM_GETTEXT,a,lparam(result));
+ end;
+ end
+ else
+ begin
+ a:=SendMessageW(wnd,WM_GETTEXTLENGTH,0,0)+1;
+ if a>1 then
+ begin
+ mGetMem(pWideChar(result),a*SizeOf(WideChar));
+ SendMessageW(wnd,WM_GETTEXT,a,lparam(result));
+ end;
+ end;
+end;
+
+function GetDlgText(Dialog:HWND;idc:integer;getAnsi:boolean=false):pointer;
+begin
+ result:=GetDlgText(GetDlgItem(Dialog,idc),getAnsi);
+end;
+
+//----- Combobox functions -----
+
+function CB_SelectData(cb:HWND;data:dword):lresult; overload;
+var
+ i:integer;
+begin
+ result:=0;
+ for i:=0 to SendMessage(cb,CB_GETCOUNT,0,0)-1 do
+ begin
+ if data=dword(SendMessage(cb,CB_GETITEMDATA,i,0)) then
+ begin
+ result:=i;
+ break;
+ end;
+ end;
+ result:=SendMessage(cb,CB_SETCURSEL,result,0);
+end;
+
+function CB_SelectData(Dialog:HWND;id:cardinal;data:dword):lresult; overload;
+begin
+ result:=CB_SelectData(GetDlgItem(Dialog,id),data);
+end;
+
+function CB_GetData(cb:HWND;idx:integer=-1):lresult;
+begin
+ if idx<0 then
+ idx:=SendMessage(cb,CB_GETCURSEL,0,0);
+ if idx<0 then
+ result:=0
+ else
+ result:=SendMessage(cb,CB_GETITEMDATA,idx,0);
+end;
+
+function CB_AddStrData(cb:HWND;astr:pAnsiChar;data:integer=0;idx:integer=-1):HWND;
+begin
+ result:=cb;
+ if idx<0 then
+ idx:=SendMessageA(cb,CB_ADDSTRING,0,lparam(astr))
+ else
+ idx:=SendMessageA(cb,CB_INSERTSTRING,idx,lparam(astr));
+ SendMessageA(cb,CB_SETITEMDATA,idx,data);
+end;
+
+function CB_AddStrDataW(cb:HWND;astr:pWideChar;data:integer=0;idx:integer=-1):HWND;
+begin
+ result:=cb;
+ if idx<0 then
+ idx:=SendMessageW(cb,CB_ADDSTRING,0,lparam(astr))
+ else
+ idx:=SendMessageW(cb,CB_INSERTSTRING,idx,lparam(astr));
+ SendMessage(cb,CB_SETITEMDATA,idx,data);
+end;
+
+function StringToGUID(const astr:PAnsiChar):TGUID;
+var
+ i:integer;
+begin
+ result:=EmptyGUID;
+ if StrLen(astr)<>38 then exit;
+ result.D1:=HexToInt(PAnsiChar(@astr[01]),8);
+ result.D2:=HexToInt(PAnsiChar(@astr[10]),4);
+ result.D3:=HexToInt(PAnsiChar(@astr[15]),4);
+
+ result.D4[0]:=HexToInt(PAnsiChar(@astr[20]),2);
+ result.D4[1]:=HexToInt(PAnsiChar(@astr[22]),2);
+ for i:=2 to 7 do
+ begin
+ result.D4[i]:=HexToInt(PAnsiChar(@astr[21+i*2]),2);
+ end;
+end;
+
+function StringToGUID(const astr:PWideChar):TGUID;
+var
+ i:integer;
+begin
+ result:=EmptyGUID;
+ if StrLenW(astr)<>38 then exit;
+ result.D1:=HexToInt(pWideChar(@astr[01]),8);
+ result.D2:=HexToInt(pWideChar(@astr[10]),4);
+ result.D3:=HexToInt(pWideChar(@astr[15]),4);
+
+ result.D4[0]:=HexToInt(pWideChar(@astr[20]),2);
+ result.D4[1]:=HexToInt(pWideChar(@astr[22]),2);
+ for i:=2 to 7 do
+ begin
+ result.D4[i]:=HexToInt(pWideChar(@astr[21+i*2]),2);
+ end;
+end;
+
+//----- ListView functions -----
+
+Procedure ListView_GetItemTextA(hwndLV:hwnd;i:WPARAM;iSubItem:integer;pszText:Pointer;cchTextMax:integer);
+Var
+ lvi:LV_ITEMA;
+Begin
+ lvi.iSubItem :=iSubItem;
+ lvi.cchTextMax:=cchTextMax;
+ lvi.pszText :=pszText;
+ SendMessageA(hwndLV,LVM_GETITEMTEXT,i,LPARAM(@lvi));
+end;
+
+Procedure ListView_GetItemTextW(hwndLV:hwnd;i:WPARAM;iSubItem:integer;pszText:Pointer;cchTextMax:integer);
+Var
+ lvi:LV_ITEMW;
+Begin
+ lvi.iSubItem :=iSubItem;
+ lvi.cchTextMax:=cchTextMax;
+ lvi.pszText :=pszText;
+ SendMessageW(hwndLV,LVM_GETITEMTEXT,i,LPARAM(@lvi));
+end;
+
+procedure LV_SetItem(handle:hwnd;str:PAnsiChar;item:integer;subitem:integer=0);
+var
+ li:LV_ITEMA;
+begin
+// zeromemory(@li,sizeof(li));
+ li.mask :=LVIF_TEXT;
+ li.pszText :=str;
+ li.iItem :=item;
+ li.iSubItem:=subitem;
+ SendMessageA(handle,LVM_SETITEMA,0,lparam(@li));
+end;
+
+procedure LV_SetItemW(handle:hwnd;str:PWideChar;item:integer;subitem:integer=0);
+var
+ li:LV_ITEMW;
+begin
+// zeromemory(@li,sizeof(li));
+ li.mask :=LVIF_TEXT;
+ li.pszText :=str;
+ li.iItem :=item;
+ li.iSubItem:=subitem;
+ SendMessageW(handle,LVM_SETITEMW,0,lparam(@li));
+end;
+
+function LV_GetLParam(list:HWND;item:integer=-1):lresult;
+var
+ li:LV_ITEMW;
+begin
+ if item<0 then
+ begin
+ item:=SendMessage(list,LVM_GETNEXTITEM,-1,LVNI_FOCUSED);
+ if item<0 then
+ begin
+ result:=-1;
+ exit;
+ end;
+ end;
+ li.iItem :=item;
+ li.mask :=LVIF_PARAM;
+ li.iSubItem:=0;
+ SendMessageW(list,LVM_GETITEMW,0,lparam(@li));
+ result:=li.lParam;
+end;
+
+function LV_SetLParam(list:HWND;lParam:LPARAM;item:integer=-1):lresult;
+var
+ li:LV_ITEMW;
+begin
+ if item<0 then
+ begin
+ item:=SendMessage(list,LVM_GETNEXTITEM,-1,LVNI_FOCUSED);
+ if item<0 then
+ begin
+ result:=-1;
+ exit;
+ end;
+ end;
+ li.iItem :=item;
+ li.mask :=LVIF_PARAM;
+ li.lParam :=lParam;
+ li.iSubItem:=0;
+ SendMessageW(list,LVM_SETITEMW,0,windows.lparam(@li));
+ result:=lParam;
+end;
+
+function LV_ItemAtPos(wnd:HWND;Pt:TPOINT;var SubItem:dword):Integer;
+var
+ HTI:LV_HITTESTINFO;
+begin
+ HTI.pt.x := pt.X;
+ HTI.pt.y := pt.Y;
+ SendMessage(wnd,LVM_SUBITEMHITTEST,0,lparam(@HTI));
+ Result :=HTI.iItem;
+ if @SubItem<>nil then
+ SubItem:=HTI.iSubItem;
+end;
+
+function LV_ItemAtPos(wnd:HWND;x,y:integer;var SubItem:dword):Integer; overload;
+var
+ HTI:LV_HITTESTINFO;
+begin
+ HTI.pt.x := x;
+ HTI.pt.y := y;
+ SendMessage(wnd,LVM_SUBITEMHITTEST,0,lparam(@HTI));
+ Result :=HTI.iItem;
+ if @SubItem<>nil then
+ SubItem:=HTI.iSubItem;
+end;
+
+function LV_Compare(lParam1,lParam2,param:LPARAM):integer; stdcall;
+var
+ olditem,neibor:integer;
+begin
+ result:=lParam1-lParam2;
+ neibor :=hiword(param);
+ olditem:=loword(param);
+ if neibor>olditem then
+ begin
+ if (lParam1=olditem) and (lParam2<=neibor) then
+ result:=1;
+ end
+ else
+ begin
+ if (lParam2=olditem) and (lParam1>=neibor) then
+ result:=1;
+ end;
+end;
+
+function LV_MoveItem(list:hwnd;direction:integer;item:integer=-1):integer;
+begin
+ if ((direction>0) and (item=(SendMessage(list,LVM_GETITEMCOUNT,0,0)-1))) or
+ ((direction<0) and (item=0)) then
+ begin
+ result:=item;
+ exit;
+ end;
+
+ if item<0 then
+ item:=SendMessage(list,LVM_GETNEXTITEM,-1,LVNI_FOCUSED);
+ SendMessageW(list,LVM_SORTITEMSEX,wparam(item)+(wparam(item+direction) shl 16),lparam(@LV_Compare));
+ result:=item+direction;
+end;
+
+function LV_GetColumnCount(list:HWND):lresult;
+begin
+ result:=SendMessage(SendMessage(list,LVM_GETHEADER,0,0),HDM_GETITEMCOUNT,0,0);
+end;
+
+function LV_CheckDirection(list:HWND):integer;
+var
+ i,cnt{,selcnt}:integer;
+ stat,first,last,focus: integer;
+begin
+ first :=-1;
+ last :=-1;
+ focus :=-1;
+ cnt :=SendMessage(list,LVM_GETITEMCOUNT,0,0)-1;
+// selcnt:=SendMessage(list,LVM_GETSELECTEDCOUNT,0,0);
+ for i:=0 to cnt do
+ begin
+ stat:=SendMessage(list,LVM_GETITEMSTATE,i,LVIS_SELECTED or LVIS_FOCUSED);
+ if (stat and LVIS_SELECTED)<>0 then
+ begin
+ if (stat and LVIS_FOCUSED)<>0 then
+ focus:=i;
+ if first<0 then first:=i;
+ last:=i;
+ end;
+ end;
+ result:=0;
+ if focus<0 then
+ focus:=first;
+ if focus>=0 then
+ result:=result or ((focus+1) shl 16);
+ if first>0 then // at least one selected and not first
+ begin
+ result:=(result or 1){ or (first+1) shl 16};
+ end;
+ if (last>=0) and (last<cnt) then
+ result:=result or 2;
+end;
+
+//----- CommDlg procedures -----
+
+function ShowDlg(dst:PAnsiChar;fname:PAnsiChar=nil;Filter:PAnsiChar=nil;open:boolean=true):boolean;
+var
+ NameRec:OpenFileNameA;
+begin
+ FillChar(NameRec,SizeOf(NameRec),0);
+ with NameRec do
+ begin
+ LStructSize:=SizeOf(NameRec);
+ if fname=nil then
+ dst[0]:=#0
+ else if fname<>dst then
+ StrCopy(dst,fname);
+// lpstrInitialDir:=dst;
+ if Filter<>nil then
+ begin
+ lpstrDefExt:=StrEnd(Filter)+1;
+ inc(lpstrDefExt,2); // skip "*."
+ end;
+ lpStrFile :=dst;
+ lpStrFilter:=Filter;
+ NMaxFile :=511;
+ Flags :=OFN_EXPLORER or OFN_OVERWRITEPROMPT;// or OFN_HIDEREADONLY;
+ end;
+ if open then
+ result:=GetOpenFileNameA({$IFDEF FPC}@{$ENDIF}NameRec)
+ else
+ result:=GetSaveFileNameA({$IFDEF FPC}@{$ENDIF}NameRec);
+end;
+
+function ShowDlgW(dst:PWideChar;fname:PWideChar=nil;Filter:PWideChar=nil;open:boolean=true):boolean;
+var
+ NameRec:OpenFileNameW;
+begin
+ FillChar(NameRec,SizeOf(NameRec),0);
+ with NameRec do
+ begin
+ LStructSize:=SizeOf(NameRec);
+ if fname=nil then
+ dst[0]:=#0
+ else if fname<>dst then
+ StrCopyW(dst,fname);
+// lpstrInitialDir:=dst;
+ if Filter<>nil then
+ begin
+ lpstrDefExt:=StrEndW(Filter)+1;
+ inc(lpstrDefExt,2); // skip "*."
+ end;
+ lpStrFile :=dst;
+ lpStrFilter:=Filter;
+ NMaxFile :=511;
+ Flags :=OFN_EXPLORER or OFN_OVERWRITEPROMPT;// or OFN_HIDEREADONLY;
+ end;
+ if open then
+ result:=GetOpenFileNameW({$IFDEF FPC}@{$ENDIF}NameRec)
+ else
+ result:=GetSaveFileNameW({$IFDEF FPC}@{$ENDIF}NameRec)
+end;
+
+end.
diff --git a/plugins/Utils.pas/zwrapper.pas b/plugins/Utils.pas/zwrapper.pas new file mode 100644 index 0000000000..7ccffafb14 --- /dev/null +++ b/plugins/Utils.pas/zwrapper.pas @@ -0,0 +1,58 @@ +unit zwrapper;
+
+interface
+
+function ZDecompressBuf(const inBuffer: Pointer; inSize: Integer; out outBuffer: Pointer; out outSize: Integer; outEstimate: Integer): Integer;
+
+implementation
+
+uses zlib;
+
+function ZDecompressBuf(const inBuffer: Pointer; inSize: Integer; out outBuffer: Pointer; out outSize: Integer; outEstimate: Integer): Integer;
+var
+ zstream : TZStreamRec;
+ delta : Integer;
+begin
+ FillChar(zstream, SizeOf(TZStreamRec), 0);
+
+ delta := (inSize + 255) and not 255;
+
+ if outEstimate = 0 then outSize := delta
+ else outSize := outEstimate;
+ Result := Z_OK;
+ GetMem(outBuffer, outSize);
+ try
+ zstream.next_in := inBuffer;
+ zstream.avail_in := inSize;
+ zstream.next_out := outBuffer;
+ zstream.avail_out := outSize;
+
+ Result := InflateInit(zstream);
+ if Result < 0 then Exit;
+
+ try
+ Result := inflate(zstream, Z_NO_FLUSH);
+ if Result < 0 then Exit;
+
+ while (Result <> Z_STREAM_END) do begin
+ Inc(outSize, delta);
+ ReallocMem(outBuffer, outSize);
+
+ zstream.next_out := {$IFDEF FPC}PBytef{$ENDIF}(pByte(outBuffer) + zstream.total_out);
+ zstream.avail_out := delta;
+ Result := inflate(zstream, Z_NO_FLUSH);
+ if Result < 0 then Exit;
+ end;
+ finally
+ inflateEnd(zstream);
+ end;
+
+ ReallocMem(outBuffer, zstream.total_out);
+ outSize := zstream.total_out;
+
+ finally
+ if Result < 0 then FreeMem(outBuffer);
+ end;
+end;
+
+end.
\ No newline at end of file |