From 864081102a5f252415f41950b3039a896b4ae9c5 Mon Sep 17 00:00:00 2001 From: Vadim Dashevskiy Date: Mon, 8 Oct 2012 18:43:29 +0000 Subject: Awkwars's plugins - welcome to our trunk git-svn-id: http://svn.miranda-ng.org/main/trunk@1822 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c --- plugins/Utils.pas/common.pas | 2409 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 2409 insertions(+) create mode 100644 plugins/Utils.pas/common.pas (limited to 'plugins/Utils.pas/common.pas') diff --git a/plugins/Utils.pas/common.pas b/plugins/Utils.pas/common.pas new file mode 100644 index 0000000000..88df058957 --- /dev/null +++ b/plugins/Utils.pas/common.pas @@ -0,0 +1,2409 @@ +{$INCLUDE compilers.inc} +{$IFDEF Miranda} + {.$DEFINE Use_MMI} +{$ENDIF} +unit common; + +interface + +uses +windows +{$IFDEF Miranda} +,m_api +{$ENDIF} +; + +procedure ShowDump(ptr:pbyte;len:integer); + +Const {- Character sets -} + sBinNum = ['0'..'1']; + sOctNum = ['0'..'7']; + sNum = ['0'..'9']; + sHexNum = ['0'..'9','A'..'F','a'..'f']; + sWord = ['0'..'9','A'..'Z','a'..'z','_',#128..#255]; + sIdFirst = ['A'..'Z','a'..'z','_']; + sLatWord = ['0'..'9','A'..'Z','a'..'z','_']; + sWordOnly = ['A'..'Z','a'..'z']; + sSpace = [#9,' ']; + sEmpty = [#9,#10,#13,' ']; + +const + HexDigitChrLo: array [0..15] of AnsiChar = ('0','1','2','3','4','5','6','7', + '8','9','a','b','c','d','e','f'); + + HexDigitChr : array [0..15] of AnsiChar = ('0','1','2','3','4','5','6','7', + '8','9','A','B','C','D','E','F'); + +const + mimecnt = 5; + mimes:array [0..mimecnt-1] of record + mime:PAnsiChar; + ext:array [0..3] of AnsiChar + end = ( + (mime:'image/gif' ; ext:'GIF'), + (mime:'image/jpg' ; ext:'JPG'), + (mime:'image/jpeg'; ext:'JPG'), + (mime:'image/png' ; ext:'PNG'), + (mime:'image/bmp' ; ext:'BMP') +); + +var + IsW2K, + IsVista, + IsAnsi:boolean; + +const + CP_UNICODE = 1200; + CP_REVERSEBOM = 65534; +const + SIGN_UNICODE = $FEFF; + SIGN_REVERSEBOM = $FFFE; + SIGN_UTF8 = $BFBBEF; + +function BSwap(value:dword):dword; + +function Hash(s:pointer; len:integer{const Seed: LongWord=$9747b28c}): LongWord; + +function Encode(dst,src:pAnsiChar):PAnsiChar; +function Decode(dst,src:pAnsiChar):PAnsiChar; +function GetTextFormat(Buffer:pByte;sz:cardinal):integer; + +function IIF(cond:bool;ret1,ret2:integer ):integer; overload; +function IIF(cond:bool;ret1,ret2:PAnsiChar):PAnsiChar; overload; +function IIF(cond:bool;ret1,ret2:pWideChar):pWideChar; overload; +function IIF(cond:bool;ret1,ret2:Extended ):Extended; overload; +function IIF(cond:bool;ret1,ret2:tDateTime):tDateTime; overload; +function IIF(cond:bool;ret1,ret2:pointer ):pointer; overload; +function IIF(cond:bool;const ret1,ret2:string):string; overload; +{$IFNDEF DELPHI_7_UP} +function IIF(cond:bool;ret1,ret2:variant ):variant; overload; +{$ENDIF} + +function GetImageType (buf:pByte;mime:PAnsiChar=nil):dword; +function GetImageTypeW(buf:pByte;mime:PWideChar=nil):int64; + +procedure CopyToClipboard(txt:pointer; Ansi:bool); +function PasteFromClipboard(Ansi:boolean;cp:dword=CP_ACP):pointer; + +function mGetMem (var dst;size:integer):pointer; +procedure mFreeMem(var ptr); +function mReallocMem(var dst; size:integer):pointer; + +// String processing +function WideToCombo(src:PWideChar;var dst;cp:integer=CP_ACP):integer; + +function ChangeUnicode(str:PWideChar):PWideChar; +function UTF8Len(src:PAnsiChar):integer; +function WideToAnsi(src:PWideChar;var dst:PAnsiChar;cp:dword=CP_ACP):PAnsiChar; +function AnsiToWide(src:PAnsiChar;var dst:PWideChar;cp:dword=CP_ACP):PWideChar; +function AnsiToUTF8(src:PAnsiChar;var dst:PAnsiChar;cp:dword=CP_ACP):PAnsiChar; +function UTF8ToAnsi(src:PAnsiChar;var dst:PAnsiChar;cp:dword=CP_ACP):PAnsiChar; +function UTF8ToWide(src:PAnsiChar;var dst:PWideChar;len:cardinal=cardinal(-1)):PWideChar; +function WideToUTF8(src:PWideChar;var dst:PAnsiChar):PAnsiChar; + +function CharWideToUTF8(src:WideChar;var dst:pAnsiChar):integer; +function CharUTF8ToWide(src:pAnsiChar;pin:pinteger=nil):WideChar; +function CharUTF8Len(src:pAnsiChar):integer; + +function FastWideToAnsiBuf(src:PWideChar;dst:PAnsiChar;len:cardinal=cardinal(-1)):PAnsiChar; +function FastAnsiToWideBuf(src:PAnsiChar;dst:PWideChar;len:cardinal=cardinal(-1)):PWideChar; +function FastWideToAnsi (src:PWideChar;var dst:PAnsiChar):PAnsiChar; +function FastAnsiToWide (src:PAnsiChar;var dst:PWideChar):PWideChar; + +function UnEscape(buf:PAnsiChar):PAnsiChar; +function Escape (buf:PAnsiChar):PAnsiChar; + +// ----- base strings functions ----- +function StrDup (var dst:PAnsiChar;src:PAnsiChar;len:cardinal=0):PAnsiChar; +function StrDupW(var dst:PWideChar;src:PWideChar;len:cardinal=0):PWideChar; +function StrDelete (aStr:PAnsiChar;pos,len:cardinal):PAnsiChar; +function StrDeleteW(aStr:PWideChar;pos,len:cardinal):PWideChar; +function StrInsert (substr,src:PAnsiChar;pos:cardinal):PAnsiChar; +function StrInsertW(substr,src:PWideChar;pos:cardinal):PWideChar; +function StrReplace (src,SubStr,NewStr:PAnsiChar):PAnsiChar; +function StrReplaceW(src,SubStr,NewStr:pWideChar):PWideChar; +function CharReplace (dst:pAnsiChar;old,new:AnsiChar):PAnsiChar; +function CharReplaceW(dst:pWideChar;old,new:WideChar):PWideChar; +function StrCmp (a,b:PAnsiChar;n:cardinal=0):integer; +function StrCmpW(a,b:PWideChar;n:cardinal=0):integer; +function StrEnd (const a:PAnsiChar):PAnsiChar; +function StrEndW(const a:PWideChar):PWideChar; +function StrScan (src:PAnsiChar;c:AnsiChar):PAnsiChar; +function StrScanW(src:PWideChar;c:WideChar):PWideChar; +function StrRScan (src:PAnsiChar;c:AnsiChar):PAnsiChar; +function StrRScanW(src:PWideChar;c:WideChar):PWideChar; +function StrLen (Str: PAnsiChar): Cardinal; +function StrLenW(Str: PWideChar): Cardinal; +function StrCat (Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar; +function StrCatW(Dest: PWideChar; const Source: PWideChar): PWideChar; +function StrCatE (Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar; +function StrCatEW(Dest: PWideChar; const Source: PWideChar): PWideChar; +function StrCopyE (dst:PAnsiChar;src:PAnsiChar;len:cardinal=0):PAnsiChar; +function StrCopyEW(dst:PWideChar;src:PWideChar;len:cardinal=0):PWideChar; +function StrCopy (dst:PAnsiChar;src:PAnsiChar;len:cardinal=0):PAnsiChar; +function StrCopyW(dst:PWideChar;src:PWideChar;len:cardinal=0):PWideChar; +function StrPos (const aStr, aSubStr: PAnsiChar): PAnsiChar; +function StrPosW(const aStr, aSubStr: PWideChar): PWideChar; +function StrIndex (const aStr, aSubStr: PAnsiChar):integer; +function StrIndexW(const aStr, aSubStr: PWideChar):integer; + +procedure FillWord(var buf;count:cardinal;value:word); register; +function CompareMem(P1, P2: Pointer; Length: Integer): Boolean; + +function Min(a,b:integer):integer; +function Max(a,b:integer):integer; + +function Timestamp(Year,Month,Day:cardinal;Hour:cardinal=0;Minute:cardinal=0;Sec:cardinal=0):dword; +function GetCurrentTime:dword; + +function TimeToInt(stime:PAnsiChar):integer; overload; +function TimeToInt(stime:PWideChar):integer; overload; +function IntToTime(dst:pWideChar;time:integer):pWideChar; overload; +function IntToTime(dst:PAnsiChar;time:integer):PAnsiChar; overload; + +{ + filesize to string conversion + value - filelength + divider - 1=byte; 1024=kbyte; 1024*1024 - Mbyte + prec - numbers after point (1-3) + post - 0=none + 1=(small)' bytes','kb','mb' + 2=(mix) ' Bytes','Kb','Mb' + 3=(caps) '' ,'KB','MB' + postfix calculated from 'divider' value +} +function IntToK(dst:pWideChar;value,divider,prec,post:integer):pWideChar; + +// string conversion +function IntToHex(dst:pWideChar;Value:int64;Digits:integer=0):pWideChar; overload; +function IntToHex(dst:PAnsiChar;Value:int64;Digits:integer=0):PAnsiChar; overload; +function IntToStr(dst:pWideChar;Value:int64;Digits:integer=0):pWideChar; overload; +function IntToStr(dst:PAnsiChar;Value:int64;Digits:integer=0):PAnsiChar; overload; +function StrToInt(src:pWideChar):int64; overload; +function StrToInt(src:PAnsiChar):int64; overload; +function HexToInt(src:pWideChar;len:cardinal=$FFFF):int64; overload; +function HexToInt(src:PAnsiChar;len:cardinal=$FFFF):int64; overload; + +// filename work +function ChangeExt (src,ext:PAnsiChar):PAnsiChar; +function ChangeExtW(src,ext:PWideChar):PWideChar; +function Extract (s:PAnsiChar;name:Boolean=true):PAnsiChar; +function ExtractW(s:pWideChar;name:Boolean=true):pWideChar; +function GetExt(fname,dst:pWideChar;maxlen:dword=100):pWideChar; overload; +function GetExt(fname,dst:PAnsiChar;maxlen:dword=100):PAnsiChar; overload; + +procedure UpperCase(src:pWideChar); +procedure LowerCase(src:pWideChar); +function GetPairChar(ch:AnsiChar):AnsiChar; overload; +function GetPairChar(ch:WideChar):WideChar; overload; + +type + tSortProc = function (First,Second:integer):integer; + {0=equ; 1=1st>2nd; -1=1st<2nd } +procedure ShellSort(size:integer;Compare,Swap:tSortProc); + +function isPathAbsolute(path:pWideChar):boolean; overload; +function isPathAbsolute(path:PAnsiChar):boolean; overload; + +implementation + +// Murmur 2.0 +function Hash(s:pointer; len:integer{const Seed: LongWord=$9747b28c}): LongWord; +var + hash: LongWord; + k: LongWord; + tmp,data: pByte; +const + // 'm' and 'r' are mixing constants generated offline. + // They're not really 'magic', they just happen to work well. + m = $5bd1e995; + r = 24; +begin + //The default seed, $9747b28c, is from the original C library + + // Initialize the hash to a 'random' value + hash := {seed xor }len; + + // Mix 4 bytes at a time into the hash + data := s; + + while(len >= 4) do + begin + k := PLongWord(data)^; + + k := k*m; + k := k xor (k shr r); + k := k*m; + + hash := hash*m; + hash := hash xor k; + + inc(data,4); + dec(len,4); + end; + + // Handle the last few bytes of the input array + if len = 3 then + begin + tmp:=data; + inc(tmp,2); + hash := hash xor (LongWord(tmp^) shl 16); + end; + if len >= 2 then + begin + tmp:=data; + inc(tmp); + hash := hash xor (LongWord(tmp^) shl 8); + end; + if len >= 1 then + begin + hash := hash xor (LongWord(data^)); + hash := hash * m; + end; + + // Do a few final mixes of the hash to ensure the last few + // bytes are well-incorporated. + hash := hash xor (hash shr 13); + hash := hash * m; + hash := hash xor (hash shr 15); + + Result := hash; +end; + +function BSwap(value:dword):dword; + {$IFNDEF WIN64} +begin + asm + mov eax,value + bswap eax + mov result,eax + end; + {$ELSE} +begin + result:=((value and $000000FF) shl 6) + + ((value and $0000FF00) shl 2) + + ((value and $00FF0000) shr 2) + + ((value and $FF000000) shr 6); + {$ENDIF} +end; + +function Encode(dst,src:pAnsiChar):PAnsiChar; +begin + while src^<>#0 do + begin + if not (src^ in [' ','%','+','&','?',#128..#255]) then + dst^:=src^ + else + begin + dst^:='%'; inc(dst); + dst^:=HexDigitChr[ord(src^) shr 4]; inc(dst); + dst^:=HexDigitChr[ord(src^) and $0F]; + end; + inc(src); + inc(dst); + end; + dst^:=#0; + result:=dst; +end; + +function Decode(dst,src:pAnsiChar):PAnsiChar; +begin + while (src^<>#0) and (src^<>'&') do + begin + if (src^='%') and ((src+1)^ in sHexNum) and ((src+2)^ in sHexNum) then + begin + inc(src); + dst^:=AnsiChar(HexToInt(src,2)); + inc(src); + end + else + dst^:=src^; + inc(dst); + inc(src); + end; + dst^:=#0; + result:=dst; +end; + +const + IS_TEXT_UNICODE_ASCII16 = $1; + IS_TEXT_UNICODE_REVERSE_ASCII16 = $10; + IS_TEXT_UNICODE_STATISTICS = $2; + IS_TEXT_UNICODE_REVERSE_STATISTICS = $20; + IS_TEXT_UNICODE_CONTROLS = $4; + IS_TEXT_UNICODE_REVERSE_CONTROLS = $40; + IS_TEXT_UNICODE_SIGNATURE = $8; + IS_TEXT_UNICODE_REVERSE_SIGNATURE = $80; + IS_TEXT_UNICODE_ILLEGAL_CHARS = $100; + IS_TEXT_UNICODE_ODD_LENGTH = $200; + IS_TEXT_UNICODE_DBCS_LEADBYTE = $400; + IS_TEXT_UNICODE_NULL_BYTES = $1000; + IS_TEXT_UNICODE_UNICODE_MASK = $F; + IS_TEXT_UNICODE_REVERSE_MASK = $F0; + IS_TEXT_UNICODE_NOT_UNICODE_MASK = $F00; + IS_TEXT_UNICODE_NOT_ASCII_MASK = $F000; + +function IsTextUTF8(Buffer:pbyte;Length:integer):boolean; +var + Ascii:boolean; + Octets:cardinal; + c:byte; +begin + Ascii:=true; + Octets:=0; + + if Length=0 then + Length:=-1; + repeat + if (Length=0) or (Buffer^=0) then + break; + dec(Length); + c:=Buffer^; + if (c and $80)<>0 then + Ascii:=false; + if Octets<>0 then + begin + if (c and $C0)<>$80 then + begin + result:=false; + exit; + end; + dec(Octets); + end + else + begin + if (c and $80)<>0 then + begin + while (c and $80)<>0 do + begin + c:=c shl 1; + inc(Octets); + end; + dec(Octets); + if Octets=0 then + begin + result:=false; + exit; + end; + end + end; + inc(Buffer); + until false; + result:= not ((Octets>0) or Ascii); +end; + +function GetTextFormat(Buffer:pByte;sz:cardinal):integer; +var + test:integer; +begin + result:=-1; + + if sz>=2 then + begin + if pword (Buffer)^ =SIGN_UNICODE then result := CP_UNICODE + else if pword (Buffer)^ =SIGN_REVERSEBOM then result := CP_REVERSEBOM + else if (sz>=4) and + ((pdword(Buffer)^ and $00FFFFFF)=SIGN_UTF8) then result := CP_UTF8; + end; + + if result<0 then + begin + test:= + IS_TEXT_UNICODE_STATISTICS or + IS_TEXT_UNICODE_REVERSE_STATISTICS or + IS_TEXT_UNICODE_CONTROLS or + IS_TEXT_UNICODE_REVERSE_CONTROLS or + IS_TEXT_UNICODE_ILLEGAL_CHARS or + IS_TEXT_UNICODE_ODD_LENGTH or + IS_TEXT_UNICODE_NULL_BYTES; + + if not odd(sz) and IsTextUnicode(Buffer,sz,@test) then + begin + if (test and (IS_TEXT_UNICODE_ODD_LENGTH or IS_TEXT_UNICODE_ILLEGAL_CHARS))=0 then + begin + if (test and (IS_TEXT_UNICODE_NULL_BYTES or + IS_TEXT_UNICODE_CONTROLS or + IS_TEXT_UNICODE_REVERSE_CONTROLS))<>0 then + begin + if (test and (IS_TEXT_UNICODE_CONTROLS or + IS_TEXT_UNICODE_STATISTICS))<>0 then + result:=CP_UNICODE + else if (test and (IS_TEXT_UNICODE_REVERSE_CONTROLS or + IS_TEXT_UNICODE_REVERSE_STATISTICS))<>0 then + result:=CP_REVERSEBOM; + end + end + end + else if IsTextUTF8(Buffer,sz) then + result:=CP_UTF8 + else + result:=CP_ACP; + end; +end; + +function IIF(cond:bool;ret1,ret2:integer):integer; overload; +begin + if cond then result:=ret1 else result:=ret2; +end; +function IIF(cond:bool;ret1,ret2:PAnsiChar):PAnsiChar; overload; +begin + if cond then result:=ret1 else result:=ret2; +end; +function IIF(cond:bool;ret1,ret2:pWideChar):pWideChar; overload; +begin + if cond then result:=ret1 else result:=ret2; +end; +function IIF(cond:bool;ret1,ret2:Extended):Extended; overload; +begin + if cond then result:=ret1 else result:=ret2; +end; +function IIF(cond:bool;ret1,ret2:tDateTime):tDateTime; overload; +begin + if cond then result:=ret1 else result:=ret2; +end; +function IIF(cond:bool;ret1,ret2:pointer):pointer; overload; +begin + if cond then result:=ret1 else result:=ret2; +end; +function IIF(cond:bool;const ret1,ret2:string):string; overload; +begin + if cond then result:=ret1 else result:=ret2; +end; +{$IFNDEF DELPHI_7_UP} +function IIF(cond:bool;ret1,ret2:variant):variant; overload; +begin + if cond then result:=ret1 else result:=ret2; +end; +{$ENDIF} + +function GetImageType(buf:pByte;mime:PAnsiChar=nil):dword; +var + i:integer; +begin + result:=0; + if (mime<>nil) and (mime^<>#0) then + begin + for i:=0 to mimecnt-1 do + begin + if {lstrcmpia}StrCmp(mime,mimes[i].mime)=0 then + begin + result:=dword(mimes[i].ext); + exit; + end; + end; + end + else if buf<>nil then + begin + if (pdword(buf)^ and $F0FFFFFF)=$E0FFD8FF then result:=$0047504A // 'JPG' + else if pdword(buf)^=$38464947 then result:=$00464947 // 'GIF' + else if pdword(buf)^=$474E5089 then result:=$00474E50 // 'PNG' + else if pword (buf)^=$4D42 then result:=$00504D42 // 'BMP' + end; +end; + +function GetImageTypeW(buf:pByte;mime:PWideChar=nil):int64; +var + i:integer; + lmime:array [0..63] of AnsiChar; +begin + result:=0; + if (mime<>nil) and (mime^<>#0) then + begin + FastWideToAnsiBuf(mime,lmime); + for i:=0 to mimecnt-1 do + begin + if {lstrcmpia}StrCmp(lmime,mimes[i].mime)=0 then + begin +// result:=dword(mimes[i].ext); + FastAnsiToWideBuf(mimes[i].ext,PWideChar(@result)); + exit; + end; + end; + end + else if buf<>nil then + begin + if (pdword(buf)^ and $F0FFFFFF)=$E0FFD8FF then result:=$000000470050004A // 'JPG' + else if pdword(buf)^=$38464947 then result:=$0000004600490047 // 'GIF' + else if pdword(buf)^=$474E5089 then result:=$00000047004E0050 // 'PNG' + else if pword (buf)^=$4D42 then result:=$00000050004D0042 // 'BMP' + end; +end; + +procedure CopyToClipboard(txt:pointer; Ansi:bool); +var + s:pointer; + fh:THANDLE; +begin + if pointer(txt)=nil then + exit; + if Ansi then + begin + if PAnsiChar(txt)^=#0 then exit + end + else + if PWideChar(txt)^=#0 then exit; + + if OpenClipboard(0) then + begin + if Ansi then + begin + fh:=GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE,(StrLen(PAnsiChar(txt))+1)); + s:=GlobalLock(fh); + StrCopy(s,PAnsiChar(txt)); + end + else + begin + fh:=GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, + (StrLenW(PWideChar(txt))+1)*SizeOf(WideChar)); + s:=GlobalLock(fh); + StrCopyW(s,PWideChar(txt)); + end; + GlobalUnlock(fh); + EmptyClipboard; + if Ansi then + SetClipboardData(CF_TEXT,fh) + else + SetClipboardData(CF_UNICODETEXT,fh); + CloseClipboard; + end; +end; + +function PasteFromClipboard(Ansi:boolean;cp:dword=CP_ACP):pointer; +var + p:pWideChar; + fh:tHandle; +begin + result:=nil; + if OpenClipboard(0) then + begin + if not Ansi then + begin + fh:=GetClipboardData(CF_UNICODETEXT); + if fh<>0 then + begin + p:=GlobalLock(fh); + StrDupW(pWideChar(result),p); + end + else + begin + fh:=GetClipboardData(CF_TEXT); + if fh<>0 then + begin + p:=GlobalLock(fh); + AnsiToWide(PAnsiChar(p),pWideChar(result),cp); + end; + end; + end + else + begin + fh:=GetClipboardData(CF_TEXT); + if fh<>0 then + begin + p:=GlobalLock(fh); + StrDup(PAnsiChar(result),PAnsiChar(p)); + end; + end; + if fh<>0 then + GlobalUnlock(fh); + CloseClipboard; + end +end; + +procedure CheckSystem; +var + ovi:TOSVersionInfo; +begin + ovi.dwOSVersionInfoSize:=SizeOf(TOSVersionInfo); + GetVersionEx(ovi); +//VER_PLATFORM_WIN32_NT for 2KXP + with ovi do + begin + IsAnsi :=dwPlatformId=VER_PLATFORM_WIN32_WINDOWS; + IsW2K :=(dwMajorVersion=5) and (dwMinorVersion=0); + IsVista:=(dwMajorVersion=6) and (dwMinorVersion=0); + end; +end; + +// --------- string conversion ---------- + +function WideToCombo(src:PWideChar;var dst;cp:integer=CP_ACP):integer; +var + pc:PAnsiChar; + i,j:Cardinal; +begin + WideToAnsi(src,pc,cp); + j:=StrLen(pc)+1; + i:=j+(StrLenW(src)+1)*SizeOf(WideChar); + mGetMem(PAnsiChar(dst),i); + StrCopy(PAnsiChar(dst),pc); + mFreeMem(pc); + StrCopyW(pWideChar(PAnsiChar(dst)+j),src); + result:=i; +end; + +function ChangeUnicode(str:PWideChar):PWideChar; +var + i,len:integer; +begin + result:=str; + if (str=nil) or (str^=#0) then + exit; + if (word(str^)=$FFFE) or (word(str^)=$FEFF) then + begin + len:=StrLenW(str); + if word(str^)=$FFFE then + begin + i:=len-1; + while i>0 do // str^<>#0 + begin + pword(str)^:=swap(pword(str)^); + inc(str); + dec(i); + end; + end; + move((result+1)^,result^,len*SizeOf(WideChar)); + end; +end; + +function WideToAnsi(src:PWideChar;var dst:PAnsiChar; cp:dword=CP_ACP):PAnsiChar; +var + len,l:integer; +begin + if (src=nil) or (src^=#0) then + begin + mGetMem(result,SizeOf(AnsiChar)); + result^:=#0; + end + else + begin + l:=StrLenW(src); + len:=WideCharToMultiByte(cp,0,src,l,NIL,0,NIL,NIL)+1; + mGetMem(result,len); + FillChar(result^,len,0); + WideCharToMultiByte(cp,0,src,l,result,len,NIL,NIL); + end; + dst:=result; +end; + +function AnsiToWide(src:PAnsiChar;var dst:PWideChar; cp:dword=CP_ACP):PWideChar; +var + len,l:integer; +begin + if (src=nil) or (src^=#0) then + begin + mGetMem(result,SizeOf(WideChar)); + result^:=#0; + end + else + begin + l:=StrLen(src); + len:=MultiByteToWideChar(cp,0,src,l,NIL,0)+1; + mGetMem(result,len*SizeOf(WideChar)); + FillChar(result^,len*SizeOf(WideChar),0); + MultiByteToWideChar(cp,0,src,l,result,len); + end; + dst:=result; +end; + +function AnsiToUTF8(src:PAnsiChar;var dst:PAnsiChar;cp:dword=CP_ACP):PAnsiChar; +var + tmp:PWideChar; +begin + AnsiToWide(src,tmp,cp); + result:=WideToUTF8(tmp,dst); + mFreeMem(tmp); +end; + +function UTF8Len(src:PAnsiChar):integer; // w/o zero +begin + result:=0; + if src<>nil then + begin + if (pdword(src)^ and $00FFFFFF)=SIGN_UTF8 then + inc(src,3); + while src^<>#0 do + begin + if (ord(src^) and $80)=0 then + else if (ord(src^) and $E0)=$E0 then + inc(src,2) + else + inc(src); + inc(result); + inc(src); + end; + end; +end; + +function CalcUTF8Len(src:pWideChar):integer; +begin + result:=0; + if src<>nil then + begin + while src^<>#0 do + begin + if src^<#$0080 then + else if src^<#$0800 then + inc(result) + else + inc(result,2); + inc(src); + inc(result); + end; + end; +end; + +function CharWideToUTF8(src:WideChar;var dst:pAnsiChar):integer; +begin + if src<#$0080 then + begin + dst^:=AnsiChar(src); + result:=1; + end + else if src<#$0800 then + begin + dst^:=AnsiChar($C0 or (ord(src) shr 6)); + inc(dst); + dst^:=AnsiChar($80 or (ord(src) and $3F)); + result:=2; + end + else + begin + dst^:=AnsiChar($E0 or (ord(src) shr 12)); + inc(dst); + dst^:=AnsiChar($80 or ((ord(src) shr 6) and $3F)); + inc(dst); + dst^:=AnsiChar($80 or (ord(src) and $3F)); + result:=3; + end; + inc(dst); dst^:=#0; +end; + +function CharUTF8ToWide(src:pAnsiChar;pin:pinteger=nil):WideChar; +var + cnt:integer; + w:word; +begin + if ord(src^)<$80 then + begin + w:=ord(src^); + cnt:=1; + end + else if (ord(src^) and $E0)=$E0 then + begin + w:=(ord(src^) and $1F) shl 12; + inc(src); + w:=w or (((ord(src^))and $3F) shl 6); + inc(src); + w:=w or (ord(src^) and $3F); + cnt:=3; + end + else + begin + w:=(ord(src^) and $3F) shl 6; + inc(src); + w:=w or (ord(src^) and $3F); + cnt:=2; + end; + if pin<>nil then + pin^:=cnt; + result:=WideChar(w); +end; + +function CharUTF8Len(src:pAnsiChar):integer; +begin +{!!} + if (ord(src^) and $80)=0 then + result:=1 + else if (ord(src^) and $E0)=$E0 then + result:=3 + else + result:=2; +{} +end; + +function UTF8ToWide(src:PAnsiChar; var dst:PWideChar; len:cardinal=cardinal(-1)):PWideChar; +var + w:word; + p:PWideChar; +begin + mGetMem(dst,(UTF8Len(src)+1)*SizeOf(WideChar)); + p:=dst; + if src<>nil then + begin + if (pdword(src)^ and $00FFFFFF)=SIGN_UTF8 then + inc(src,3); + while (src^<>#0) and (len>0) do + begin + if ord(src^)<$80 then + w:=ord(src^) + else if (ord(src^) and $E0)=$E0 then + begin + w:=(ord(src^) and $1F) shl 12; + inc(src); dec(len); + w:=w or (((ord(src^))and $3F) shl 6); + inc(src); dec(len); + w:=w or (ord(src^) and $3F); + end + else + begin + w:=(ord(src^) and $3F) shl 6; + inc(src); dec(len); + w:=w or (ord(src^) and $3F); + end; + p^:=WideChar(w); + inc(p); + inc(src); dec(len); + end; + end; + p^:=#0; + result:=dst; +end; + +function UTF8ToAnsi(src:PAnsiChar;var dst:PAnsiChar;cp:dword=CP_ACP):PAnsiChar; +var + tmp:pWideChar; +begin + UTF8ToWide(src,tmp); + result:=WideToAnsi(tmp,dst,cp); + mFreeMem(tmp); +end; + +function WidetoUTF8(src:PWideChar; var dst:PAnsiChar):PAnsiChar; +var + p:PAnsiChar; +begin + mGetMem(dst,CalcUTF8Len(src)+1); + p:=dst; + if src<>nil then + begin + while src^<>#0 do + begin + if src^<#$0080 then + p^:=AnsiChar(src^) + else if src^<#$0800 then + begin + p^:=AnsiChar($C0 or (ord(src^) shr 6)); + inc(p); + p^:=AnsiChar($80 or (ord(src^) and $3F)); + end + else + begin + p^:=AnsiChar($E0 or (ord(src^) shr 12)); + inc(p); + p^:=AnsiChar($80 or ((ord(src^) shr 6) and $3F)); + inc(p); + p^:=AnsiChar($80 or (ord(src^) and $3F)); + end; + inc(p); + inc(src); + end; + end; + p^:=#0; + result:=dst; +end; + +procedure FillWord(var buf;count:cardinal;value:word); register; +{$IFNDEF WIN64}assembler; +{ + PUSH EDI + MOV EDI, ECX // Move Value To Write + MOV ECX, EDX // Move Number to ECX for countdown + MOV EDX, EAX // Move over buffer + MOV EAX, EDI // Value to Write needs to be here + MOV EDI, EDX // Pointer to Buffer[0] + REP STOSW + POP EDI +} +asm + push edi + mov edi,buf // destination + mov ax,value // value + mov ecx,count // count + rep stosw + pop edi +{ + push edi + mov edi,eax // destination + mov ax,cx // value + mov ecx,edx // count + rep stosw + pop edi +} +end; +{$ELSE} +var + ptr:pword; + i:integer; +begin + ptr:=pword(@buf); + for i:=0 to count-1 do + begin + ptr^:=value; + inc(ptr); + end; +end; +{$ENDIF} +// from SysUtils +{ Delphi 7.0 +function CompareMem(P1, P2: Pointer; Length: Integer): Boolean; assembler; +asm + PUSH ESI + PUSH EDI + MOV ESI,P1 + MOV EDI,P2 + MOV EDX,ECX + XOR EAX,EAX + AND EDX,3 + SAR ECX,2 + JS @@1 // Negative Length implies identity. + REPE CMPSD + JNE @@2 + MOV ECX,EDX + REPE CMPSB + JNE @@2 +@@1: INC EAX +@@2: POP EDI + POP ESI +end; +} +{$IFNDEF WIN64} +// Delphi 2009 realization +function CompareMem(P1, P2: Pointer; Length: Integer): Boolean; assembler; +asm + add eax, ecx + add edx, ecx + xor ecx, -1 + add eax, -8 + add edx, -8 + add ecx, 9 + push ebx + jg @Dword + mov ebx, [eax+ecx] + cmp ebx, [edx+ecx] + jne @Ret0 + lea ebx, [eax+ecx] + add ecx, 4 + and ebx, 3 + sub ecx, ebx + jg @Dword +@DwordLoop: + mov ebx, [eax+ecx] + cmp ebx, [edx+ecx] + jne @Ret0 + mov ebx, [eax+ecx+4] + cmp ebx, [edx+ecx+4] + jne @Ret0 + add ecx, 8 + jg @Dword + mov ebx, [eax+ecx] + cmp ebx, [edx+ecx] + jne @Ret0 + mov ebx, [eax+ecx+4] + cmp ebx, [edx+ecx+4] + jne @Ret0 + add ecx, 8 + jle @DwordLoop +@Dword: + cmp ecx, 4 + jg @Word + mov ebx, [eax+ecx] + cmp ebx, [edx+ecx] + jne @Ret0 + add ecx, 4 +@Word: + cmp ecx, 6 + jg @Byte + movzx ebx, word ptr [eax+ecx] + cmp bx, [edx+ecx] + jne @Ret0 + add ecx, 2 +@Byte: + cmp ecx, 7 + jg @Ret1 + movzx ebx, byte ptr [eax+7] + cmp bl, [edx+7] + jne @Ret0 +@Ret1: + mov eax, 1 + pop ebx + ret +@Ret0: + xor eax, eax + pop ebx +end; +{$ELSE} +function CompareMem(P1, P2: Pointer; Length: Integer): Boolean; + {$IFNDEF COMPILER_16_UP} +begin + result:=CompareByte(P1,P2,Length)=0; + {$ELSE} +var + i:integer; +begin + for i:=0 to Length-1 do + begin + if pByte(p1)^<>pbyte(p2)^ then + begin + result:=false; + exit; + end; + inc(pbyte(p1)); + inc(pbyte(p2)); + end; + result:=true; + {$ENDIF} +end; +{$ENDIF} + +function Min(a,b:integer):integer; +begin + if a>b then + result:=b + else + result:=a; +end; + +function Max(a,b:integer):integer; +begin + if anil then + begin +{$IFDEF UseMMI} + mir_free(pointer(ptr)) +{$ELSE} + FreeMem(pointer(ptr)); +{$ENDIF} + Pointer(ptr):=nil; + end; +end; + +function mReallocMem(var dst; size:integer):pointer; +begin +{$IFDEF Use_MMI} + pointer(dst):=mir_realloc(pointer(dst),size) +{$ELSE} + ReallocMem(pointer(dst),size); +{$ENDIF} + result:=pointer(dst); +end; + +function UnEscape(buf:PAnsiChar):PAnsiChar; +begin + if (buf<>nil) and (buf^<>#0) then + begin + StrReplace(buf,PAnsiChar(#$7F'n'),PAnsiChar(#$0D#$0A)); + StrReplace(buf,PAnsiChar(#$7F't'),PAnsiChar(#$09)); + end; + result:=buf; +end; + +function Escape(buf:PAnsiChar):PAnsiChar; +var + i:integer; +begin + i:=StrLen(buf); + if i<>0 then + begin + Move(buf^,(buf+1)^,i+1); + buf^:=#39; + (buf+i+1)^:=#39; + (buf+i+2)^:=#0; + StrReplace(buf,#$0D#$0A,#$7F'n'); + StrReplace(buf,#$09,#$7F't'); + end; + result:=buf; +end; + +procedure ShellSort(size:integer;Compare,Swap:tSortProc); +var + i,j,gap:longint; +begin + gap:=size shr 1; + while gap>0 do + begin + for i:=gap to size-1 do + begin + j:=i-gap; + while (j>=0) and (Compare(j,UInt(j+gap))>0) do + begin + Swap(j,UInt(j+gap)); + dec(j,gap); + end; + end; + gap:=gap shr 1; + end; +end; + +const + Posts:array [0..8] of PWideChar = + (' bytes',' Bytes','','kb','Kb','KB','mb','Mb','MB'); + +function IntToK(dst:pWidechar;value,divider,prec,post:integer):pWidechar; +var + tmp:integer; + p:pWideChar; + ls:array [0..4] of WideChar; +begin + result:=dst; + IntToStr(dst,value div divider); + if divider=1 then prec:=0; + while dst^<>#0 do inc(dst); + if prec<>0 then + begin + if prec=1 then prec:=10 + else if prec=2 then prec:=100 + else {if prec=3 then} prec:=1000; + tmp:=round(frac(value*1.0/divider)*prec); + dst^:='.'; inc(dst); + IntToStr(ls,tmp); + p:=ls; + while p^<>#0 do + begin + dst^:=p^; inc(dst); inc(p); + end; + dst^:=#0; + end; + if post<>0 then + begin + if divider=1 then + StrCatW(dst,Posts[post-1]) + else + begin + if divider=1024 then tmp:=1 + else {if divider=1024*1024 then} tmp:=2; + p:=Posts[tmp*3+post-1]; + dst^:=p[0]; inc(dst); + dst^:=p[1]; inc(dst); + dst^:=#0; + end; + end; +end; + +// ----- base string functions ----- +function StrDup(var dst:PAnsiChar;src:PAnsiChar;len:cardinal=0):PAnsiChar; +var + l:cardinal; + p:pAnsiChar; +begin + if (src=nil) or (src^=#0) then + dst:=nil + else + begin + if len=0 then + len:=high(cardinal); + p:=src; + l:=len; + while (p^<>#0) and (l>0) do + begin + inc(p); dec(l); + end; + l:=p-src; + + mGetMem(dst,l+1); + move(src^, dst^,l); + dst[l]:=#0; + end; + result:=dst; +end; + +function StrDupW(var dst:PWideChar;src:PWideChar;len:cardinal=0):PWideChar; +var + l:cardinal; + p:pWideChar; +begin + if (src=nil) or (src^=#0) then + dst:=nil + else + begin + if len=0 then + len:=high(cardinal); + p:=src; + l:=len; + while (p^<>#0) and (l>0) do + begin + inc(p); dec(l); + end; + l:=p-src; + mGetMem(dst,(l+1)*SizeOf(WideChar)); + move(src^, dst^,l*SizeOf(WideChar)); + dst[l]:=#0; + end; + result:=dst; +end; + +function StrCopyE(dst:PAnsiChar;src:PAnsiChar;len:cardinal=0):PAnsiChar; +var + l:cardinal; + p:pAnsiChar; +begin + if dst<>nil then + begin + if (src=nil) or (src^=#0) then + dst^:=#0 + else + begin + if len=0 then + len:=high(cardinal); + p:=src; + l:=len; + while (p^<>#0) and (l>0) do + begin + inc(p); dec(l); + end; + l:=p-src; + move(src^, dst^,l); + inc(dst,l); + dst^:=#0; + end; + end; + result:=dst; +end; + +function StrCopyEW(dst:PWideChar;src:PWideChar;len:cardinal=0):PWideChar; +var + l:cardinal; + p:pWideChar; +begin + if dst<>nil then + begin + if (src=nil) or (src^=#0) then + dst^:=#0 + else + begin + if len=0 then + len:=high(cardinal); + p:=src; + l:=len; + while (p^<>#0) and (l>0) do + begin + inc(p); dec(l); + end; + l:=p-src; + move(src^, dst^,l*SizeOf(WideChar)); + inc(dst,l); + dst^:=#0; + end; + end; + result:=dst; +end; + +function StrCopy(dst:PAnsiChar;src:PAnsiChar;len:cardinal=0):PAnsiChar; +var + l:cardinal; + p:pAnsiChar; +begin + if dst<>nil then + begin + if (src=nil) or (src^=#0) then + dst^:=#0 + else + begin + if len=0 then + len:=high(cardinal); + p:=src; + l:=len; + while (p^<>#0) and (l>0) do + begin + inc(p); dec(l); + end; + l:=p-src; + move(src^, dst^,l); + dst[l]:=#0; + end; + end; + result:=dst; +end; + +function StrCopyW(dst:PWideChar;src:PWideChar;len:cardinal=0):PWideChar; +var + l:cardinal; + p:pWideChar; +begin + if dst<>nil then + begin + if (src=nil) or (src^=#0) then + dst^:=#0 + else + begin + if len=0 then + len:=high(cardinal); + p:=src; + l:=len; + while (p^<>#0) and (l>0) do + begin + inc(p); dec(l); + end; + l:=p-src; + move(src^, dst^,l*SizeOf(WideChar)); + dst[l]:=#0; + end; + end; + result:=dst; +end; + +function StrDelete(aStr:PAnsiChar;pos,len:cardinal):PAnsiChar; +var + i:cardinal; +begin + if len>0 then + begin + i:=StrLen(aStr); + if 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=0):integer; // CompareString +begin + result:=0; + if (a=nil) and (b=nil) then + exit; + if (a=nil) or (b=nil) then + begin + result:=-1; + exit; + end; + repeat + result:=ord(a^)-ord(b^); + if (result<>0) or (a^=#0) then + break; + inc(a); + inc(b); + dec(n); + until n=0; +end; + +function StrCmpW(a,b:PWideChar;n:cardinal=0):integer; +begin + result:=0; + if (a=nil) and (b=nil) then + exit; + if (a=nil) or (b=nil) then + begin + result:=-1; + exit; + end; + repeat + result:=ord(a^)-ord(b^); + if (result<>0) or (a^=#0) then + break; + inc(a); + inc(b); + dec(n); + until n=0; +end; + +function StrEnd(const a:PAnsiChar):PAnsiChar; +begin + result:=a; + if result<>nil then + while result^<>#0 do inc(result); +end; + +function StrEndW(const a:PWideChar):PWideChar; +begin + result:=a; + if result<>nil then + while result^<>#0 do inc(result); +end; + +function StrScan(src:PAnsiChar;c:AnsiChar):PAnsiChar; +begin + if src<>nil then + begin + while (src^<>#0) and (src^<>c) do inc(src); + if src^<>#0 then + begin + result:=src; + exit; + end; + end; + result:=nil; +end; + +function StrRScan(src:PAnsiChar;c:AnsiChar):PAnsiChar; +begin + if src<>nil then + begin + result:=StrEnd(src); + while (result>=src) and (result^<>c) do dec(result); + if 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 StrCatE(Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar; +begin + if Dest<>nil then + result:=StrCopyE(StrEnd(Dest), Source) + else + result:=nil; +end; + +function StrCatEW(Dest: PWideChar; const Source: PWideChar): PWideChar; +begin + if Dest<>nil then + result:=StrCopyEW(StrEndW(Dest), Source) + else + result:=nil; +end; + +function StrPos(const aStr, aSubStr: PAnsiChar): PAnsiChar; +var + Str, SubStr: PAnsiChar; + Ch: AnsiChar; +begin + if (aStr = nil) or (aStr^ = #0) or (aSubStr = nil) or (aSubStr^ = #0) then + begin + Result := nil; + Exit; + end; + Result := aStr; + Ch := aSubStr^; + repeat + if Result^ = Ch then + begin + Str := Result; + SubStr := aSubStr; + repeat + Inc(Str); + Inc(SubStr); + if SubStr^ = #0 then exit; + if Str^ = #0 then + begin + Result := nil; + exit; + end; + if Str^ <> SubStr^ then break; + until (FALSE); + end; + Inc(Result); + until (Result^ = #0); + Result := nil; +end; + +function StrIndex(const aStr, aSubStr: PAnsiChar):integer; +var + p:pAnsiChar; +begin + p:=StrPos(aStr,aSubStr); + if p=nil then + result:=0 + else + result:=p-aStr+1; +end; + +function StrPosW(const aStr, aSubStr: PWideChar): PWideChar; +var + Str, SubStr: PWideChar; + Ch: WideChar; +begin + if (aStr = nil) or (aStr^ = #0) or (aSubStr = nil) or (aSubStr^ = #0) then + begin + Result := nil; + Exit; + end; + Result := aStr; + Ch := aSubStr^; + repeat + if Result^ = Ch then + begin + Str := Result; + SubStr := aSubStr; + repeat + Inc(Str); + Inc(SubStr); + if SubStr^ = #0 then exit; + if Str^ = #0 then + begin + Result := nil; + exit; + end; + if Str^ <> SubStr^ then break; + until (FALSE); + end; + Inc(Result); + until (Result^ = #0); + Result := nil; +end; + +function StrIndexW(const aStr, aSubStr: PWideChar):integer; +var + p:pWideChar; +begin + p:=StrPosW(aStr,aSubStr); + if p=nil then + result:=0 + else + result:=(p-aStr)+1; //!!!! +end; + +// ----- filenames ----- + +function ChangeExt(src,ext:PAnsiChar):PAnsiChar; +var + i,j:integer; +begin + i:=StrLen(src); + j:=i; + while (i>0) and (src[i]<>'\') and (src[i]<>':') and (src[i]<>'.') do dec(i); + if src[i]<>'.' then + begin + i:=j; + src[i]:='.'; + end; + if ext=nil then + ext:=''; + StrCopy(src+i+1,ext); + result:=src; +end; + +function ChangeExtW(src,ext:PWideChar):PWideChar; +var + i,j:integer; +begin + i:=StrLenW(src); + j:=i; + while (i>0) and (src[i]<>'\') and (src[i]<>':') and (src[i]<>'.') do dec(i); + if src[i]<>'.' then + begin + i:=j; + src[i]:='.'; + end; + if ext=nil then + ext:=''; + StrCopyW(src+i+1,ext); + result:=src; +end; + +function Extract(s:PAnsiChar;name:Boolean=true):PAnsiChar; +var + i:integer; +begin + i:=StrLen(s)-1; +// j:=i; + while (i>=0) and ((s[i]<>'\') and (s[i]<>'/')) do dec(i); + if name then + begin + StrDup(result,s+i+1); +// mGetMem(result,(j-i+1)); +// StrCopy(result,s+i+1); + end + else + begin + StrDup(result,s,i+1); + end; +end; + +function ExtractW(s:pWideChar;name:Boolean=true):pWideChar; +var + i:integer; +begin + i:=StrLenW(s)-1; +// j:=i; + while (i>=0) and ((s[i]<>'\') and (s[i]<>'/')) do dec(i); + if name then + begin + StrDupW(result,s+i+1); +// mGetMem(result,(j-i+1)*SizeOf(WideChar)); +// StrCopyW(result,s+i+1); + end + else + begin + StrDupW(result,s,i+1); + end; +end; + +function GetExt(fname,dst:pWideChar;maxlen:dword=100):pWideChar; +var + ppc,pc:PWideChar; +begin + result:=dst; + dst^:=#0; + if fname<>nil then + begin + pc:=StrEndW(fname)-1; + while (pc>fname) and ((pc^='"') or (pc^=' ')) do dec(pc); + ppc:=pc+1; + while (pc>fname) and (pc^<>'.') do + begin + if maxlen=0 then exit; + if not (AnsiChar(pc^) in ['0'..'9','A'..'Z','_','a'..'z']) then exit; + dec(maxlen); + dec(pc); //empty name not allowed! + end; + if pc>fname then + begin + repeat + inc(pc); + if pc=ppc then + begin + dst^:=#0; + break; + end; + if (pc^>='a') and (pc^<='z') then + dst^:=WideChar(ord(pc^)-$20) + else + dst^:=pc^; + inc(dst); + until false; + end; + end; +end; + +function GetExt(fname,dst:PAnsiChar;maxlen:dword=100):PAnsiChar; +var + ppc,pc:PAnsiChar; +begin + result:=dst; + dst^:=#0; + if fname<>nil then + begin + pc:=StrEnd(fname)-1; + while (pc>fname) and ((pc^='"') or (pc^=' ')) do dec(pc); + ppc:=pc+1; + while (pc>fname) and (pc^<>'.') do + begin + if maxlen=0 then exit; + if not (AnsiChar(pc^) in ['0'..'9','A'..'Z','_','a'..'z']) then exit; + dec(maxlen); + dec(pc); //empty name not allowed! + end; + if pc>fname then + begin + repeat + inc(pc); + if pc=ppc then + begin + dst^:=#0; + break; + end; + if (pc^>='a') and (pc^<='z') then + dst^:=AnsiChar(ord(pc^)-$20) + else + dst^:=pc^; + inc(dst); + until false; + end; + end; +end; + +type + PDayTable = ^TDayTable; + TDayTable = array [0..11] of cardinal; + +const + MonthDays: array [Boolean] of TDayTable = + ((31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31), + (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)); + +const + DateDelta = 693594; +{ Days between TDateTime basis (12/31/1899) and Unix time_t basis (1/1/1970) } + UnixDateDelta = 25569; + +function IsLeapYear(Year:Word):Boolean; +begin + Result:=(Year mod 4=0) and ((Year mod 100<>0) or (Year mod 400=0)); +end; + +function EncodeTime(Hour, Minute, Sec: cardinal): TDateTime; +begin + result := (Hour*3600 + Minute*60 + Sec) / 86400; +end; + +function EncodeDate(Year, Month, Day: cardinal):TDateTime; +var + DayTable: PDayTable; +begin + DayTable := @MonthDays[IsLeapYear(Year)]; + dec(Month); + while Month>0 do + begin + dec(Month); + inc(Day,DayTable^[Month]); + end; + + dec(Year); + result := Year * 365 + Year div 4 - Year div 100 + Year div 400 + Day - DateDelta; +end; + +function Timestamp(Year,Month,Day:cardinal;Hour:cardinal=0;Minute:cardinal=0;Sec:cardinal=0):dword; +var + t:tDateTime; +begin + t := EncodeDate(Year, Month, Day); + if t >= 0 then + t := t + EncodeTime(Hour, Minute, Sec) + else + t := t - EncodeTime(Hour, Minute, Sec); + result:=Round((t - UnixDateDelta) * 86400) +end; + +function GetCurrentTime:dword; +var + st:tSystemTime; +begin + GetSystemTime(st); + result:=Timestamp(st.wYear,st.wMonth,st.wDay,st.wHour,st.wMinute,st.wSecond); +end; + +function TimeToInt(stime:PAnsiChar):integer; +var + hour,minute,sec,len,i:integer; +begin + len:=StrLen(stime); + i:=0; + sec :=0; + minute:=0; + hour :=0; + while i'9') then + begin + if minute>0 then + hour:=minute; + minute:=sec; + sec:=0; + end + else + sec:=sec*10+ord(stime[i])-ord('0'); + inc(i); + end; + result:=hour*3600+minute*60+sec; +end; + +function TimeToInt(stime:PWideChar):integer; +var + buf:array [0..63] of AnsiChar; +begin + result:=TimeToInt(FastWideToAnsiBuf(stime,buf)); +end; + +function IntToTime(dst:PAnsiChar;time:integer):PAnsiChar; +var + day,hour,minute,sec:array [0..7] of AnsiChar; + d,h:integer; +begin + result:=dst; + h:=time div 3600; + dec(time,h*3600); + IntToStr(sec,(time mod 60),2); + d:=h div 24; + if d>0 then + begin + h:=h mod 24; + IntToStr(day,d); + dst^:=day[0]; inc(dst); + if day[1]<>#0 then // now only 99 days max + begin + dst^:=day[1]; inc(dst); + end; + dst^:=' '; inc(dst); + end; + if h>0 then + begin + IntToStr(hour,h); + IntToStr(minute,(time div 60),2); + dst^:=hour[0]; inc(dst); + if hour[1]<>#0 then + begin + dst^:=hour[1]; inc(dst); + end; + dst^:=':'; inc(dst); + dst^:=minute[0]; inc(dst); + dst^:=minute[1]; inc(dst); + end + else + begin + IntToStr(minute,time div 60); + dst^:=minute[0]; inc(dst); + if minute[1]<>#0 then + begin + dst^:=minute[1]; inc(dst); + end; + end; + dst^:=':'; inc(dst); + dst^:=sec[0]; inc(dst); + dst^:=sec[1]; inc(dst); + dst^:=#0; +end; + +function IntToTime(dst:pWideChar;time:integer):pWideChar; +var + buf:array [0..63] of AnsiChar; +begin + result:=FastAnsiToWideBuf(IntToTime(buf,time),dst); +end; + +function StrToInt(src:pWideChar):int64; +var + sign:boolean; +begin + result:=0; + if src<>nil then + begin + sign:=src^='-'; + if sign then inc(src); + while src^<>#0 do + begin + if (src^>='0') and (src^<='9') then + result:=result*10+ord(src^)-ord('0') + else + break; + inc(src); + end; + if sign then result:=-result; + end; +end; + +function StrToInt(src:PAnsiChar):int64; +var + sign:boolean; +begin + result:=0; + if src<>nil then + begin + sign:=src^='-'; + if sign then inc(src); + while src^<>#0 do + begin + if (src^>='0') and (src^<='9') then + result:=result*10+ord(src^)-ord('0') + else + break; + inc(src); + end; + if sign then result:=-result; + end; +end; + +function IntToStr(dst:PAnsiChar;Value:int64;Digits:integer=0):PAnsiChar; +var + i:dword; +begin + if Digits<=0 then + begin + if Value<0 then + Digits:=1 + else + Digits:=0; + i:=ABS(Value); + repeat + i:=i div 10; + inc(Digits); + until i=0; + end; + dst[Digits]:=#0; + i:=ABS(Value); + repeat + dec(Digits); + dst[Digits]:=AnsiChar(ord('0')+(i mod 10)); + i:=i div 10; + if (Value<0) and (Digits=1) then + begin + dst[0]:='-'; + break; + end; + until Digits=0; + result:=dst; +end; + +function IntToStr(dst:pWideChar;Value:int64;Digits:integer=0):pWideChar; +var + i:dword; +begin + if Digits<=0 then + begin + if Value<0 then + Digits:=1 + else + Digits:=0; + i:=ABS(Value); + repeat + i:=i div 10; + inc(Digits); + until i=0; + end; + dst[Digits]:=#0; + i:=ABS(Value); + repeat + dec(Digits); + dst[Digits]:=WideChar(ord('0')+(i mod 10)); + i:=i div 10; + if (Value<0) and (Digits=1) then + begin + dst[0]:='-'; + break; + end; + until Digits=0; + result:=dst; +end; + +function HexToInt(src:pWideChar;len:cardinal=$FFFF):int64; +begin + result:=0; + while (src^<>#0) and (len>0) do + begin + if (src^>='0') and (src^<='9') then + result:=result*16+ord(src^)-ord('0') + else if ((src^>='A') and (src^<='F')) then + result:=result*16+ord(src^)-ord('A')+10 + else if ((src^>='a') and (src^<='f')) then + result:=result*16+ord(src^)-ord('a')+10 + else + break; + inc(src); + dec(len); + end; +end; + +function HexToInt(src:PAnsiChar;len:cardinal=$FFFF):int64; +begin + result:=0; + while (src^<>#0) and (len>0) do + begin + if (src^>='0') and (src^<='9') then + result:=result*16+ord(src^)-ord('0') + else if ((src^>='A') and (src^<='F')) then + result:=result*16+ord(src^)-ord('A')+10 + else if ((src^>='a') and (src^<='f')) then + result:=result*16+ord(src^)-ord('a')+10 + else + break; + inc(src); + dec(len); + end; +end; + +function IntToHex(dst:pWidechar;Value:int64;Digits:integer=0):pWideChar; +var + i:dword; +begin + if Digits<=0 then + begin + Digits:=0; + i:=Value; + repeat + i:=i shr 4; + inc(Digits); + until i=0; + end; + dst[Digits]:=#0; + repeat + Dec(Digits); + dst[Digits]:=WideChar(HexDigitChr[Value and $F]); + Value:=Value shr 4; + until Digits=0; + result:=dst; +end; + +function IntToHex(dst:PAnsiChar;Value:int64;Digits:integer=0):PAnsiChar; +var + i:dword; +begin + if Digits<=0 then + begin + Digits:=0; + i:=Value; + repeat + i:=i shr 4; + inc(Digits); + until i=0; + end; + dst[Digits]:=#0; + repeat + Dec(Digits); + dst[Digits]:=HexDigitChr[Value and $F]; + Value:=Value shr 4; + until Digits=0; + result:=dst; +end; + +procedure UpperCase(src:pWideChar); +var + c:WideChar; +begin + if src<>nil then + begin + while src^<>#0 do + begin + c:=src^; + if (c>='a') and (c<='z') then + src^:=WideChar(ord(c)-$20); + inc(src); + end; + end; +end; + +procedure LowerCase(src:pWideChar); +var + c:WideChar; +begin + if src<>nil then + begin + while src^<>#0 do + begin + c:=src^; + if (c>='A') and (c<='Z') then + src^:=WideChar(ord(c)+$20); + inc(src); + end; + end; +end; + +function GetPairChar(ch:AnsiChar):AnsiChar; +begin + case ch of + '[': result:=']'; + '<': result:='>'; + '(': result:=')'; + '{': result:='}'; + else // ' and " too + result:=ch; + end; +end; + +function GetPairChar(ch:WideChar):WideChar; +begin + case ch of + '[': result:=']'; + '<': result:='>'; + '(': result:=')'; + '{': result:='}'; + else // ' and " too + result:=ch; + end; +end; + +function FastWideToAnsiBuf(src:PWideChar;dst:PAnsiChar;len:cardinal=cardinal(-1)):PAnsiChar; +begin + result:=dst; + if src<>nil then + begin + repeat + dst^:=AnsiChar(src^); + if src^=#0 then + break; + dec(len); + if len=0 then + begin + (dst+1)^:=#0; + break; + end; + inc(src); + inc(dst); + until false; + end + else + dst^:=#0; +end; + +function FastWideToAnsi(src:PWideChar;var dst:PAnsiChar):PAnsiChar; +begin + if src=nil then + dst:=nil + else + begin + mGetMem(dst,StrLenW(src)+1); + FastWideToAnsiBuf(src,dst); + end; + result:=dst; +end; + +function FastAnsiToWideBuf(src:PAnsiChar;dst:PWideChar;len:cardinal=cardinal(-1)):PWideChar; +begin + result:=dst; + if src<>nil then + begin + repeat + dst^:=WideChar(src^); + if src^=#0 then + break; + dec(len); + if len=0 then + begin + (dst+1)^:=#0; + break; + end; + inc(src); + inc(dst); + until false; + end + else + dst^:=#0; +end; + +function FastAnsiToWide(src:PAnsiChar;var dst:PWideChar):PWideChar; +begin + if src=nil then + dst:=nil + else + begin + mGetMem(dst,(StrLen(src)+1)*SizeOf(WideChar)); + FastAnsiToWideBuf(src,dst); + end; + result:=dst; +end; + +function isPathAbsolute(path:pWideChar):boolean; +begin + result:=((path[1]=':') and (path[2]='\')) or ((path[0]='\') {and (path[1]='\')}) or + (StrPosW(path,'://')<>nil); +end; + +function isPathAbsolute(path:pAnsiChar):boolean; +begin + result:=((path[1]=':') and (path[2]='\')) or ((path[0]='\') {and (path[1]='\')}) or + (StrPos(path,'://')<>nil); +end; + +procedure ShowDump(ptr:pbyte;len:integer); +var + buf: array of Ansichar; + i:integer; + p:pAnsiChar; + p1:pByte; + cnt:integer; +begin + SetLength(buf,len*4+1); + p:=@buf[0]; + p1:=ptr; + cnt:=0; + for i:=0 to len-1 do + begin + IntToHex(p,p1^,2); + inc(p,2); + inc(p1); + inc(cnt); + if cnt=4 then + begin + cnt:=0; + p^:='.'; + inc(p); + end; + end; + p^:=#0; + messageboxa(0,@buf[0],'',0); +end; +begin + CheckSystem; +end. -- cgit v1.2.3