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/common.pas | 2116 --------------------------------------- 1 file changed, 2116 deletions(-) delete mode 100644 delphi/Awkward/utils/common.pas (limited to 'delphi/Awkward/utils/common.pas') 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. -- cgit v1.2.3