From 9e0ca10baba2700d19bd3a3b81500b73bd4013d0 Mon Sep 17 00:00:00 2001 From: watcherhd Date: Sun, 15 May 2011 15:36:29 +0000 Subject: unneeded delphi folder removed git-svn-id: http://miranda-plugins.googlecode.com/svn/trunk@107 e753b5eb-9565-29b2-b5c5-2cc6f99dfbcb --- delphi/Awkward/utils/appcmdapi.pas | 97 -- delphi/Awkward/utils/base64.pas | 108 -- delphi/Awkward/utils/cbex.pas | 79 -- delphi/Awkward/utils/common.pas | 2116 ----------------------------------- delphi/Awkward/utils/compilers.inc | 735 ------------ delphi/Awkward/utils/dbsettings.pas | 421 ------- delphi/Awkward/utils/hotkeys.pas | 571 ---------- delphi/Awkward/utils/ini.pas | 857 -------------- delphi/Awkward/utils/io.pas | 249 ----- delphi/Awkward/utils/mirutils.pas | 1026 ----------------- delphi/Awkward/utils/playlist.pas | 431 ------- delphi/Awkward/utils/protocols.pas | 573 ---------- delphi/Awkward/utils/syswin.pas | 734 ------------ delphi/Awkward/utils/utils.pas | 44 - delphi/Awkward/utils/wrapper.pas | 450 -------- 15 files changed, 8491 deletions(-) delete mode 100644 delphi/Awkward/utils/appcmdapi.pas delete mode 100644 delphi/Awkward/utils/base64.pas delete mode 100644 delphi/Awkward/utils/cbex.pas delete mode 100644 delphi/Awkward/utils/common.pas delete mode 100644 delphi/Awkward/utils/compilers.inc delete mode 100644 delphi/Awkward/utils/dbsettings.pas delete mode 100644 delphi/Awkward/utils/hotkeys.pas delete mode 100644 delphi/Awkward/utils/ini.pas delete mode 100644 delphi/Awkward/utils/io.pas delete mode 100644 delphi/Awkward/utils/mirutils.pas delete mode 100644 delphi/Awkward/utils/playlist.pas delete mode 100644 delphi/Awkward/utils/protocols.pas delete mode 100644 delphi/Awkward/utils/syswin.pas delete mode 100644 delphi/Awkward/utils/utils.pas delete mode 100644 delphi/Awkward/utils/wrapper.pas (limited to 'delphi/Awkward/utils') diff --git a/delphi/Awkward/utils/appcmdapi.pas b/delphi/Awkward/utils/appcmdapi.pas deleted file mode 100644 index b316838..0000000 --- a/delphi/Awkward/utils/appcmdapi.pas +++ /dev/null @@ -1,97 +0,0 @@ -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/delphi/Awkward/utils/base64.pas b/delphi/Awkward/utils/base64.pas deleted file mode 100644 index 73ce09b..0000000 --- a/delphi/Awkward/utils/base64.pas +++ /dev/null @@ -1,108 +0,0 @@ -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; - ptr:=pbyte(src); - while ptr^<>0 do inc(ptr); - slen:=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/delphi/Awkward/utils/cbex.pas b/delphi/Awkward/utils/cbex.pas deleted file mode 100644 index b4f94c6..0000000 --- a/delphi/Awkward/utils/cbex.pas +++ /dev/null @@ -1,79 +0,0 @@ -unit CBEx; -interface - -uses windows,commctrl; - -// build combobox with xstatus icons and names - -function AddCBEx(wnd:HWND;proto:PAnsiChar):HWND; - -implementation - -uses messages,m_api,kol,common,mirutils; - -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(buf,proto); - StrCat (buf,PS_ICQ_GETCUSTOMSTATUSICON); - if PluginLink^.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(buf1,proto); - StrCat (buf1,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,dword(@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,dword(@ics)); - cbei.pszText:=TranslateW(@b); - end; - cbei.iItem :=cnt; - cbei.iImage :=cnt; - cbei.iSelectedImage:=cnt; - if SendMessageW(wnd,CBEM_INSERTITEMW,0,dword(@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. \ No newline at end of file diff --git a/delphi/Awkward/utils/common.pas b/delphi/Awkward/utils/common.pas deleted file mode 100644 index cdaabe3..0000000 --- a/delphi/Awkward/utils/common.pas +++ /dev/null @@ -1,2116 +0,0 @@ -{$DEFINE USE_MMI} -{$INCLUDE compilers.inc} -unit common; - -interface - -uses windows -{$IFDEF USE_MMI} -,m_api -{$ENDIF} -; - -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 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;ret1,ret2:string ):string; overload; -{$IFNDEF DELPHI7_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=dword(-1)):PWideChar; -function WidetoUTF8(src:PWideChar;var dst:PAnsiChar):PAnsiChar; - -function FastWideToAnsiBuf(src:PWideChar;dst:PAnsiChar;len:cardinal=dword(-1)):PAnsiChar; -function FastAnsiToWideBuf(src:PAnsiChar;dst:PWideChar;len:cardinal=dword(-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=$FFFFFFFF):integer; -function StrCmpW(a,b:PWideChar;n:cardinal=$FFFFFFFF):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 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; assembler; -function Min(a,b:integer):integer; -function Max(a,b:integer):integer; - -function Timestamp(Year,Month,Day:cardinal;Hour:cardinal=0;Min: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:dword ;Digits:integer=0):pWideChar; overload; -function IntToHex(dst:PAnsiChar;Value:dword ;Digits:integer=0):PAnsiChar; overload; -function IntToStr(dst:pWideChar;Value:integer;Digits:integer=0):pWideChar; overload; -function IntToStr(dst:PAnsiChar;Value:integer;Digits:integer=0):PAnsiChar; overload; -function StrToInt(src:pWideChar):integer; overload; -function StrToInt(src:PAnsiChar):integer; overload; -function HexToInt(src:pWideChar):integer; overload; -function HexToInt(src:PAnsiChar):integer; 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 - lSortProc = function (First,Second:integer):integer; - {0=equ; 1=1st>2nd; -1=1st<2nd } -procedure ShellSort(size:integer;Compare,Swap:lSortProc); - -function isPathAbsolute(path:pWideChar):boolean; overload; -function isPathAbsolute(path:PAnsiChar):boolean; overload; - -implementation - -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;ret1,ret2:string):string; overload; -begin - if cond then result:=ret1 else result:=ret2; -end; -{$IFNDEF DELPHI7_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); - GlobalFree(fh); - CloseClipboard; - end; -end; - -function PasteFromClipboard(ansi:boolean;cp:dword=CP_ACP):pointer; -var - p:pWideChar; - fh:tHandle; -begin - 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 UTF8toWide(src:PAnsiChar; var dst:PWideChar; len:cardinal=dword(-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; 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,eax // destination - mov ax,cx // value - mov ecx,edx // count - rep stosw - pop edi -end; - -// 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; -} -// 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; - -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 anil then - pointer(dst):=mmi.malloc(size) - else -{$ENDIF} - GetMem(pointer(dst),size); - result:=pointer(dst); -end; - -procedure mFreeMem(var ptr); -begin - if pointer(ptr)<>nil then - begin -{$IFDEF USE_MMI} - if @mmi.free<>nil then - mmi.free(pointer(ptr)) - else -{$ENDIF} - FreeMem(pointer(ptr)); - Pointer(ptr):=nil; - end; -end; - -function mReallocMem(var dst; size:integer):pointer; -begin -{$IFDEF USE_MMI} - if @mmi.malloc<>nil then - pointer(dst):=mmi.realloc(pointer(dst),size) - else -{$ENDIF} - ReallocMem(pointer(dst),size); - 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:lSortProc); -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 posi 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 posi 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=$FFFFFFFF):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; - while n>0 do - begin - result:=ord(a^)-ord(b^); - if (result<>0) or (a^=#0) then - break; - inc(a); - inc(b); - dec(n); - end; -end; - -function StrCmpW(a,b:PWideChar;n:cardinal=$FFFFFFFF):integer; -begin - result:=0; - if (a=nil) and (b=nil) then - exit; - if (a=nil) or (b=nil) then - begin - result:=-1; - exit; - end; - while n>0 do - begin - result:=ord(a^)-ord(b^); - if (result<>0) or (a^=#0) then - break; - inc(a); - inc(b); - dec(n); - end; -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 resultnil 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 resultnil 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 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,j:integer; -begin - i:=StrLen(s)-1; - j:=i; - while (i>=0) and ((s[i]<>'\') and (s[i]<>'/')) do dec(i); - if name then - begin - 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,j:integer; -begin - i:=StrLenW(s)-1; - j:=i; - while (i>=0) and ((s[i]<>'\') and (s[i]<>'/')) do dec(i); - if name then - begin - 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, Min, Sec: cardinal): TDateTime; -begin - result := (Hour*3600 + Min*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;Min:cardinal=0;Sec:cardinal=0):dword; -var - t:tDateTime; -begin - t := EncodeDate(Year, Month, Day); - if t >= 0 then - t := t + EncodeTime(Hour, Min, Sec) - else - t := t - EncodeTime(Hour, Min, 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,min,sec,len,i:integer; -begin - len:=StrLen(stime); - i:=0; - sec :=0; - min :=0; - hour:=0; - while i'9') then - begin - if min>0 then - hour:=min; - min:=sec; - sec:=0; - end - else - sec:=sec*10+ord(stime[i])-ord('0'); - inc(i); - end; - result:=hour*3600+min*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,min,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(min,(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^:=min[0]; inc(dst); - dst^:=min[1]; inc(dst); - end - else - begin - IntToStr(min,time div 60); - dst^:=min[0]; inc(dst); - if min[1]<>#0 then - begin - dst^:=min[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):integer; -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):integer; -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:integer;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:integer;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):integer; -begin - result:=0; - while src^<>#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); - end; -end; - -function HexToInt(src:PAnsiChar):integer; -begin - result:=0; - while src^<>#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); - end; -end; - -function IntToHex(dst:pWidechar;Value:dword;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:dword;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=dword(-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=dword(-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; - -begin - CheckSystem; -end. diff --git a/delphi/Awkward/utils/compilers.inc b/delphi/Awkward/utils/compilers.inc deleted file mode 100644 index af89289..0000000 --- a/delphi/Awkward/utils/compilers.inc +++ /dev/null @@ -1,735 +0,0 @@ -{$IFDEF VER210} // Delphi 2010 - {$DEFINE COMPILER13} - {$DEFINE VCL71} - {$DEFINE DELPHI13} - {$DEFINE DELPHI2010} - {$DEFINE BCB13} - {$DEFINE BCB2010} - {$DEFINE BDS7} - {$DEFINE BDS2010} -{$ENDIF} - -{$IFDEF VER200} - {$DEFINE COMPILER12} - {$DEFINE VCL71} - {$DEFINE DELPHI12} - {$DEFINE DELPHI2009} - {$DEFINE BCB12} - {$DEFINE BCB2009} - {$DEFINE BDS6} - {$DEFINE BDS2009} -{$ENDIF} - -{$IFDEF VER185} - {$DEFINE COMPILER11} - {$DEFINE VCL71} - {$DEFINE DELPHI11} - {$DEFINE DELPHI2007} - {$DEFINE BCB11} - {$DEFINE BCB2007} - {$DEFINE BDS5} - {$DEFINE BDS2007} - {$UNDEF VER180} -{$ENDIF} - -{$IFDEF VER180} - {$DEFINE COMPILER10} - {$DEFINE VCL71} - {$DEFINE DELPHI10} - {$DEFINE DELPHI2006} - {$DEFINE BCB10} - {$DEFINE BCB2006} - {$DEFINE BDS4} - {$DEFINE BDS2006} -{$ENDIF} - -{$IFDEF VER170} - {$DEFINE COMPILER9} - {$DEFINE VCL71} - {$DEFINE DELPHI9} - {$DEFINE DELPHI2005} - {$DEFINE BDS3} - {$DEFINE BDS2005} -{$ENDIF} - -{$IFDEF VER160} - {$DEFINE COMPILER8} - {$DEFINE VCL71} - {$DEFINE DELPHI8} - {$DEFINE BDS2} -{$ENDIF} - -{$IFDEF VER150} - {$DEFINE COMPILER7} - {$IFDEF LINUX} - {$DEFINE CLX10} - {$ELSE} - {$DEFINE VCL70} - {$DEFINE CLX10} - {$IFDEF BCB} - {$DEFINE BCB7} - {$ELSE} - {$DEFINE DELPHI7} - {$ENDIF} - {$ENDIF} -{$ENDIF} - -{$IFDEF VER140} - {$DEFINE COMPILER6} - {$IFDEF LINUX} - {$DEFINE CLX10} - {$IFDEF CONDITIONALEXPRESSIONS} - {$IFDEF CompilerVersion} - {.$IF System.RTLVersion = 14.1} - {.$DEFINE KYLIX2} - {.$IFEND} - {.$IF System.RTLVersion = 14.5} - {.$DEFINE KYLIX3} - {.$IFEND} - {$ELSE} - {$DEFINE KYLIX1} - {$ENDIF} - {$ENDIF} - {$ELSE} - {$DEFINE VCL60} - {$DEFINE CLX10} - {$IFDEF BCB} - {$DEFINE BCB6} - {$ELSE} - {$DEFINE DELPHI6} - {$ENDIF} - {$ENDIF} -{$ENDIF} - -{$IFDEF VER130} - {$DEFINE COMPILER5} - {$DEFINE VCL50} - {$IFDEF BCB} - {$DEFINE BCB5} - {$ELSE} - {$DEFINE DELPHI5} - {$ENDIF} -{$ENDIF} - -{$IFDEF VER125} - {$DEFINE COMPILER4} - {$DEFINE VCL40} - {$DEFINE BCB4} -{$ENDIF} - -{$IFDEF VER120} - {$DEFINE COMPILER4} - {$DEFINE VCL40} - {$DEFINE DELPHI4} -{$ENDIF} - -{$IFDEF VER110} - {$DEFINE COMPILER35} - {$DEFINE VCL30} - {$DEFINE BCB3} -{$ENDIF} - -{$IFDEF VER100} - {$DEFINE COMPILER3} - {$DEFINE VCL30} - {$DEFINE DELPHI3} -{$ENDIF} - -{$IFDEF VER93} - {$DEFINE COMPILER2} - {$DEFINE VCL20} - {$DEFINE BCB1} -{$ENDIF} - -{$IFDEF VER90} - {$DEFINE COMPILER2} - {$DEFINE VCL20} - {$DEFINE DELPHI2} -{$ENDIF} - -{$IFDEF VER80} - {$DEFINE COMPILER1} - {$DEFINE VCL10} - {$DEFINE DELPHI1} -{$ENDIF} - -// DELPHIX_UP from DELPHIX mappings - -{$IFDEF DELPHI13} - {$DEFINE DELPHI} - {$DEFINE DELPHI13_UP} - {$DEFINE DELPHI12_UP} - {$DEFINE DELPHI11_UP} - {$DEFINE DELPHI10_UP} - {$DEFINE DELPHI9_UP} - {$DEFINE DELPHI8_UP} - {$DEFINE DELPHI7_UP} - {$DEFINE DELPHI6_UP} - {$DEFINE DELPHI5_UP} - {$DEFINE DELPHI4_UP} - {$DEFINE DELPHI3_UP} - {$DEFINE DELPHI2_UP} - {$DEFINE DELPHI1_UP} -{$ENDIF} - -{$IFDEF DELPHI2010} - {$DEFINE DELPHI2010_UP} - {$DEFINE DELPHI2009_UP} - {$DEFINE DELPHI2007_UP} - {$DEFINE DELPHI2006_UP} - {$DEFINE DELPHI2005_UP} -{$ENDIF} - -{$IFDEF DELPHI12} - {$DEFINE DELPHI} - {$DEFINE DELPHI12_UP} - {$DEFINE DELPHI11_UP} - {$DEFINE DELPHI10_UP} - {$DEFINE DELPHI9_UP} - {$DEFINE DELPHI8_UP} - {$DEFINE DELPHI7_UP} - {$DEFINE DELPHI6_UP} - {$DEFINE DELPHI5_UP} - {$DEFINE DELPHI4_UP} - {$DEFINE DELPHI3_UP} - {$DEFINE DELPHI2_UP} - {$DEFINE DELPHI1_UP} -{$ENDIF} - -{$IFDEF DELPHI2009} - {$DEFINE DELPHI2009_UP} - {$DEFINE DELPHI2007_UP} - {$DEFINE DELPHI2006_UP} - {$DEFINE DELPHI2005_UP} -{$ENDIF} - -{$IFDEF DELPHI11} - {$DEFINE DELPHI} - {$DEFINE DELPHI11_UP} - {$DEFINE DELPHI10_UP} - {$DEFINE DELPHI9_UP} - {$DEFINE DELPHI8_UP} - {$DEFINE DELPHI7_UP} - {$DEFINE DELPHI6_UP} - {$DEFINE DELPHI5_UP} - {$DEFINE DELPHI4_UP} - {$DEFINE DELPHI3_UP} - {$DEFINE DELPHI2_UP} - {$DEFINE DELPHI1_UP} -{$ENDIF} - -{$IFDEF DELPHI2007} - {$DEFINE DELPHI2007_UP} - {$DEFINE DELPHI2006_UP} - {$DEFINE DELPHI2005_UP} -{$ENDIF} - -{$IFDEF DELPHI10} - {$DEFINE DELPHI} - {$DEFINE DELPHI10_UP} - {$DEFINE DELPHI9_UP} - {$DEFINE DELPHI8_UP} - {$DEFINE DELPHI7_UP} - {$DEFINE DELPHI6_UP} - {$DEFINE DELPHI5_UP} - {$DEFINE DELPHI4_UP} - {$DEFINE DELPHI3_UP} - {$DEFINE DELPHI2_UP} - {$DEFINE DELPHI1_UP} -{$ENDIF} - -{$IFDEF DELPHI2006} - {$DEFINE DELPHI2006_UP} - {$DEFINE DELPHI2005_UP} -{$ENDIF} - -{$IFDEF DELPHI9} - {$DEFINE DELPHI} - {$DEFINE DELPHI9_UP} - {$DEFINE DELPHI8_UP} - {$DEFINE DELPHI7_UP} - {$DEFINE DELPHI6_UP} - {$DEFINE DELPHI5_UP} - {$DEFINE DELPHI4_UP} - {$DEFINE DELPHI3_UP} - {$DEFINE DELPHI2_UP} - {$DEFINE DELPHI1_UP} -{$ENDIF} - -{$IFDEF DELPHI2005} - {$DEFINE DELPHI2005_UP} -{$ENDIF} - -{$IFDEF DELPHI8} - {$DEFINE DELPHI} - {$DEFINE DELPHI8_UP} - {$DEFINE DELPHI7_UP} - {$DEFINE DELPHI6_UP} - {$DEFINE DELPHI5_UP} - {$DEFINE DELPHI4_UP} - {$DEFINE DELPHI3_UP} - {$DEFINE DELPHI2_UP} - {$DEFINE DELPHI1_UP} -{$ENDIF} - -{$IFDEF DELPHI7} - {$DEFINE DELPHI} - {$DEFINE DELPHI7_UP} - {$DEFINE DELPHI6_UP} - {$DEFINE DELPHI5_UP} - {$DEFINE DELPHI4_UP} - {$DEFINE DELPHI3_UP} - {$DEFINE DELPHI2_UP} - {$DEFINE DELPHI1_UP} -{$ENDIF} - -{$IFDEF DELPHI6} - {$DEFINE DELPHI} - {$DEFINE DELPHI6_UP} - {$DEFINE DELPHI5_UP} - {$DEFINE DELPHI4_UP} - {$DEFINE DELPHI3_UP} - {$DEFINE DELPHI2_UP} - {$DEFINE DELPHI1_UP} -{$ENDIF} - -{$IFDEF DELPHI5} - {$DEFINE DELPHI} - {$DEFINE DELPHI5_UP} - {$DEFINE DELPHI4_UP} - {$DEFINE DELPHI3_UP} - {$DEFINE DELPHI2_UP} - {$DEFINE DELPHI1_UP} -{$ENDIF} - -{$IFDEF DELPHI4} - {$DEFINE DELPHI} - {$DEFINE DELPHI4_UP} - {$DEFINE DELPHI3_UP} - {$DEFINE DELPHI2_UP} - {$DEFINE DELPHI1_UP} -{$ENDIF} - -{$IFDEF DELPHI3} - {$DEFINE DELPHI} - {$DEFINE DELPHI3_UP} - {$DEFINE DELPHI2_UP} - {$DEFINE DELPHI1_UP} -{$ENDIF} - -{$IFDEF DELPHI2} - {$DEFINE DELPHI} - {$DEFINE DELPHI2_UP} - {$DEFINE DELPHI1_UP} -{$ENDIF} - -{$IFDEF DELPHI1} - {$DEFINE DELPHI} - {$DEFINE DELPHI1_UP} -{$ENDIF} - -// BCBX_UP from BCBX mappings - -{$IFDEF BCB12} - {$DEFINE BCB} - {$DEFINE BCB12_UP} - {$DEFINE BCB11_UP} - {$DEFINE BCB10_UP} - {$DEFINE BCB7_UP} - {$DEFINE BCB6_UP} - {$DEFINE BCB5_UP} - {$DEFINE BCB4_UP} - {$DEFINE BCB3_UP} - {$DEFINE BCB1_UP} -{$ENDIF} - -{$IFDEF BCB2008} - {$DEFINE BCB2008_UP} - {$DEFINE BCB2007_UP} - {$DEFINE BCB2006_UP} -{$ENDIF} - -{$IFDEF BCB11} - {$DEFINE BCB} - {$DEFINE BCB11_UP} - {$DEFINE BCB10_UP} - {$DEFINE BCB7_UP} - {$DEFINE BCB6_UP} - {$DEFINE BCB5_UP} - {$DEFINE BCB4_UP} - {$DEFINE BCB3_UP} - {$DEFINE BCB1_UP} -{$ENDIF} - -{$IFDEF BCB2007} - {$DEFINE BCB2007_UP} - {$DEFINE BCB2006_UP} -{$ENDIF} - -{$IFDEF BCB10} - {$DEFINE BCB} - {$DEFINE BCB10_UP} - {$DEFINE BCB7_UP} - {$DEFINE BCB6_UP} - {$DEFINE BCB5_UP} - {$DEFINE BCB4_UP} - {$DEFINE BCB3_UP} - {$DEFINE BCB1_UP} -{$ENDIF} - -{$IFDEF BCB2006} - {$DEFINE BCB2006_UP} -{$ENDIF} - -{$IFDEF BCB7} - {$DEFINE BCB} - {$DEFINE BCB7_UP} - {$DEFINE BCB6_UP} - {$DEFINE BCB5_UP} - {$DEFINE BCB4_UP} - {$DEFINE BCB3_UP} - {$DEFINE BCB1_UP} -{$ENDIF} - -{$IFDEF BCB6} - {$DEFINE BCB} - {$DEFINE BCB6_UP} - {$DEFINE BCB5_UP} - {$DEFINE BCB4_UP} - {$DEFINE BCB3_UP} - {$DEFINE BCB1_UP} -{$ENDIF} - -{$IFDEF BCB5} - {$DEFINE BCB} - {$DEFINE BCB5_UP} - {$DEFINE BCB4_UP} - {$DEFINE BCB3_UP} - {$DEFINE BCB1_UP} -{$ENDIF} - -{$IFDEF BCB4} - {$DEFINE BCB} - {$DEFINE BCB4_UP} - {$DEFINE BCB3_UP} - {$DEFINE BCB1_UP} -{$ENDIF} - -{$IFDEF BCB3} - {$DEFINE BCB} - {$DEFINE BCB3_UP} - {$DEFINE BCB1_UP} -{$ENDIF} - -{$IFDEF BCB1} - {$DEFINE BCB} - {$DEFINE BCB1_UP} -{$ENDIF} - -// KYLIXX_UP from KYLIXX mappings - -{$IFDEF KYLIX3} - {$DEFINE KYLIX} - {$DEFINE KYLIX3_UP} - {$DEFINE KYLIX2_UP} - {$DEFINE KYLIX1_UP} -{$ENDIF} - -{$IFDEF KYLIX2} - {$DEFINE KYLIX} - {$DEFINE KYLIX2_UP} - {$DEFINE KYLIX1_UP} -{$ENDIF} - -{$IFDEF KYLIX1} - {$DEFINE KYLIX} - {$DEFINE KYLIX1_UP} -{$ENDIF} - -// BDSXX_UP from BDSXX mappings - -{$IFDEF BDS6} - {$DEFINE BDS} - {$DEFINE BDS6_UP} - {$DEFINE BDS5_UP} - {$DEFINE BDS4_UP} - {$DEFINE BDS3_UP} - {$DEFINE BDS2_UP} - {$DEFINE BDS1_UP} -{$ENDIF} - -{$IFDEF BDS2008} - {$DEFINE BDS2008_UP} - {$DEFINE BDS2007_UP} - {$DEFINE BDS2006_UP} - {$DEFINE BDS2005_UP} -{$ENDIF} - -{$IFDEF BDS5} - {$DEFINE BDS} - {$DEFINE BDS5_UP} - {$DEFINE BDS4_UP} - {$DEFINE BDS3_UP} - {$DEFINE BDS2_UP} - {$DEFINE BDS1_UP} -{$ENDIF} - -{$IFDEF BDS2007} - {$DEFINE BDS2007_UP} - {$DEFINE BDS2006_UP} - {$DEFINE BDS2005_UP} -{$ENDIF} - -{$IFDEF BDS4} - {$DEFINE BDS} - {$DEFINE BDS4_UP} - {$DEFINE BDS3_UP} - {$DEFINE BDS2_UP} - {$DEFINE BDS1_UP} -{$ENDIF} - -{$IFDEF BDS2006} - {$DEFINE BDS2006_UP} - {$DEFINE BDS2005_UP} -{$ENDIF} - -{$IFDEF BDS3} - {$DEFINE BDS} - {$DEFINE BDS3_UP} - {$DEFINE BDS2_UP} - {$DEFINE BDS1_UP} -{$ENDIF} - -{$IFDEF BDS2005} - {$DEFINE BDS2005_UP} -{$ENDIF} - -{$IFDEF BDS2} - {$DEFINE BDS} - {$DEFINE BDS2_UP} - {$DEFINE BDS1_UP} -{$ENDIF} - -{$IFDEF BDS1} - {$DEFINE BDS} - {$DEFINE BDS1_UP} -{$ENDIF} - -// COMPILERX_UP from COMPILERX mappings - -{$IFDEF COMPILER12} - {$DEFINE COMPILER12_UP} - {$DEFINE COMPILER11_UP} - {$DEFINE COMPILER10_UP} - {$DEFINE COMPILER9_UP} - {$DEFINE COMPILER8_UP} - {$DEFINE COMPILER7_UP} - {$DEFINE COMPILER6_UP} - {$DEFINE COMPILER5_UP} - {$DEFINE COMPILER4_UP} - {$DEFINE COMPILER35_UP} - {$DEFINE COMPILER3_UP} - {$DEFINE COMPILER2_UP} - {$DEFINE COMPILER1_UP} -{$ENDIF} - -{$IFDEF COMPILER11} - {$DEFINE COMPILER11_UP} - {$DEFINE COMPILER10_UP} - {$DEFINE COMPILER9_UP} - {$DEFINE COMPILER8_UP} - {$DEFINE COMPILER7_UP} - {$DEFINE COMPILER6_UP} - {$DEFINE COMPILER5_UP} - {$DEFINE COMPILER4_UP} - {$DEFINE COMPILER35_UP} - {$DEFINE COMPILER3_UP} - {$DEFINE COMPILER2_UP} - {$DEFINE COMPILER1_UP} -{$ENDIF} - -{$IFDEF COMPILER10} - {$DEFINE COMPILER10_UP} - {$DEFINE COMPILER9_UP} - {$DEFINE COMPILER8_UP} - {$DEFINE COMPILER7_UP} - {$DEFINE COMPILER6_UP} - {$DEFINE COMPILER5_UP} - {$DEFINE COMPILER4_UP} - {$DEFINE COMPILER35_UP} - {$DEFINE COMPILER3_UP} - {$DEFINE COMPILER2_UP} - {$DEFINE COMPILER1_UP} -{$ENDIF} - -{$IFDEF COMPILER9} - {$DEFINE COMPILER9_UP} - {$DEFINE COMPILER8_UP} - {$DEFINE COMPILER7_UP} - {$DEFINE COMPILER6_UP} - {$DEFINE COMPILER5_UP} - {$DEFINE COMPILER4_UP} - {$DEFINE COMPILER35_UP} - {$DEFINE COMPILER3_UP} - {$DEFINE COMPILER2_UP} - {$DEFINE COMPILER1_UP} -{$ENDIF} - -{$IFDEF COMPILER8} - {$DEFINE COMPILER8_UP} - {$DEFINE COMPILER7_UP} - {$DEFINE COMPILER6_UP} - {$DEFINE COMPILER5_UP} - {$DEFINE COMPILER4_UP} - {$DEFINE COMPILER35_UP} - {$DEFINE COMPILER3_UP} - {$DEFINE COMPILER2_UP} - {$DEFINE COMPILER1_UP} -{$ENDIF} - -{$IFDEF COMPILER7} - {$DEFINE COMPILER7_UP} - {$DEFINE COMPILER6_UP} - {$DEFINE COMPILER5_UP} - {$DEFINE COMPILER4_UP} - {$DEFINE COMPILER35_UP} - {$DEFINE COMPILER3_UP} - {$DEFINE COMPILER2_UP} - {$DEFINE COMPILER1_UP} -{$ENDIF} - -{$IFDEF COMPILER6} - {$DEFINE COMPILER6_UP} - {$DEFINE COMPILER5_UP} - {$DEFINE COMPILER4_UP} - {$DEFINE COMPILER35_UP} - {$DEFINE COMPILER3_UP} - {$DEFINE COMPILER2_UP} - {$DEFINE COMPILER1_UP} -{$ENDIF} - -{$IFDEF COMPILER5} - {$DEFINE COMPILER5_UP} - {$DEFINE COMPILER4_UP} - {$DEFINE COMPILER35_UP} - {$DEFINE COMPILER3_UP} - {$DEFINE COMPILER2_UP} - {$DEFINE COMPILER1_UP} -{$ENDIF} - -{$IFDEF COMPILER4} - {$DEFINE COMPILER4_UP} - {$DEFINE COMPILER35_UP} - {$DEFINE COMPILER3_UP} - {$DEFINE COMPILER2_UP} - {$DEFINE COMPILER1_UP} -{$ENDIF} - -{$IFDEF COMPILER35} - {$DEFINE COMPILER35_UP} - {$DEFINE COMPILER3_UP} - {$DEFINE COMPILER2_UP} - {$DEFINE COMPILER1_UP} -{$ENDIF} - -{$IFDEF COMPILER3} - {$DEFINE COMPILER3_UP} - {$DEFINE COMPILER2_UP} - {$DEFINE COMPILER1_UP} -{$ENDIF} - -{$IFDEF COMPILER2} - {$DEFINE COMPILER2_UP} - {$DEFINE COMPILER1_UP} -{$ENDIF} - -{$IFDEF COMPILER1} - {$DEFINE COMPILER1_UP} -{$ENDIF} - -// VCLXX_UP from VCLXX mappings - -{$IFDEF VCL71} - {$DEFINE VCL71_UP} - {$DEFINE VCL70_UP} - {$DEFINE VCL60_UP} - {$DEFINE VCL50_UP} - {$DEFINE VCL40_UP} - {$DEFINE VCL30_UP} - {$DEFINE VCL20_UP} - {$DEFINE VCL10_UP} -{$ENDIF} - -{$IFDEF VCL70} - {$DEFINE VCL70_UP} - {$DEFINE VCL60_UP} - {$DEFINE VCL50_UP} - {$DEFINE VCL40_UP} - {$DEFINE VCL30_UP} - {$DEFINE VCL20_UP} - {$DEFINE VCL10_UP} -{$ENDIF} - -{$IFDEF VCL60} - {$DEFINE VCL60_UP} - {$DEFINE VCL50_UP} - {$DEFINE VCL40_UP} - {$DEFINE VCL30_UP} - {$DEFINE VCL20_UP} - {$DEFINE VCL10_UP} -{$ENDIF} - -{$IFDEF VCL50} - {$DEFINE VCL50_UP} - {$DEFINE VCL40_UP} - {$DEFINE VCL30_UP} - {$DEFINE VCL20_UP} - {$DEFINE VCL10_UP} -{$ENDIF} - -{$IFDEF VCL40} - {$DEFINE VCL40_UP} - {$DEFINE VCL30_UP} - {$DEFINE VCL20_UP} - {$DEFINE VCL10_UP} -{$ENDIF} - -{$IFDEF VCL30} - {$DEFINE VCL30_UP} - {$DEFINE VCL20_UP} - {$DEFINE VCL10_UP} -{$ENDIF} - -{$IFDEF VCL20} - {$DEFINE VCL20_UP} - {$DEFINE VCL10_UP} -{$ENDIF} - -{$IFDEF VCL10} - {$DEFINE VCL10_UP} -{$ENDIF} - -// CLXXX_UP from CLXXX mappings - -{$IFDEF CLX10} - {$DEFINE CLX10_UP} -{$ENDIF} - -//------------------------ - -{$ALIGN ON} -{$BOOLEVAL OFF} - -{$ifdef COMPILER_7_UP} - {$define THEME_7_UP} { Allows experimental theme support on pre-Delphi 7. } -{$endif} - -{$IFDEF COMPILER_6_UP} - {$WARN SYMBOL_PLATFORM OFF} { We are going to use Win32 specific symbols! } -{$ENDIF} - -{$IFDEF COMPILER_7_UP} - {$WARN UNSAFE_CODE OFF} { We are not going to be "safe"! } - {$WARN UNSAFE_TYPE OFF} - {$WARN UNSAFE_CAST OFF} -{$ENDIF} diff --git a/delphi/Awkward/utils/dbsettings.pas b/delphi/Awkward/utils/dbsettings.pas deleted file mode 100644 index 05482e6..0000000 --- a/delphi/Awkward/utils/dbsettings.pas +++ /dev/null @@ -1,421 +0,0 @@ -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):Integer; -function DBReadSettingStr(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;dbv:PDBVARIANT):Integer; - -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):Integer; -function DBWriteByte (hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;val:Byte ):Integer; -function DBWriteWord (hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;val:Word ):Integer; -function DBWriteDWord(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;val:dword):Integer; - -function DBWriteString (hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar; - val:PAnsiChar;enc:integer=DBVT_ASCIIZ):Integer; -function DBWriteUTF8 (hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;val:PAnsiChar):Integer; -function DBWriteUnicode(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;val:PWideChar):Integer; - -function DBFreeVariant(dbv:PDBVARIANT):integer; -function DBDeleteSetting(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar):Integer; -function DBDeleteGroup(hContact:THANDLE;szModule:PAnsiChar):integer; -function DBDeleteModule(szModule:PAnsiChar):integer; // 0.8.0+ - -function DBGetSettingType(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar):integer; - -implementation - -function DBReadByte(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;default:byte=0):byte; -var - dbv:TDBVARIANT; - cgs:TDBCONTACTGETSETTING; -begin - cgs.szModule :=szModule; - cgs.szSetting:=szSetting; - cgs.pValue :=@dbv; - If PluginLink^.CallService(MS_DB_CONTACT_GETSETTING,hContact,lParam(@cgs))<>0 then - Result:=default - else - Result:=dbv.bVal; -end; - -function DBReadWord(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;default:word=0):word; -var - dbv:TDBVARIANT; - cgs:TDBCONTACTGETSETTING; -begin - cgs.szModule :=szModule; - cgs.szSetting:=szSetting; - cgs.pValue :=@dbv; - If PluginLink^.CallService(MS_DB_CONTACT_GETSETTING,hContact,lParam(@cgs))<>0 then - Result:=default - else - Result:=dbv.wVal; -end; - -function DBReadDword(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;default:dword=0):dword; -var - dbv:TDBVARIANT; - cgs:TDBCONTACTGETSETTING; -begin - cgs.szModule :=szModule; - cgs.szSetting:=szSetting; - cgs.pValue :=@dbv; - If PluginLink^.CallService(MS_DB_CONTACT_GETSETTING,hContact,lParam(@cgs))<>0 then - Result:=default - else - Result:=dbv.dVal; -end; - -function DBReadSetting(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;dbv:PDBVARIANT):Integer; -var - cgs:TDBCONTACTGETSETTING; -begin - cgs.szModule :=szModule; - cgs.szSetting:=szSetting; - cgs.pValue :=dbv; - Result:=PluginLink^.CallService(MS_DB_CONTACT_GETSETTING,hContact,lParam(@cgs)); -end; - -function DBReadSettingStr(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;dbv:PDBVARIANT):Integer; -var - cgs:TDBCONTACTGETSETTING; -begin - cgs.szModule :=szModule; - cgs.szSetting:=szSetting; - cgs.pValue :=dbv; - Result:=PluginLink^.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:integer; -begin - cgs.szModule :=szModule; - cgs.szSetting:=szSetting; - cgs.pValue :=@dbv; - i:=PluginLink^.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:integer; -begin - cgs.szModule :=szModule; - cgs.szSetting:=szSetting; - cgs.pValue :=@dbv; - dbv._type :=enc; - i:=PluginLink^.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 - begin - result:=mmi.malloc(lstrlena(default)+1); - if result<>nil then - lstrcpya(result,default); - end; - 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:integer; -begin - cgs.szModule :=szModule; - cgs.szSetting:=szSetting; - cgs.pValue :=@dbv; - dbv._type :=DBVT_WCHAR; - i:=PluginLink^.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 - begin - result:=mmi.malloc((lstrlenw(default)+1)*SizeOf(WideChar)); - if result<>nil then - lstrcpyw(result,default); - end; - if i=0 then - DBFreeVariant(@dbv); -end; - -function DBReadStruct(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar; - ptr:pointer;size:dword):Integer; -var - dbv:TDBVariant; -begin - 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; -var - cws:TDBCONTACTWRITESETTING; -begin - cws.szModule :=szModule; - cws.szSetting :=szSetting; - cws.value._type :=DBVT_BLOB; - cws.value.pbVal :=ptr; - cws.value.cpbVal:=size; - result:=PluginLink^.CallService(MS_DB_CONTACT_WRITESETTING,0,lParam(@cws)); -end; - -function DBWriteSetting(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;dbv:PDBVARIANT):Integer; -var - cws: TDBCONTACTWRITESETTING; -begin - cws.szModule :=szModule; - cws.szSetting :=szSetting; - move(dbv^,cws.value,SizeOf(TDBVARIANT)); - Result := PluginLink^.CallService(MS_DB_CONTACT_WRITESETTING, hContact, lParam(@cws)); -end; - -function DBWriteByte(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;val:Byte):Integer; -var - cws:TDBCONTACTWRITESETTING; -begin - cws.szModule :=szModule; - cws.szSetting :=szSetting; - cws.value._type:=DBVT_BYTE; - cws.value.bVal :=Val; - Result:=PluginLink^.CallService(MS_DB_CONTACT_WRITESETTING,hContact,lParam(@cws)); -end; - -function DBWriteWord(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;val:Word):Integer; -var - cws:TDBCONTACTWRITESETTING; -begin - cws.szModule :=szModule; - cws.szSetting :=szSetting; - cws.value._type:=DBVT_WORD; - cws.value.wVal :=Val; - Result:=PluginLink^.CallService(MS_DB_CONTACT_WRITESETTING,hContact,lParam(@cws)); -end; - -function DBWriteDWord(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;val:dword):Integer; -var - cws:TDBCONTACTWRITESETTING; -begin - cws.szModule :=szModule; - cws.szSetting :=szSetting; - cws.value._type:=DBVT_DWORD; - cws.value.dVal :=Val; - Result:=PluginLink^.CallService(MS_DB_CONTACT_WRITESETTING,hContact,lParam(@cws)); -end; - -function DBWriteString(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar; - val:PAnsiChar;enc:integer=DBVT_ASCIIZ):Integer; -var - cws:TDBCONTACTWRITESETTING; -begin - cws.szModule :=szModule; - cws.szSetting :=szSetting; - cws.value._type :=enc; - if val=nil then - val:=''; - cws.value.szVal.a:=Val; - Result:=PluginLink^.CallService(MS_DB_CONTACT_WRITESETTING,hContact,lParam(@cws)); -end; - -function DBWriteUTF8(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;val:PAnsiChar):Integer; -begin - result:=DBWriteString(hContact,szModule,szSetting,val,DBVT_UTF8); -end; - -function DBWriteUnicode(hContact:THANDLE;szModule:PAnsiChar;szSetting:PAnsiChar;val:PWideChar):Integer; -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:=PluginLink^.CallService(MS_DB_CONTACT_WRITESETTING,hContact,lParam(@cws)); -} -end; - -function DBFreeVariant(dbv:PDBVARIANT):integer; -begin - Result:=PluginLink^.CallService(MS_DB_CONTACT_FREEVARIANT,0,lParam(dbv)); -end; - -function DBDeleteSetting(hContact:THandle;szModule:PAnsiChar;szSetting:PAnsiChar):Integer; -var - cgs:TDBCONTACTGETSETTING; -begin - cgs.szModule :=szModule; - cgs.szSetting:=szSetting; - Result:=PluginLink^.CallService(MS_DB_CONTACT_DELETESETTING,hContact,lParam(@cgs)); -end; -{ -type - pdbenumrec = ^dbenumrec; - dbenumrec = record - num:integer; - ptr:PAnsiChar; - end; -function EnumSettingsProc(const szSetting:PAnsiChar;lParam:LPARAM):int; cdecl; -begin - with pdbenumrec(lParam)^ do - begin - lstrcpya(ptr,szSetting); - while ptr^<>#0 do inc(ptr); - inc(ptr); - inc(num); - end; - result:=0; -end; -// hContact = 0 -function DBDeleteGroup(hContact:THANDLE;szModule:PAnsiChar):integer; -var - ces:TDBCONTACTENUMSETTINGS; - cgs:TDBCONTACTGETSETTING; - p:PAnsiChar; - rec:dbenumrec; -begin - GetMem(p,65520); - rec.num :=0; - rec.ptr :=p; - ces.pfnEnumProc:=@EnumSettingsProc; - ces.szModule :=szModule; - ces.lParam :=integer(@rec); - ces.ofsSettings:=0; - result:=PluginLink^.CallService(MS_DB_CONTACT_ENUMSETTINGS,hContact,dword(@ces)); - cgs.szModule :=szModule; - rec.ptr:=p; - with rec do - while num>0 do - begin - dec(num); - cgs.szSetting:=ptr; - PluginLink^.CallService(MS_DB_CONTACT_DELETESETTING,hContact,lParam(@cgs)); - while ptr^<>#0 do inc(ptr); - inc(ptr); - end; - FreeMem(p); -end; -} -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(pdword(lParam)^,lstrlena(szSetting)+1); - result:=0; -end; -// hContact = 0 -function DBDeleteGroup(hContact:THANDLE;szModule:PAnsiChar):integer; -var - ces:TDBCONTACTENUMSETTINGS; - cgs:TDBCONTACTGETSETTING; - p:PAnsiChar; - num:integer; - ptr:pAnsiChar; -begin - ces.szModule:=szModule; - num:=0; - - ces.pfnEnumProc:=@EnumSettingsProcCalc; - ces.lParam :=integer(@num); - ces.ofsSettings:=0; - PluginLink^.CallService(MS_DB_CONTACT_ENUMSETTINGS,hContact,dword(@ces)); - - GetMem(p,num+1); - ptr:=p; - ces.pfnEnumProc:=@EnumSettingsProc; - ces.lParam :=integer(@ptr); - ces.ofsSettings:=0; - result:=PluginLink^.CallService(MS_DB_CONTACT_ENUMSETTINGS,hContact,dword(@ces)); - ptr^:=#0; - - cgs.szModule:=szModule; - ptr:=p; - while ptr^<>#0 do - begin - cgs.szSetting:=ptr; - PluginLink^.CallService(MS_DB_CONTACT_DELETESETTING,hContact,lParam(@cgs)); - while ptr^<>#0 do inc(ptr); - inc(ptr); - end; - FreeMem(p); -end; - -function DBDeleteModule(szModule:PAnsiChar):integer; // 0.8.0+ -begin - result:=0; - PluginLink^.CallService(MS_DB_MODULE_DELETE,0,dword(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/delphi/Awkward/utils/hotkeys.pas b/delphi/Awkward/utils/hotkeys.pas deleted file mode 100644 index 738bd55..0000000 --- a/delphi/Awkward/utils/hotkeys.pas +++ /dev/null @@ -1,571 +0,0 @@ -{Hotkey and timer related functions} -unit hotkeys; - -interface - -uses windows; - -type - AWKHotKeyProc = function(hotkey:integer):integer; - -function AddProc(aproc:AWKHotKeyProc;ahotkey:integer;global:bool=false):integer; overload; -function AddProc(ahotkey:integer;wnd:HWND;aproc:AWKHotKeyProc ):integer; overload; -function AddProc(ahotkey:integer;wnd:HWND;msg:DWORD ):integer; overload; -function DelProc(hotkey:integer ):integer; overload; -function DelProc(hotkey:integer;wnd:HWND):integer; overload; - -procedure InitHotKeys; -procedure FreeHotKeys; - -implementation - -uses messages; - -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,dword(@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:integer;lParam:longint):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 lo(wParam); - proc:=FindHotkey(key,true); - if proc<>nil then - begin - if integer(proc)<>-1 then - PostMessageA(hiddenwindow,WM_MYMESSAGE,key,dword(proc)); - result:=1; - exit; - end; - end; - result:=CallNextHookEx(KbHook,code,wParam,lParam); -end; - -function wmKeyboardLL_hook(code:integer;wParam:integer;lParam:integer):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 integer(proc)<>-1 then - PostMessageA(hiddenwindow,WM_MYMESSAGE,key,dword(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,wParam,lParam:integer):integer; stdcall; -var - key:dword; -begin - if Msg=WM_HOTKEY then - begin - key:=(lParam shr 16)+(Lo(lParam) shl 8); - result:=dword(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,dword(HWND_MESSAGE),0,hInstance,nil); - if wnd<>0 then - begin - SetWindowLongA(wnd,GWL_WNDPROC,dword(@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 i0 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 i0 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/delphi/Awkward/utils/ini.pas b/delphi/Awkward/utils/ini.pas deleted file mode 100644 index 7c1e50d..0000000 --- a/delphi/Awkward/utils/ini.pas +++ /dev/null @@ -1,857 +0,0 @@ -unit INI; - -interface - -uses windows; - -{+}function SetStorage(name:PAnsiChar;inINI:boolean):cardinal; -{+}procedure FreeStorage(aHandle:cardinal); - -{+}procedure SetDefaultSection(aHandle:cardinal;name:PAnsiChar); -{+}procedure SetCurrentSection(aHandle:cardinal;sect:PAnsiChar); - -{+}procedure FlushSettings(aHandle:cardinal); -{+}procedure FlushSection(aHandle:cardinal); - -{+}procedure WriteNCInt(aHandle:cardinal;sect:PAnsiChar;param:PAnsiChar;value:integer); -{+}procedure WriteNCStr(aHandle:cardinal;sect:PAnsiChar;param:PAnsiChar;value:PAnsiChar); - -{+}procedure WriteNCStruct(aHandle:cardinal;sect:PAnsiChar;param:PAnsiChar;ptr:pointer;size:integer); -{*}procedure WriteStruct(aHandle:cardinal;param:PAnsiChar;ptr:pointer;size:integer); -{+}function ReadStruct (aHandle:cardinal;param:PAnsiChar;ptr:pointer;size:integer):boolean; - -{+}procedure WriteFlag(aHandle:cardinal;param:PAnsiChar;value:integer); -{+}procedure WriteInt (aHandle:cardinal;param:PAnsiChar;value:integer); -{+}procedure WriteStr (aHandle:cardinal;param:PAnsiChar;value:PWideChar); -procedure WriteAnsiStr(aHandle:cardinal;param:PAnsiChar;value:PAnsiChar); -{+}function ReadFlag(aHandle:cardinal;param:PAnsiChar; default:integer):integer; -{+}function ReadInt (aHandle:cardinal;param:PAnsiChar; default:integer):integer; -procedure ReadStr (aHandle:cardinal;var dst:PWideChar;param:PAnsiChar;default:PWideChar); -procedure ReadAnsiStr(aHandle:cardinal;var dst:PAnsiChar;param:PAnsiChar;default:PAnsiChar); - -procedure WriteSect(aHandle:cardinal;src:PAnsiChar); -procedure ReadSect (aHandle:cardinal;var dst:PAnsiChar); - -{*}procedure ClearSection(aHandle:cardinal); -{+}procedure DeleteParam(aHandle:cardinal;param:PAnsiChar); - -implementation - -uses common,io,m_api,dbsettings; - -type - PStorage = ^TStorage; - TStorage = record - SName :PAnsiChar; - SType :bool; - SHandle :THANDLE; - DefSection:PAnsiChar; - Section :Array [0..127] of AnsiChar; - ParOffset :integer; - Buffer :PAnsiChar; - INIBuffer :PAnsiChar; - end; - PStHeap = ^TStHeap; - TStHeap = array [0..10] of TStorage; - -const - Storage:PStHeap=nil; - NumStorage:cardinal=0; - -type - pbrec=^brec; - brec=record - ptr:PAnsiChar; - handle:cardinal; - end; - -const - DefDefSection:PAnsiChar = 'default'; - -{+}function SetStorage(name:PAnsiChar;inINI:boolean):cardinal; -var - i:integer; - tmp:PStHeap; -begin - if Storage=nil then - begin - mGetMem(Storage,SizeOf(TStorage)); - FillChar(Storage^,SizeOf(TStorage),0); - NumStorage:=1; - result:=0; - end - else - begin - integer(result):=-1; - for i:=0 to NumStorage-1 do - begin - if Storage^[i].SName=nil then // free cell - begin - result:=i; - break; - end; - end; - if integer(result)<0 then - begin - mGetMem(tmp,SizeOf(TStorage)*(NumStorage+1)); - move(Storage^,tmp^,SizeOf(TStorage)*NumStorage); - mFreeMem(Storage); - Storage:=tmp; - FillChar(Storage^[NumStorage],SizeOf(TStorage),0); - result:=NumStorage; - inc(NumStorage); - end - end; - with Storage^[result] do - begin - StrDup(SName,name); - SType:=inINI; - end; -end; - -{+}procedure FreeStorage(aHandle:cardinal); -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - begin - mFreeMem(SName); - mFreeMem(DefSection); - mFreeMem(Buffer); - mFreeMem(INIBuffer); - end; -end; - -{+}procedure WriteNCStruct(aHandle:cardinal;sect:PAnsiChar;param:PAnsiChar;ptr:pointer;size:integer); -var - cws:TDBCONTACTWRITESETTING; - pn:array [0..127] of AnsiChar; - i:integer; -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - if SType then - begin - if (sect=nil) or (sect^=#0) then - sect:=DefSection; - if sect=nil then - sect:=DefDefSection; - WritePrivateProfileStructA(sect,param,ptr,size,SName); - end - else - begin - if (sect<>nil) and (sect^<>#0) then - begin - i:=StrLen(sect); - move(sect^,pn,i); - pn[i]:='/'; - inc(i); - end - else - i:=0; - StrCopy(pn+i,param); - cws.szModule :=SName; - cws.szSetting :=pn; - cws.value._type :=DBVT_BLOB; - cws.value.pbVal :=ptr; - cws.value.cpbVal:=size; - PluginLink^.CallService(MS_DB_CONTACT_WRITESETTING,0,lParam(@cws)); - end -end; - -{*}procedure WriteStruct(aHandle:cardinal;param:PAnsiChar;ptr:pointer;size:integer); -const - hex:array [0..15] of AnsiChar = '0123456789ABCDEF'; -var - lptr:PAnsiChar; - buf,buf1:PAnsiChar; - i:integer; - crc:integer; - cws:TDBCONTACTWRITESETTING; -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - if SType then - begin - mGetMem(buf,(size+1)*2); - crc:=0; - buf1:=buf; - for i:=0 to size-1 do - begin - inc(crc,PByte(ptr)^); - buf1^ :=hex[pbyte(ptr)^ shr 4]; - (buf1+1)^:=hex[pbyte(ptr)^ and $0F]; - inc(buf1,2); - inc(pbyte(ptr)); - end; - buf1^ :=hex[(crc and $FF) shr 4]; - (buf1+1)^:=hex[(crc and $0F)]; - - StrCat(Buffer,param); - lptr:=StrEnd(Buffer); - lptr^:='='; - inc(lptr); - move(buf^,lptr^,(size+1)*2); - mFreeMem(buf); - inc(lptr,(size+1)*2); - lptr^ :=#13; - (lptr+1)^:=#10; - (lptr+2)^:=#0; - end - else - begin - StrCopy(Section+ParOffset,param); - cws.szModule :=SName; - cws.szSetting :=Section; - cws.value._type :=DBVT_BLOB; - cws.value.pbVal :=ptr; - cws.value.cpbVal:=size; - PluginLink^.CallService(MS_DB_CONTACT_WRITESETTING,0,lParam(@cws)); - end -end; - -{+}function ReadStruct(aHandle:cardinal;param:PAnsiChar;ptr:pointer;size:integer):boolean; -var - dbv:TDBVariant; -begin - if aHandle>=NumStorage then - begin - result:=false; - exit; - end; - with Storage^[aHandle] do - if SType then - begin - result:=GetPrivateProfileStructA(Section,param,ptr,size,SName); - end - else - begin - dbv._type:=DBVT_BLOB; - dbv.pbVal:=nil; - StrCopy(Section+ParOffset,param); - if (DBReadSetting(0,SName,Section,@dbv)=0) and - (dbv.pbVal<>nil) and (dbv.cpbVal=size) then - begin - move(dbv.pbVal^,ptr^,size); - DBFreeVariant(@dbv); - result:=true; - end - else - result:=false; - end -end; - -{+}procedure WriteNCInt(aHandle:cardinal;sect:PAnsiChar;param:PAnsiChar;value:integer); -var - pn:array [0..127] of AnsiChar; - i:integer; -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - if Stype then - begin - if (sect=nil) or (sect^=#0) then - sect:=DefSection; - if sect=nil then - sect:=DefDefSection; - WritePrivateProfileStringA(sect,param,IntToStr(pn,value),SName); - end - else - begin - if (sect<>nil) and (sect^<>#0) then - begin - i:=StrLen(sect); - move(sect^,pn,i); - pn[i]:='/'; - inc(i); - end - else - i:=0; - StrCopy(pn+i,param); - DBWriteDWord(0,SName,pn,value) - end -end; - -{+}procedure WriteNCStr(aHandle:cardinal;sect:PAnsiChar;param:PAnsiChar;value:PAnsiChar); -var - pn:array [0..127] of AnsiChar; - i:integer; -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - if SType then - begin - if (sect=nil) or (sect^=#0) then - sect:=DefSection; - if sect=nil then - sect:=DefDefSection; - WritePrivateProfileStringA(sect,param,value,SName); - end - else - begin - if (sect<>nil) and (sect^<>#0) then - begin - i:=StrLen(sect); - move(sect^,pn,i); - pn[i]:='/'; - inc(i); - end - else - i:=0; - StrCopy(pn+i,param); - DBWriteString(0,SName,pn,value); - end -end; - -{+}procedure SetDefaultSection(aHandle:cardinal;name:PAnsiChar); -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - begin - mFreeMem(DefSection); - StrDup(DefSection,name); - end; -end; - -{+}procedure SetCurrentSection(aHandle:cardinal;sect:PAnsiChar); -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - begin - if sect=nil then - sect:=DefSection; - if sect=nil then - sect:=''; - if SType then - begin - if (sect=nil) or (sect^=#0) then - sect:=DefDefSection; - StrCopy(Section,sect); - mGetMem(Buffer,16384); - Buffer^ :=#13; - (Buffer+1)^:=#10; - (Buffer+2)^:=#0; - end - else - begin - if sect<>nil then - begin - StrCopy(Section,sect); - ParOffset:=StrLen(Section); - Section[ParOffset]:='/'; - inc(ParOffset); - end - else - ParOffset:=0; - end - end; -end; - -{+}procedure FlushSettings(aHandle:cardinal); -var - size:integer; - ptr:PAnsiChar; -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - begin - if SType then - begin - if INIBuffer=nil then - exit; - ptr:=INIBuffer+1; - size:=StrLen(ptr); - seek(SHandle,0); - BlockWrite(SHandle,ptr^,size); - SetEndOfFile(SHandle); - mFreeMem(INIBuffer); - CloseHandle(SHandle); - end; - end; -end; - -{+}procedure FlushSection(aHandle:cardinal); -var - size,i:integer; - sect:array [0..127] of AnsiChar; - ptr1,ptr:PAnsiChar; -begin - if aHandle>=NumStorage then - exit; - with Storage^[aHandle] do - if SType then - begin - if INIBuffer=nil then - begin - mGetMem(INIBuffer,32768); - INIBuffer[0]:=#10; - SHandle:=Reset(SName); - if dword(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 :=dword(@p); - ces.szModule :=SName; - ces.ofsSettings:=0; - PluginLink^.CallService(MS_DB_CONTACT_ENUMSETTINGS,0,dword(@ces)); - mGetMem(dst,p.ptr-@buf+1); - move(buf,PAnsiChar(dst)^,p.ptr-@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,dword(@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,dword(@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 :=dword(@p); - ces.szModule :=SName; - ces.ofsSettings:=0; - PluginLink^.CallService(MS_DB_CONTACT_ENUMSETTINGS,0,dword(@ces)); - i:=p.ptr-@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,dword(@db)); - end; - end; -end; - -end. diff --git a/delphi/Awkward/utils/io.pas b/delphi/Awkward/utils/io.pas deleted file mode 100644 index aedbfeb..0000000 --- a/delphi/Awkward/utils/io.pas +++ /dev/null @@ -1,249 +0,0 @@ -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:WIN32_FIND_DATAA; - 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/delphi/Awkward/utils/mirutils.pas b/delphi/Awkward/utils/mirutils.pas deleted file mode 100644 index efca1fe..0000000 --- a/delphi/Awkward/utils/mirutils.pas +++ /dev/null @@ -1,1026 +0,0 @@ -{$Include compilers.inc} -unit mirutils; - -interface - -uses windows,m_api; - -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; - -function RegisterSingleIcon(resname,ilname,descr,group:PAnsiChar):int; -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 SetCListSelContact(hContact:THANDLE):THANDLE; -function GetCListSelContact:THANDLE; {$IFDEF DELPHI10_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):integer; overload; -function WndToContact:integer; overload; -function GetContactStatus(hContact:THANDLE):integer; -// -2 - deleted account, -1 - disabled account, 0 - hidden -// 1 - metacontact, 2 - submetacontact, positive - active -function IsContactActive(hContact:THANDLE;var proto:pAnsiChar):integer; overload; -function IsContactActive(hContact:THANDLE):integer; overload; - -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 - HKMT_CORE = 1; - HKMT_HOTKEYPLUS = 2; - HKMT_HK = 3; - HKMT_HKSERVICE = 4; - -function DetectHKManager:dword; - -const - MAX_REDIRECT_RECURSE = 4; - -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 dbsettings,common,io,syswin,freeimage,kol; - -function ConvertFileName(src:pWideChar;dst:pWideChar;hContact:THANDLE=0):pWideChar; overload; -var - pc,pc1:pWideChar; - dat:TREPLACEVARSDATA; -begin - result:=dst; - dst^:=#0; - if (src<>nil) and (src^<>#0) then - begin - pc:=nil; - if PluginLink^.ServiceExists(MS_UTILS_REPLACEVARS)<>0 then - begin - FillChar(dat,SizeOf(TREPLACEVARSDATA),0); - dat.cbSize:=SizeOf(TREPLACEVARSDATA); - dat.dwflags:=RVF_UNICODE; - pc:=pWideChar(PluginLink^.CallService(MS_UTILS_REPLACEVARS,dword(src),dword(@dat))); - end; - if isVarsInstalled then - begin - if pc<>nil then src:=pc; - pc1:=pc; - pc:=ParseVarString(src,hContact); - if pc1<>nil then mFreeMem(pc1); - end; - if pc<>nil then src:=pc; - PluginLink^.CallService(MS_UTILS_PATHTOABSOLUTEW,dword(src),dword(dst)); - if pc<>nil then 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,pc1:pAnsiChar; - dat:TREPLACEVARSDATA; -begin - result:=dst; - dst^:=#0; - if (src<>nil) and (src^<>#0) then - begin - pc:=nil; - if PluginLink^.ServiceExists(MS_UTILS_REPLACEVARS)<>0 then - begin - FillChar(dat,SizeOf(TREPLACEVARSDATA),0); - dat.cbSize:=SizeOf(TREPLACEVARSDATA); - pc:=pAnsiChar(PluginLink^.CallService(MS_UTILS_REPLACEVARS,dword(src),dword(@dat))); - end; - if isVarsInstalled then - begin - if pc<>nil then src:=pc; - pc1:=pc; - pc:=ParseVarString(src,hContact); - if pc1<>nil then mFreeMem(pc1); - end; - if pc<>nil then src:=pc; - PluginLink^.CallService(MS_UTILS_PATHTOABSOLUTE,dword(src),dword(dst)); - if pc<>nil then 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 - IsVars:integer=-1; - MirCP:integer=-1; -const - HKManager: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 - if IsVars<0 then - IsVars:=PluginLink^.ServiceExists(MS_VARS_FORMATSTRING); - result:=IsVars<>0; -end; - -function ParseVarString(astr:pAnsiChar;aContact:THANDLE=0;extra:pAnsiChar=nil):pAnsiChar; -var - tfi:TFORMATINFO; - tmp:pAnsiChar; -begin - 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,dword(@tfi),0)); - StrDup(result,tmp); - PluginLink^.CallService(MS_VARS_FREEMEMORY,int(tmp),0); - end - else - begin - StrDup(result,astr); - end; -end; - -function ParseVarString(astr:pWideChar;aContact:THANDLE=0;extra:pWideChar=nil):pWideChar; -var - tfi:TFORMATINFO; - tmp:pWideChar; -begin - 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,dword(@tfi),0)); - StrDupW(result,tmp); - PluginLink^.CallService(MS_VARS_FREEMEMORY,int(tmp),0); - end - else - begin - StrDupW(result,astr); - end; -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:=PluginLink^.CallService(MS_VARS_SHOWHELPEX,dlg,dword(@vhi)); -end; - -function DetectHKManager:dword; -begin - if HKManager<0 then - begin - with PluginLink^ do - if ServiceExists('CoreHotkeys/Register' )<>0 then HKManager:=HKMT_CORE - else if ServiceExists('HotkeysPlus/Add' )<>0 then HKManager:=HKMT_HOTKEYPLUS - else if ServiceExists('HotKey/CatchHotkey' )<>0 then HKManager:=HKMT_HK - else if ServiceExists('HotkeysService/RegisterItem')<>0 then HKManager:=HKMT_HKSERVICE - else HKManager:=0; - end; - result:=HKManager; -// else if (CallService(MS_SYSTEM_GETVERSION,0,0) and $FFFF0000)>=$00080000 then // core -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; - PluginLink^.CallService(MS_POPUP_ADDPOPUPW,DWORD(@ppdu),APF_NO_HISTORY); -end; - -function TranslateA2W(sz:PAnsiChar):PWideChar; -var - tmp:pWideChar; -begin - mGetMem(tmp,(StrLen(sz)+1)*SizeOf(WideChar)); - Result:=PWideChar(PluginLink^.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 PluginLink^.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:=integer(StrPos(sz,'Miranda')); - mFreeMem(sz); - end - else - result:=-1; -end; - -function WndToContact(wnd:hwnd):integer; overload; -var - hContact:integer; - mwid:TMessageWindowInputData; - mwod:TMessageWindowOutputData; -begin - wnd:=GetParent(wnd); //!! - hContact:=PluginLink^.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 PluginLink^.CallService(MS_MSG_GETWINDOWDATA,dword(@mwid),dword(@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:=PluginLink^.CallService(MS_DB_CONTACT_FINDNEXT,hContact,0); - end; - result:=0; -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 WndToContact:integer; 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(PluginLink^.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 dword(f)=INVALID_HANDLE_VALUE then - begin - if path<>nil then - begin - CallService(MS_UTILS_PATHTOABSOLUTE,dword(path),dword(@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 dword(f)<>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,dword(@profilepath)); - p:=StrEnd(profilepath); - p^:='\'; inc(p); - p^:=#0; - if prefix<>nil then - begin - StrCopy(filename,prefix); - p:=StrEnd(filename); - CallService(MS_DB_GETPROFILENAME,SizeOf(filename)-integer(p-@filename),dword(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 - StrCat(profilepath,filename); - 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 - StrCopy(pc,PAnsiChar(CallService(MS_PROTO_GETCONTACTBASEPROTO,hContact,0))); - 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 PluginLink^.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; - - PluginLink^.CallServiceSync(MS_GC_EVENT,0,dword(@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,dword(pszModule)); - i:=0; - gci.pszModule:=pszModule; - while i0 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; - if result<>0 then break; - end; - DBFreeVariant(@ldbv); - end; - end; - hContact:=CallService(MS_DB_CONTACT_FINDNEXT,hContact,0); - end; -end; - -function IsContactActive(hContact:THANDLE;var proto:pAnsiChar):integer; overload; -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 PluginLink^.CallService(MS_DB_CONTACT_GETSETTINGSTATIC,hContact,dword(@dbcgs))=0 then - begin - result:=0; - - if PluginLink^.ServiceExists(MS_PROTO_GETACCOUNT)<>0 then - begin - p:=PPROTOACCOUNT(CallService(MS_PROTO_GETACCOUNT,0,dword(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,dword(dbv.szVal.a))=0 then - result:=-1; - end; - - if (result=0) and (DBReadByte(hContact,strCList,'Hidden',0)=0) then - begin - result:=255; - if PluginLink^.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 - StrDup(proto,dbv.szVal.a); - end - else - begin - result:=-2; - if @proto<>nil then - proto:=nil; - end; - -end; - -function IsContactActive(hContact:THANDLE):integer; overload; -type - ppAnsiChar = ^pAnsiChar; -begin - result:=IsContactActive(hContact,ppAnsiChar(nil)^); -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 PluginLink^.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,'Group',@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,'Group',@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 PluginLink^.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,'Group',@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,'Group',@grbuf[1]); - - p:=StrRScan(grbuf,'\'); - if p<>nil then - begin - p^:=#0; - CreateGroup(grbuf+1,0); - end; - - result:=1; -end; - -function MakeGroupMenu(idxfrom:integer=100):HMENU; -var - sl:PWStrList; - i:integer; - b:array [0..15] of AnsiChar; - p:pWideChar; -begin - result:=CreatePopupMenu; - i:=0; - AppendMenuW(result,MF_STRING,idxfrom,TranslateW('')); - AppendMenuW(result,MF_SEPARATOR,0,nil); - sl:=NewWStrList; - repeat - p:=DBReadUnicode(0,'CListGroups',IntToStr(b,i),nil); - if p=nil then break; - sl.Add(p+1); - mFreeMem(p); - inc(i); - until false; - sl.Sort(false); - for i:=0 to sl.Count-1 do - begin - AppendMenuW(result,MF_STRING,idxfrom+1,pWideChar(sl.Items[i])); - end; - sl.Clear; - sl.Free; -end; - -function GetNewGroupName(parent:HWND):pWideChar; -var - mmenu:HMENU; - i:integer; - buf:array [0..63] of WideChar; - pt:TPoint; -begin - mmenu:=MakeGroupMenu; - GetCursorPos(pt); - i:=integer(TrackPopupMenu(mmenu,TPM_RETURNCMD+TPM_NONOTIFY,pt.x,pt.y,0,parent,nil)); - if i>0 then - begin - GetMenuStringW(mmenu,i,buf,HIGH(buf)+1,MF_BYCOMMAND); - StrDupW(result,buf); - end; - DestroyMenu(mmenu); -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 :=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,dword(@nlu)); - end; - - resp:=pointer(CallService(MS_NETLIB_HTTPTRANSACTION,hNetlib,dword(@req))); - - if resp<>nil then - begin - if resp^.resultCode=200 then - begin - hSaveFile:=Rewrite(save_file); - if dword(hSaveFile)<>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,dword(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,dword(@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 :=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,dword(@nlu)); - - resp:=pointer(CallService(MS_NETLIB_HTTPTRANSACTION,hNetlib,dword(@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,dword(@im),0); -// if result<>0 then -// DeleteObject(SendMessage(wnd,STM_SETIMAGE,IMAGE_BITMAP,result)); //!! - end; - CallService(MS_NETLIB_FREEHTTPREQUESTSTRUCT,0,dword(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 :=LoadImage(hInstance,resname,IMAGE_ICON,16,16,0); - sid.pszName :=ilname; - sid.szDescription.a:=descr; - result:=PluginLink^.CallService(MS_SKIN2_ADDICON,0,dword(@sid)); - DestroyIcon(sid.hDefaultIcon); -end; - -end. diff --git a/delphi/Awkward/utils/playlist.pas b/delphi/Awkward/utils/playlist.pas deleted file mode 100644 index d1fb552..0000000 --- a/delphi/Awkward/utils/playlist.pas +++ /dev/null @@ -1,431 +0,0 @@ -{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; - -implementation - -uses windows, common, io;//, m_api, mirutils; - -const - plSizeStart = 2048; - plSizeStep = 256; -const - pltM3OLD = $100; - pltM3UTF = $200; - -type - tM3UPlaylist = class(tPlayList) - private - public - constructor Create(fName:pWideChar); - end; - - tPLSPlaylist = class(tPlayList) - private - public - constructor Create(fName:pWideChar); - 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 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.Create(fName:pWideChar); -var - f:THANDLE; - i:integer; - p:PAnsiChar; - pp,pd:pWideChar; - plBuf:pAnsiChar; - plBufW:pWideChar; - pltNew:boolean; - lname,ldescr:pWideChar; - finish:boolean; -begin - inherited; - - // Load into mem - f:=Reset(fName); - if dword(f)<>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; - - p:=PlBuf; - if (pdword(p)^ and $00FFFFFF)=$00BFBBEF then - begin - inc(p,3); - UTF8ToWide(p,plBufW) - end - else - AnsiToWide(p,plBufW); - - mFreeMem(plBuf); - - pp:=plBufW; - pltNew:=StrCmpW(pp,'#EXTM3U',7)=0; - if pltNew then SkipLine(pp); - - 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; - end; - -end; - -//----- ----- - -constructor tPLSPlaylist.Create(fName:pWideChar); -var - buf:array [0..MAX_PATH-1] of AnsiChar; - lname,ldescr:pWideChar; - ffile,ftitle:array [0..31] of AnsiChar; - plName:array [0..127] of AnsiChar; - f,t:pAnsiChar; - i,size:integer; - plFile:pAnsiChar; -begin - inherited; - - WideToAnsi(fName,PlFile); - GetPrivateProfileSectionNamesA(buf,127,PlFile); - StrCopy(plName,buf); - size:=GetPrivateProfileIntA(PlName,'NumberOfEntries',0,PlFile); - f:=StrCopyE(ffile ,'File'); - t:=StrCopyE(ftitle,'Title'); - for i:=1 to size do - begin - IntToStr(f,i); - GetPrivateProfileStringA(PlName,ffile,'',buf,SizeOf(buf),PlFile); - AnsiToWide(buf,lname); - - IntToStr(t,i); - GetPrivateProfileStringA(PlName,ftitle,'',buf,SizeOf(buf),PlFile); - AnsiToWide(buf,ldescr); - - AddLine(lname,ldescr,false); - end; - mFreeMem(plFile); -end; - -//----- ----- - -constructor tPlaylist.Create(fName:pWideChar); -begin - 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; -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; - - 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); - mFreeMem(result); - StrDupW(result,buf); - end; -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; - CurElement:=PlOrder[CurOrder]; - 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); - CurElement:=PlOrder[CurOrder]; - end; - result:=GetSong; - end - else - result:=nil; -end; - -end. diff --git a/delphi/Awkward/utils/protocols.pas b/delphi/Awkward/utils/protocols.pas deleted file mode 100644 index ba14288..0000000 --- a/delphi/Awkward/utils/protocols.pas +++ /dev/null @@ -1,573 +0,0 @@ -unit protocols; - -interface - -uses windows,m_api; - -function FindProto(proto:PAnsiChar):integer; - -function GetStatusNum(status:integer):integer; -function GetNumProto:cardinal; - -function GetProtoSetting(ProtoNum:cardinal;param:boolean=false):dword; -procedure SetProtoSetting(ProtoNum:cardinal;mask:dword;param:boolean=false); - -function IsTunesSupported (ProtoNum:cardinal):bool; -function IsXStatusSupported(ProtoNum:cardinal):bool; -function IsChatSupported (ProtoNum:cardinal):bool; - -function GetProtoStatus (ProtoNum:cardinal):integer; -function GetProtoStatusNum(ProtoNum:cardinal):integer; -function GetProtoName (ProtoNum:cardinal):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: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; - psf_chat = $1000; - psf_icq = $2000; - psf_tunes = $4000; - -implementation - -uses commctrl,common,dbsettings; - -{$include m_newawaysys.inc} - -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; -// xstat :integer; // old ICQ XStatus - enabled :integer; - status :integer; // mask - param :dword; - end; - pMyProtos = ^tMyProtos; - tMyProtos = array [0..100] of tMyProto; - -var - protos:pMyProtos; - NumProto:cardinal; - NASPresents:bool; - -function FindProto(proto:PAnsiChar):integer; -var - i:integer; -begin - 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:cardinal):bool; -begin - if ProtoNum>100 then - 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:cardinal):bool; -begin - if ProtoNum>100 then - 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:cardinal):bool; -begin - if ProtoNum>100 then - 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:cardinal;param:boolean=false):dword; -begin - if ProtoNum>100 then - 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:cardinal;mask:dword;param:boolean=false); -begin - if ProtoNum>100 then - 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:cardinal):integer; -begin - if ProtoNum>100 then - ProtoNum:=FindProto(PAnsiChar(ProtoNum)); - result:=CallProtoService(protos^[ProtoNum].name,PS_GETSTATUS,0,0); -end; - -function GetProtoStatusNum(ProtoNum:cardinal):integer; -begin - if ProtoNum>100 then - ProtoNum:=FindProto(PAnsiChar(ProtoNum)); - result:=GetStatusNum(GetProtoStatus(ProtoNum)); -end; - -function GetNumProto:cardinal; -begin - result:=NumProto; -end; - -function GetProtoName(ProtoNum:cardinal):PAnsiChar; -begin - if ProtoNum<=NumProto then - result:=protos^[ProtoNum].name - else - result:=nil; -end; - -procedure FillProtoList(list:hwnd;withIcons:bool=false); -var - item:TLVITEMA; - lvc:TLVCOLUMN; - i,NewItem:integer; - cli:PCLIST_INTERFACE; -begin - FillChar(lvc,SizeOf(lvc),0); - ListView_SetExtendedListViewStyle(list, LVS_EX_CHECKBOXES); - if withIcons then - begin - dword(cli):=CallService(MS_CLIST_RETRIEVE_INTERFACE,0,0); - SetWindowLongW(list,GWL_STYLE, - GetWindowLongW(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].name; - if withIcons and (i>0) then - item.iImage:=cli^.pfnIconFromStatusMode(item.pszText,ID_STATUS_ONLINE,0); - newItem:=ListView_InsertItemA(list,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,dword(@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 - dword(cli):=CallService(MS_CLIST_RETRIEVE_INTERFACE,0,0); - SetWindowLongW(list,GWL_STYLE, - GetWindowLongW(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; - SetWindowLongW(list,GWL_STYLE, - GetWindowLongW(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 CreateProtoList:integer; -var - protoCount,i:integer; - proto:^PPROTOCOLDESCRIPTOR; - buf:array [0..127] of AnsiChar; - flag:integer; - p:pAnsichar; -begin - CallService(MS_PROTO_ENUMPROTOCOLS,integer(@protoCount),dword(@proto)); - mGetMem(protos,(protoCount+1)*SizeOf(tMyProto)); // 0 - default - NumProto:=0; - with protos^[0] do - begin - name :=defproto; - status :=-1; - enabled:=-1; - end; - for i:=1 to protoCount do - begin - if proto^^._type=PROTOTYPE_PROTOCOL then - begin - inc(NumProto); - with protos^[NumProto] do - begin - name :=proto^^.szName; -// xstat :=-1; - enabled:=psf_all;//psf_enabled; - status :=0; - 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 PluginLink^.ServiceExists(buf)<>0 then - status:=status or psf_icq; - - StrCopy(p,PS_SET_LISTENINGTO); - if PluginLink^.ServiceExists(buf)<>0 then - status:=status or psf_tunes; - - end; - end; - inc(proto); - end; - - if PluginLink^.ServiceExists(MS_NAS_SETSTATEA)<>0 then - NASPresents:=true - else - NASPresents:=false; - - result:=NumProto; -end; - -procedure FreeProtoList; -begin - 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 integer(txt)<>-1 then - begin - if not NASPresents then - result:=CallProtoService(proto,PS_SETAWAYMSG,abs(status),dword(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:=PluginLink^.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(dword(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 integer(title)<>-1 then - begin - flags:=flags or CSSF_MASK_NAME; - szName.w:=title; - end; - if integer(title)<>-1 then - begin - flags:=flags or CSSF_MASK_MESSAGE; - szMessage.w:=txt; - end; - end; - result:=CallProtoService(proto,PS_ICQ_SETCUSTOMSTATUSEX,0,dword(@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(dword(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:=PluginLink^.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/delphi/Awkward/utils/syswin.pas b/delphi/Awkward/utils/syswin.pas deleted file mode 100644 index d22700e..0000000 --- a/delphi/Awkward/utils/syswin.pas +++ /dev/null @@ -1,734 +0,0 @@ -unit SysWin; -{$include compilers.inc} - -interface - -uses windows; - -type - FFWFilterProc = function(fname:pWideChar):boolean; - -const - ThreadTimeout = 50; -const - gffdMultiThread = 1; - gffdOld = 2; - -function GetWorkOfflineStatus:integer; - -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 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 GetEXEbyWnd(w:HWND; var dst:pWideChar):pWideChar; overload; -function GetEXEbyWnd(w:HWND; var dst:PAnsiChar):PAnsiChar; overload; -function IsExeRunning(exename:PWideChar):boolean; {hwnd} -function GetFileFromWnd(wnd:HWND;Filter:FFWFilterProc; - flags:dword=gffdMultiThread+gffdOld):pWideChar; - -function WaitFocusedWndChild(Wnd:HWnd):HWnd; - -implementation - -uses shellapi,PSAPI,common,messages; - -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 ExecuteWaitW(AppPath:pWideChar; CmdLine:pWideChar=nil; DfltDirectory:PWideChar=nil; - Show:DWORD=SW_SHOWNORMAL; TimeOut:DWORD=0; ProcID:PDWORD=nil):dword; -var - Flags: DWORD; - Startup: {$IFDEF DELPHI10_UP}TStartupInfoW{$ELSE}TStartupInfo{$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; - Startup: {$IFDEF DELPHI10_UP}TStartupInfoA{$ELSE}TStartupInfo{$ENDIF}; -// Startup: TStartupInfoA; - 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; - -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(Msg); - if Unicode then - DispatchMessageW(Msg) - else - DispatchMessageA(Msg); - end; - end - else - break; - until false; -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 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; - -type - TThreadInfo = record - ftCreationTime:TFileTime; - dwUnknown1:dword; - dwStartAddress:dword; - dwOwningPID:dword; - dwThreadID:dword; - dwCurrentPriority:dword; - dwBasePriority:dword; - dwContextSwitches:dword; - dwThreadState:dword; - dwUnknown2:dword; - dwUnknown3:dword; - dwUnknown4:dword; - dwUnknown5:dword; - dwUnknown6:dword; - dwUnknown7:dword; - end; - - TProcessInfo = record - dwOffset:dword; - dwThreadCount:dword; - dwUnknown1:array[0..5] of dword; - ftCreationTime:TFileTime; - ftUserTime:int64; - ftKernelTime:int64; - wLength:word; - wMaximumLength:word; - pszProcessName:pWideChar; - dwBasePriority:dword; - dwProcessID:dword; - dwParentProcessID:dword; - dwHandleCount:dword; -// not interesting - dwUnknown7:dword; - dwUnknown8:dword; - dwVirtualBytesPeak:dword; - dwVirtualBytes:dword; - dwPageFaults:dword; - dwWorkingSetPeak:dword; - dwWorkingSet:dword; - dwUnknown9:dword; - dwPagedPool:dword; - dwUnknown10:dword; - dwNonPagedPool:dword; - dwPageFileBytesPeak:dword; - dwPageFileBytes:dword; - dwPrivateBytes:dword; - dwUnknown11:dword; - dwUnknown12:dword; - dwUnknown13:dword; - dwUnknown14:dword; - ati:array[0..0] of TThreadInfo; - end; - -function NtQuerySystemInformation(si_class:cardinal;si:pointer;si_length:cardinal;ret_length:cardinal):cardinal; stdcall; external 'ntdll.dll'; -function NtQueryObject(ObjectHandle:THANDLE;ObjectInformationClass:dword;ObjectInformation:pointer;Length:dword;var ResultLength:dword):cardinal; stdcall; external 'ntdll.dll'; -const - ObjectNameInformation = 1; // +4 bytes - ObjectTypeInformation = 2; // +$60 bytes -const - STATUS_INFO_LENGTH_MISMATCH = $C0000004; - -function GetHandleCount(pid:dword):dword; -var - buf:pointer; - pi:^TProcessInfo; -begin -{BOOL GetProcessHandleCount( - HANDLE hProcess, - PDWORD pdwHandleCount -} - mGetMem(buf,300000); - NtQuerySystemInformation(5, buf, 300000, 0); - pi:=buf; - result:=0; - repeat - pi:=pointer(cardinal(pi)+pi^.dwOffset); //first - Idle process - if pi^.dwProcessID=pid then - begin - result:=pi^.dwHandleCount; - break; - end; - if pi^.dwOffset=0 then - break; - until false; - mFreeMem(buf); -end; - -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; - -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 - j:integer; - h:pWideChar; -begin -//clear old - j:=0; - while j0 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 i0) or - (StrCmpW(TmpBuf+$30,'File')<>0) 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,pdword(nil)^); - if WaitForSingleObject(hThread,ThreadTimeout)=WAIT_TIMEOUT then - begin - TerminateThread(hThread,0); - end - else - result:=rec.fname; - CloseHandle(hThread); - end; -end; - -function GetFileFromWnd(wnd:HWND;Filter:FFWFilterProc; - flags:dword=gffdMultiThread+gffdOld):pWideChar; -var - hProcess,h:THANDLE; - pid:dword; - i:cardinal; - c:thandle; - Handles:dword; - pc:pWideChar; -begin - result:=nil; - i:=4; - GetWindowThreadProcessId(wnd,@c); - pid:=OpenProcess(PROCESS_DUP_HANDLE,true,c); - Handles:=GetHandleCount(c)*4; - harcnt:=0; - hProcess:=GetCurrentProcess; - - while true do - begin - if DuplicateHandle(pid,i,hProcess,@h,GENERIC_READ,false,0) then - begin - pc:=TestHandle(h,(flags and gffdMultiThread)<>0); - if pc<>nil then - begin -// if GetFileType(h)=FILE_TYPE_DISK then - begin - if (@Filter=nil) or Filter(pc) and (harcntMaxHandle then break; //file not found - end; - inc(i,4); - if i>Handles then - break; - end; - - CloseHandle(pid); - if harcnt>0 then - begin - CheckHandles((flags and gffdOld)=0); - result:=translatePath(hold[0]); - end -end; - -end. diff --git a/delphi/Awkward/utils/utils.pas b/delphi/Awkward/utils/utils.pas deleted file mode 100644 index 8c16e03..0000000 --- a/delphi/Awkward/utils/utils.pas +++ /dev/null @@ -1,44 +0,0 @@ -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/delphi/Awkward/utils/wrapper.pas b/delphi/Awkward/utils/wrapper.pas deleted file mode 100644 index c7b4d05..0000000 --- a/delphi/Awkward/utils/wrapper.pas +++ /dev/null @@ -1,450 +0,0 @@ -{$include compilers.inc} -unit wrapper; - -interface -uses windows; - -function GetScreenRect():TRect; -procedure SnapToScreen(var rc:TRect;dx:integer=0;dy:integer=0{; - minw:integer=240;minh:integer=100}); - -function LV_GetLParam (list:HWND;item:integer=-1):integer; -function LV_SetLParam (list:HWND;lParam:dword;item:integer=-1):integer; -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):integer; -function LV_CheckDirection(list:HWND):integer; // bit 0 - can move up, bit 1 - down - -function GetDlgText(Dialog:HWND;idc:integer;getAnsi:boolean=false):pointer; overload; -function GetDlgText(wnd:HWND;getAnsi:boolean=false):pointer; overload; -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; - -function SelectDirectory(Caption:PAnsiChar;var Directory:PAnsiChar; - Parent:HWND=0;newstyle:bool=false):Boolean; overload; -function SelectDirectory(Caption:PWideChar;var Directory:PWideChar; - Parent:HWND=0;newstyle:bool=false):Boolean; overload; - -function CB_SelectData(cb:HWND;data:dword):integer; overload; -function CB_SelectData(Dialog:HWND;id:cardinal;data:dword):integer; overload; -function CB_GetData (cb:HWND;idx:integer=-1):dword; -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; - -implementation -uses messages,common,shlobj,activex,commctrl,commdlg; - -{.$IFNDEF DELPHI10_UP} -const - LVM_SORTITEMSEX = LVM_FIRST + 81; -{.$ENDIF} -{$IFNDEF DELPHI7_UP} -const - BIF_NEWDIALOGSTYLE = $0040; -const - SM_XVIRTUALSCREEN = 76; - SM_YVIRTUALSCREEN = 77; - SM_CXVIRTUALSCREEN = 78; - SM_CYVIRTUALSCREEN = 79; -{$ENDIF} - -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 1 then - begin - mGetMem(PAnsiChar(result),a); - SendMessageA(wnd,WM_GETTEXT,a,longint(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,longint(result)); - end; - end; -end; - -function GetDlgText(Dialog:HWND;idc:integer;getAnsi:boolean=false):pointer; -begin - result:=GetDlgText(GetDlgItem(Dialog,idc),getAnsi); -end; - -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; - lpStrFile :=dst; - lpStrFilter:=Filter; - if Filter<>nil then - begin - lpstrDefExt:=StrEnd(Filter)+1; - inc(lpstrDefExt,2); // skip "*." - end; - NMaxFile :=511; - Flags :=OFN_EXPLORER or OFN_OVERWRITEPROMPT;// or OFN_HIDEREADONLY; - end; - if open then - result:=GetOpenFileNameA(NameRec) - else - result:=GetSaveFileNameA(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; - lpStrFile :=dst; - lpStrFilter:=Filter; - if Filter<>nil then - begin - lpstrDefExt:=StrEndW(Filter)+1; - inc(lpstrDefExt,2); // skip "*." - end; - NMaxFile :=511; - Flags :=OFN_EXPLORER or OFN_OVERWRITEPROMPT;// or OFN_HIDEREADONLY; - end; - if open then - result:=GetOpenFileNameW(NameRec) - else - result:=GetSaveFileNameW(NameRec) -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,integer(@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,integer(@li)); -end; - -function SelectDirectory(Caption:PAnsiChar;var Directory:PAnsiChar; - Parent:HWND=0;newstyle:bool=false):Boolean; -var - BrowseInfo:TBrowseInfoA; - Buffer:array [0..MAX_PATH-1] of AnsiChar; - ItemIDList:PItemIDList; - ShellMalloc:IMalloc; -begin - Result:=False; - FillChar(BrowseInfo,SizeOf(BrowseInfo),0); - if (ShGetMalloc(ShellMalloc)=S_OK) and (ShellMalloc<>nil) then - begin - with BrowseInfo do - begin - hwndOwner :=Parent; - pszDisplayName:=Buffer; - lpszTitle :=Caption; - ulFlags :=BIF_RETURNONLYFSDIRS; - end; - if newstyle then - if CoInitializeEx(nil,COINIT_APARTMENTTHREADED)<>RPC_E_CHANGED_MODE then - BrowseInfo.ulFlags:=BrowseInfo.ulFlags or BIF_NEWDIALOGSTYLE; - try - ItemIDList:=ShBrowseForFolderA(BrowseInfo); - Result:=ItemIDList<>nil; - if Result then - begin - ShGetPathFromIDListA(ItemIDList,Buffer); - StrDup(Directory,Buffer); - ShellMalloc.Free(ItemIDList); - end; - finally - if newstyle then CoUninitialize; - end; - end; -end; - -function SelectDirectory(Caption:PWideChar;var Directory:PWideChar; - Parent:HWND=0;newstyle:bool=false):Boolean; -var - BrowseInfo:TBrowseInfoW; - Buffer:array [0..MAX_PATH-1] of WideChar; - ItemIDList:PItemIDList; - ShellMalloc:IMalloc; -begin - Result:=False; - FillChar(BrowseInfo,SizeOf(BrowseInfo),0); - if (ShGetMalloc(ShellMalloc)=S_OK) and (ShellMalloc<>nil) then - begin - with BrowseInfo do - begin - hwndOwner :=Parent; - pszDisplayName:=Buffer; - lpszTitle :=Caption; - ulFlags :=BIF_RETURNONLYFSDIRS; - end; - if newstyle then - if CoInitializeEx(nil,COINIT_APARTMENTTHREADED)<>RPC_E_CHANGED_MODE then - BrowseInfo.ulFlags:=BrowseInfo.ulFlags or BIF_NEWDIALOGSTYLE; - try - ItemIDList:=ShBrowseForFolderW(BrowseInfo); - Result:=ItemIDList<>nil; - if Result then - begin - ShGetPathFromIDListW(ItemIDList,Buffer); - StrDupW(Directory,Buffer); - ShellMalloc.Free(ItemIDList); - end; - finally - if newstyle then CoUninitialize; - end; - end; -end; - -//----- ListView functions ----- - -function LV_GetLParam(list:HWND;item:integer=-1):integer; -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,dword(@li)); - result:=li.lParam; -end; - -function LV_SetLParam(list:HWND;lParam:dword;item:integer=-1):integer; -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,dword(@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,Integer(@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,Integer(@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,dword(item)+(dword(item+direction) shl 16),dword(@LV_Compare)); - result:=item+direction; -end; - -function LV_GetColumnCount(list:HWND):integer; -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