unit UnitMisc;
{
    Purpose:
        "Put all the orphans in one bed"

    Updates:
        Handle error case for WindowHandleToEXEName
        Routine to save the debug log

}

{ TODO: Further optimize log usage - possibly to file }
interface

uses Windows, StrUtils, Tlhelp32, Graphics, Controls, Menus, Classes,
 GraphUtil, SysUtils;

 Type
  TWMSizing = packed record
    msg: Cardinal;
    fwEdge: WPARAM;
    lpRect: PRect;
    Result: Longint;
  end;

procedure MyFree(var o);


function IsUSB : boolean;
function IsRemote : boolean;

function hotKeyName(hotkey : string) : string;

function WindowHandleToEXEName(handle : THandle) : string;
function WindowsHandleToProcessEntry32(handle : THandle) : tagPROCESSENTRY32;
//function DupHandle(h : Thandle; var sizeh : cardinal; SizeLimit : boolean = false) : Thandle;
//procedure AppendLog( s : string; IncludeLastError : boolean = false);
//procedure DumpLog(filename : string);
//procedure ApplicationException(Sender: TObject; E: Exception);
//procedure FlushLog;

procedure MyDestroyIcon(h : HICON);
procedure TimerStart;
procedure TimerEndAt(milliseconds : cardinal);

function GetCliptypeSymbol( Format: Cardinal ) : string;

type TShellExecuteShow = (
    SES_HIDE = 0,
    SES_SHOWNORMAL = 1,
    SES_SHOWMINIMIZED = 2,
    SES_MAXIMIZE = 3,
    SES_SHOWNOACTIVATE  = 4,
    SES_SHOW = 5,
    SES_MINIMIZE = 6,
    SES_SHOWMINNOACTIVE = 7,
    SES_SHOWNA = 8,
    SES_RESTORE = 9,
    SES_SHOWDEFAULT = 10
);
function ShellExecute(F : THandle; command : string; ShowAs : TShellExecuteShow = SES_SHOWNORMAL) : integer;
function RunCommandLine(command : string) : integer;
function RunCommandResultSuccess(cmdResult : integer) : boolean;
function RunCommandResultToSysErrorCode(cmdResult : integer) : integer;

function GetAppPath : string;

function GetCF_HTML : UINT;
function GetCF_RICHTEXT : UINT;

procedure MySleep(milli : integer);


procedure SetDataFolderDefault;
procedure SetDataFolder(folder : string);

//procedure MySetTheme(h : Thandle);
function CloneIcon(inIcon : HICON) : HICON;
function IconCRC(icon : HICON) : cardinal;
function UniSupported : boolean;


//function ThreadAttach(TargetWindow: cardinal) : boolean;
//procedure ThreadDetach();
//function IsThreadAttached : boolean;

//procedure RemoveFocusFromSelf;
function GetNextWindow(start : THandle = 0): THandle;
function GetIconFromBitmap(bm : TBitmap): HICON;

const EXENAME_ERROR = '[error]';
procedure ShowPopupRight(b : TControl; pm : TPopupMenu);
procedure ShowPopupBottom(b : TControl; pm : TPopupMenu);

function Brightness(c : TColor) : integer;
function dimColor(c : TColor; alpha : double = 0.95) : TColor;
function DimColorOrReverse(c : TColor; alpha : double = 0.95) : TColor;
function SetBlueColor(c : TColor; saturation : double) : TColor;
function Blend(Col1, Col2: TColor; Col1AlphaPercent: Byte): TColor;
function BlendOrReverse(BaseColor, BlendColor, ReverseColor: TColor; BaseAlphaPercent: Byte): TColor;

function saturate(c : TColor; percent : double = 0.95) : TColor;

//function ForceForeground(h : THandle; full : boolean = true) : boolean;
function GetAssociation(const filename: string; verb : string = 'open'): string;

procedure CallEventSafe(ne : TNotifyEvent; Sender : TObject);

procedure DrawArrow(c : TCanvas;Direction: TScrollDirection; r : TRect);
type TIntList = class(TList)
protected
    function Get(Index: Integer): Integer; overload;
    procedure Put(Index: Integer; Item: Integer); overload;
public
    function Add(Item: Integer): Integer; overload;
    function IndexOf(Item: Integer): Integer; overload;
    function Remove(Item: Integer): Integer; overload;
    property Items[Index: Integer]:  Integer read Get write Put;  default;
end;

function StrSize(s : string) : cardinal;

//function ClipToString(handle : THandle; size : cardinal) : string; overload;
function ClipToString(p : Pointer; size : Cardinal) : string; overload;
function AnsiClipToString(p : Pointer; size : cardinal) : string;

function DupHandleToPointer(h : Thandle; var sizeh : cardinal; SizeLimit : boolean = false) : Pointer;
function DupPointerToHandle(p : Pointer; sizeh : cardinal) : THandle;
function DupStreamToHandle(s : TStream) : THandle;

procedure ScaleSize(destwd, destht : Integer; var srcwd, srcht : Integer);

//procedure Compress(ins, outs : TStream);
//procedure Decompress(ins, outs : TStream);
procedure CompressZip(ins : TStream; var outs : TStream);
procedure DecompressZip(ins : TStream; var outs : TStream); overload;
procedure DecompressZip(ins : TStream; var outs : TBytes); overload;

procedure LogTimeStart;
procedure LogTimeEnd(s : string);

function Between(value, small, large : integer) : boolean;

function CompactWhitespace(s : string) : string;

function ConvertVitualKey(vk : integer) : char;


function GWLStyleText(i : integer) : string;
function GWLExStyleText(i : integer) : string;

procedure AddShadow(color,mask, shadow : TBitmap);
procedure ToGrayscale(bm : TBitmap; skip : TColor=clNone);
function Convert32bit(bm : TBitmap) : TBitmap;
procedure Desaturate(bm : TBitmap; AlphaPercent : byte; skip : TColor);
function ToMask(bm : TBitmap) : TBitmap;
function IsHiddenCommandPrompt(command : string) : boolean;


function isProgramFilesPath(path : string) : boolean; overload;
function isProgramFilesPath : boolean; overload;


function InputDropdown(
    const ACaption, APrompt: string; AList : array of string;
    var value: string; var AlistIndex : integer
): Boolean;


function VistaOrAbove : boolean;

function PosI(const SubText : string; const Text : string) : integer;


function followLinks(filename : string) : string;
{////////////////////}
{//}implementation{//}
{////////////////////}
uses UnitFrmMainPopup,  Forms,
  UnitFrmClipboardManager, ShellAPI, UnitSpecialPaths, Dialogs,
  UnitPopupGenerate, UnitCRC32,  ImgList, math, Registry, System.UITypes, System.Zip,
  UnitTWideChar, Commctrl, UnitFrmDebug, UnitToken, StdCtrls, UnitThreadAttach;


function followLinks(filename : string) : string;
const STRING_SIZE = 512;
var
    h : THandle;
    TargetName: array [0..STRING_SIZE] of Char;
begin
    result := filename;

    h := CreateFile(PChar(filename), 0, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
    try
        if GetFinalPathNameByHandle(h,TargetName, STRING_SIZE, FILE_NAME_NORMALIZED) > 0 then begin
            result := TargetName;
        end;
    finally
        CloseHandle(h);
    end;
end;
function PosI(const SubText : string; const Text : string) : integer;
begin
    result := Pos(uppercase(SubText),uppercase(text));
end;

function VistaOrAbove : boolean;
begin
    result := (SysUtils.Win32MajorVersion > 5);
end;
function GetAveCharSize(Canvas: TCanvas): TPoint;
var
  I: Integer;
  Buffer: array[0..51] of Char;
begin
    for I := 0 to 25 do
        Buffer[I] := Chr(I + Ord('A'));
    for I := 0 to 25 do
        Buffer[I + 26] := Chr(I + Ord('a'));
    GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
    result.X := result.X div 52;
end;

function InputDropdown(
    const ACaption, APrompt: string; AList : array of string;
    var value: string; var AlistIndex : integer
): Boolean;
var
    i : integer;
  Form: TForm;
  Prompt: TLabel;
  Edit: TComboBox;
  btn : TButton;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
begin
    result := False;
    value := '';
    Form := TForm.Create(Application);
    try
        Form.Canvas.Font := Form.Font;
        DialogUnits := GetAveCharSize(Form.Canvas);
        Form.BorderStyle := bsDialog;
        Form.Caption := ACaption;
        Form.ClientWidth := MulDiv(180, DialogUnits.X, 4);
        Form.Position := poScreenCenter;

        Prompt := TLabel.Create(Form);
        with Prompt do begin
            Parent := Form;
            Caption := APrompt;
            Left := MulDiv(8, DialogUnits.X, 4);
            Top := MulDiv(8, DialogUnits.Y, 8);
            Constraints.MaxWidth := MulDiv(164, DialogUnits.X, 4);
            WordWrap := True;
        end;

        Edit := TComboBox.Create(Form);
        with Edit do begin
            Parent := Form;
            Left := Prompt.Left;
            Top := Prompt.Top + Prompt.Height + 5;
            Width := MulDiv(164, DialogUnits.X, 4);
            MaxLength := 255;
            Text := Value;
            SelectAll;
        end;
        for i := 0 to length(AList)-1 do begin
            edit.items.Add(AList[i]);
        end;

        ButtonTop := Edit.Top + Edit.Height + 15;
        ButtonWidth := MulDiv(50, DialogUnits.X, 4);
        ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
        btn := TButton.Create(Form);
        btn.Parent := Form;
        btn.Caption := 'OK';
        btn.ModalResult := mrOk;
        btn.Default := True;
        btn.SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);


        btn := TButton.Create(Form);

        btn.Parent := Form;
        btn.Caption := 'Cancel';
        btn.ModalResult := mrCancel;
        btn.Cancel := True;
        btn.SetBounds(MulDiv(92, DialogUnits.X, 4), Edit.Top + Edit.Height + 15,
          ButtonWidth, ButtonHeight);
        Form.ClientHeight := btn.Top + btn.Height + 13;


        if (Form.ShowModal = mrOk) then begin
            value := Edit.Text;
            AlistIndex := Edit.ItemIndex;
            result := True;
        end;
    finally
        Form.Free;
    end;
end;

function IsUSB : boolean;
type
    STORAGE_QUERY_TYPE = (
        PropertyStandardQuery = 0, PropertyExistsQuery, PropertyMaskQuery, PropertyQueryMaxDefined
    );
    STORAGE_PROPERTY_ID = (
        StorageDeviceProperty = 0, StorageAdapterProperty
    );
    STORAGE_PROPERTY_QUERY = packed record
        PropertyId: STORAGE_PROPERTY_ID;
        QueryType: STORAGE_QUERY_TYPE;
        AdditionalParameters: array [0..9] of AnsiChar;
    end;
    STORAGE_BUS_TYPE = (
        BusTypeUnknown = 0, BusTypeScsi, BusTypeAtapi, BusTypeAta, BusType1394, BusTypeSsa, BusTypeFibre,
        BusTypeUsb, BusTypeRAID, BusTypeiScsi, BusTypeSas, BusTypeSata, BusTypeMaxReserved = $7F
    );
    STORAGE_DEVICE_DESCRIPTOR = packed record
        Version: DWORD;
        Size: DWORD;
        DeviceType: Byte;
        DeviceTypeModifier: Byte;
        RemovableMedia: Boolean;
        CommandQueueing: Boolean;
        VendorIdOffset: DWORD;
        ProductIdOffset: DWORD;
        ProductRevisionOffset: DWORD;
        SerialNumberOffset: DWORD;
        BusType: STORAGE_BUS_TYPE;
        RawPropertiesLength: DWORD;
        RawDeviceProperties: AnsiChar;
    end;
const
    IOCTL_STORAGE_QUERY_PROPERTY =  $002D1400;
    QUERY_SIZE = 1024;
var
    h: THandle;
    spq: STORAGE_PROPERTY_QUERY;
    size: DWORD;
    Buffer: array [0..QUERY_SIZE-1] of Byte;
    sdd: STORAGE_DEVICE_DESCRIPTOR absolute Buffer;
    errorMode: UINT;
    drive : string ;
begin
    result := false;
    drive := lowercase(GetAppPath);
    drive := ExtractFileDrive(drive);
    if (length(drive) <> 1) then EXIT;

    errorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
    try
        h := CreateFile(
            PChar('\\.\'+drive+':'), 0,
            FILE_SHARE_READ or FILE_SHARE_WRITE,
            nil,
            OPEN_EXISTING, 0, 0
        );
        if h = INVALID_HANDLE_VALUE then EXIT;
        try
            size := 0;
            FillChar(spq, SizeOf(spq), 0);
            FillChar(Buffer, SizeOf(Buffer), 0);
            sdd.Size := SizeOf(Buffer);
            spq.PropertyId := StorageDeviceProperty;
            spq.QueryType := PropertyStandardQuery;
            if DeviceIoControl(
                h, IOCTL_STORAGE_QUERY_PROPERTY,
                @spq, SizeOf(spq),
                @Buffer, sdd.Size, size,
                nil
            ) then begin
                result := (sdd.BusType = BusTypeUsb);
            end;
        finally
            CloseHandle(H);
        end;
    finally
        SetErrorMode(errorMode);
    end;
end;
function IsRemote : boolean;
var
    drive : string;
begin
    result := false;
    drive := lowercase(GetAppPath);
    drive := ExtractFileDrive(drive);
    case (length(drive)) of
    2: begin
        result := GetDriveType(PCHar(GetAppPath)) = DRIVE_REMOTE;
    end;
    else begin
        result := true;
    end;
    end;
end;

function hotKeyName(hotkey : string) : string;
begin
    result := hotkey;
    delete(result,1,6);
end;

function IsHiddenCommandPrompt(command : string) : boolean;
var s : string;
    i : integer;
begin
    //cmd/c
    //cmd.exe /c
    s := lowercase(command);
    s := UnitToken.CutWordExclude(s,' /');

    i :=  pos('/c', command);
    result := StartsText('cmd', command) and
         (i>0) and (i <= length(s) );

    result := result or StartsText('cscript',command);
end;


type
    TPixel32 = packed record
        B: Byte;
        G: Byte;
        R: Byte;
        A: Byte;
    end;
    PPixel32 = ^TPixel32;
    TPixel = packed record
        B: Byte;
        G: Byte;
        R: Byte;
    end;
    PPixel = ^TPixel;
function ToMask(bm : TBitmap) : TBitmap;
var
    x,y : integer;
    p32 : PPixel32;
    trans : TPixel32;
    bm2 : TBitmap;
begin
    result := TBitmap.Create;
    result.Monochrome := true;
    result.Width := bm.Width;
    result.Height := bm.Height;
    bm2 := TBitmap.Create;
    bm2.Assign(bm);
    if bm2.AlphaFormat = afIgnored then begin
//        bm.Canvas.Brush.Color := bm.TransparentColor;
        bm2.Canvas.Brush.Color := clTeal;
        bm2.Canvas.FloodFill(0,31,bm2.canvas.Pixels[0,31], fsSurface);
        trans.A := 0;
        trans.G := GetGValue(bm2.Canvas.Brush.Color);
        trans.B := GetBValue(bm2.Canvas.Brush.Color);
        trans.R := GetRValue(bm2.Canvas.Brush.Color);
    end;


    for y := 0 to bm2.Height-1 do begin
        p32 := bm2.ScanLine[y];
        for x := 0 to bm2.Width-1 do begin
            if bm2.AlphaFormat = afIgnored then begin
                if CompareMem(@trans,p32,sizeof(trans)) then begin
                    result.Canvas.Pixels[x,y] := clwhite;
                end else begin
                    result.Canvas.Pixels[x,y] := clBlack;
                end;
            end else begin
                if (p32.A =0) or
                    ((p32.B=0)and(p32.G=0)and(p32.R=0)and(p32.A<100)) then begin
    //            if (p32.A<50) then begin
                    result.Canvas.Pixels[x,y] := clwhite;
                end else begin
                    result.Canvas.Pixels[x,y] := clblack;
                end;
            end;

            inc(p32);
        end;
    end;
end;
procedure AddShadow(color,mask, shadow : TBitmap);
var
    bm : TBitmap;
    x,y : integer;
    p32 : PPixel32;
begin
    for y := 0 to mask.Height-1 do begin
        p32 := color.ScanLine[y];
        for x := 0 to mask.Width-1 do begin
            if mask.Canvas.Pixels[x,y] = clBlack then begin
                if p32.A=0 then p32.A := $FF;
                if (shadow.Canvas.Pixels[x,y] = clWhite) then begin
                    p32.B := 0;
                    p32.G := 0;
                    p32.R := 0;
                    p32.A := 80;
                end;
            end;
            inc(p32);
        end;
    end;
end;
function Convert32bit(bm : TBitmap) : TBitmap;
var
    x,y : integer;
    p32 : PPixel32;
    p : PPixel;
    cl : TPixel;
begin
    result := TBitmap.Create;
    result.PixelFormat := pf32bit;
    result.TransparentColor := bm.TransparentColor;
    result.Width := bm.Width;
    result.Height := bm.Height;
    result.AlphaFormat := afDefined;
    result.Transparent := true;

    cl.R := GetRValue(bm.TransparentColor);
    cl.G := GetGValue(bm.TransparentColor);
    cl.B := GetBValue(bm.TransparentColor);

    for y := 0 to bm.Height-1 do begin
        p := bm.ScanLine[y];
        p32 := result.ScanLine[y];
        for x := 0 to bm.Width-1 do begin
            p32.B := p.B;
            p32.G := p.G;
            p32.R := p.R;
            p32.A := $FF;
            if CompareMem(p,@cl,sizeof(cl)) then begin
                p32.A := 0;
            end;
            inc(p);
            inc(p32);
        end;
    end;
end;
procedure ToGrayscale(bm : TBitmap; skip : TColor);
type
    TPixel = packed record
        B: Byte;
        G: Byte;
        R: Byte;
    end;
    PPixel = ^TPixel;
var
    x,y : Integer;
    cl : TPixel;
    b : byte;
    p : PPixel;
begin
    cl.r := GetRValue(skip);
    cl.b := GetBValue(skip);
    cl.g := GetGValue(skip);
    if (skip <> clNone) then begin
        for y := 0 to bm.Height - 1 do begin
            p := bm.ScanLine[y];
            for x := 0 to bm.Width - 1 do begin
                if not CompareMem(p, @cl, sizeof(cl))  then begin
                    b := Round((0.299 * p.R) + (0.587 * p.G) + (0.114 * p.B));
                    fillchar(p^, sizeof(TPixel), b);
                end;
                inc(p);
            end;
        end;
    end else begin
        for y := 0 to bm.Height - 1 do begin
            p := bm.ScanLine[y];
            for x := 0 to bm.Width - 1 do begin
                b := Round((0.299 * p.R) + (0.587 * p.G) + (0.114 * p.B));
                fillchar(p^, sizeof(TPixel), b);
                inc(p);
            end;
        end;
    end;
end;

procedure Desaturate(bm : TBitmap; AlphaPercent : byte; skip : TColor);
type
    TPixel = packed record
        B: Byte;
        G: Byte;
        R: Byte;
    end;
    PPixel = ^TPixel;
var
    x,y : Integer;
    cl : TPixel;
    b : byte;
    p : PPixel;
begin
    cl.r := GetRValue(skip);
    cl.b := GetBValue(skip);
    cl.g := GetGValue(skip);
    if (skip <> clNone) then begin
        for y := 0 to bm.Height - 1 do begin
            p := bm.ScanLine[y];
            for x := 0 to bm.Width - 1 do begin
                if not CompareMem(p, @cl, sizeof(cl))  then begin
                    b := Round((0.299 * p.R) + (0.587 * p.G) + (0.114 * p.B));
                    b := trunc(b * (AlphaPercent/100));
                    p.R := trunc( (p.R * (1-(AlphaPercent/100))) + b );
                    p.g := trunc( (p.g * (1-(AlphaPercent/100))) + b );
                    p.b := trunc( (p.b * (1-(AlphaPercent/100))) + b );
                end;
                inc(p);
            end;
        end;
    end else begin
        for y := 0 to bm.Height - 1 do begin
            p := bm.ScanLine[y];
            for x := 0 to bm.Width - 1 do begin
                b := Round((0.299 * p.R) + (0.587 * p.G) + (0.114 * p.B));
                b := trunc(b * (AlphaPercent/100));
                p.R := trunc( (p.R * (1-(AlphaPercent/100)))) + b;
                p.g := trunc( (p.g * (1-(AlphaPercent/100)))) + b;
                p.b := trunc( (p.b * (1-(AlphaPercent/100)))) + b;
                inc(p);
            end;
        end;
    end;
end;


function GWLStyleText(i : integer) : string;
    function IsSet(GWL : integer) : boolean;
    begin
        result := (i and GWL) > 0;
    end;
    procedure AppendIfSet(GWL : Integer; name: string);
    begin
        if IsSet(GWL) then
            result := result + name + ' ';
    end;
begin
    AppendIfSet(WS_BORDER, 'WS_BORDER');
    AppendIfSet(WS_CAPTION, 'WS_CAPTION');
    AppendIfSet(WS_CHILD, 'WS_CHILD');
    AppendIfSet(WS_CHILDWINDOW, 'WS_CHILDWINDOW');
    AppendIfSet(WS_CLIPCHILDREN, 'WS_CLIPCHILDREN');
    AppendIfSet(WS_VSCROLL, 'WS_VSCROLL');
    AppendIfSet(WS_VISIBLE, 'WS_VISIBLE');
    AppendIfSet(WS_TILED, 'WS_TILED');
    AppendIfSet(WS_THICKFRAME, 'WS_THICKFRAME');
    AppendIfSet(WS_TABSTOP, 'WS_TABSTOP');
    AppendIfSet(WS_SYSMENU, 'WS_SYSMENU');
    AppendIfSet(WS_SIZEBOX, 'WS_SIZEBOX');
    AppendIfSet(WS_OVERLAPPED, 'WS_OVERLAPPED');
    AppendIfSet(WS_MINIMIZEBOX, 'WS_MINIMIZEBOX');
    AppendIfSet(WS_MINIMIZE, 'WS_MINIMIZE');
    AppendIfSet(WS_MAXIMIZEBOX, 'WS_MAXIMIZEBOX');
    AppendIfSet(WS_MAXIMIZE, 'WS_MAXIMIZE');
    AppendIfSet(WS_ICONIC, 'WS_ICONIC');
    AppendIfSet(WS_HSCROLL, 'WS_HSCROLL');
    AppendIfSet(WS_GROUP, 'WS_GROUP');
    AppendIfSet(WS_DLGFRAME, 'WS_DLGFRAME');
    AppendIfSet(WS_DISABLED, 'WS_DISABLED');
end;
function GWLExStyleText(i : integer) : string;
    function IsSet(GWL : integer) : boolean;
    begin
        result := (i and GWL) > 0;
    end;
    procedure AppendIfSet(GWL : Integer; name: string);
    begin
        if IsSet(GWL) then
            result := result + name + ' ';
    end;
begin
    AppendIfSet(WS_EX_ACCEPTFILES, 'WS_EX_ACCEPTFILES');
    AppendIfSet(WS_EX_DLGMODALFRAME, 'WS_EX_DLGMODALFRAME');
    AppendIfSet(WS_EX_LAYERED, 'WS_EX_LAYERED');
    AppendIfSet(WS_EX_LAYOUTRTL, 'WS_EX_LAYOUTRTL');
    AppendIfSet(WS_EX_LEFT, 'WS_EX_LEFT');
    AppendIfSet(WS_EX_LEFTSCROLLBAR, 'WS_EX_LEFTSCROLLBAR');
    AppendIfSet(WS_EX_LTRREADING, 'WS_EX_LTRREADING');
    AppendIfSet(WS_EX_MDICHILD, 'WS_EX_MDICHILD');
    AppendIfSet(WS_EX_NOACTIVATE, 'WS_EX_NOACTIVATE');
    AppendIfSet(WS_EX_NOINHERITLAYOUT, 'WS_EX_NOINHERITLAYOUT');
    AppendIfSet(WS_EX_NOPARENTNOTIFY, 'WS_EX_NOPARENTNOTIFY');
//    AppendIfSet(WS_EX_NOREDIRECTIONBITMAP, 'WS_EX_NOREDIRECTIONBITMAP');
    AppendIfSet(WS_EX_RIGHT, 'WS_EX_RIGHT');
    AppendIfSet(WS_EX_RIGHTSCROLLBAR, 'WS_EX_RIGHTSCROLLBAR');
    AppendIfSet(WS_EX_RTLREADING, 'WS_EX_RTLREADING');
    AppendIfSet(WS_EX_STATICEDGE, 'WS_EX_STATICEDGE');
    AppendIfSet(WS_EX_TOOLWINDOW, 'WS_EX_TOOLWINDOW');
    AppendIfSet(WS_EX_TOPMOST, 'WS_EX_TOPMOST');
    AppendIfSet(WS_EX_TRANSPARENT, 'WS_EX_TRANSPARENT');
    AppendIfSet(WS_EX_WINDOWEDGE, 'WS_EX_WINDOWEDGE');
    AppendIfSet(WS_EX_CONTROLPARENT, 'WS_EX_CONTROLPARENT');
    AppendIfSet(WS_EX_CONTEXTHELP, 'WS_EX_CONTEXTHELP');
    AppendIfSet(WS_EX_COMPOSITED, 'WS_EX_COMPOSITED');
    AppendIfSet(WS_EX_CLIENTEDGE, 'WS_EX_CLIENTEDGE');
    AppendIfSet(WS_EX_APPWINDOW, 'WS_EX_APPWINDOW');
end;

function ConvertVitualKey(vk : integer) : char;
var ks : TKeyboardState;
    s : string;
begin
    GetKeyboardState(ks);
    SetLength(s, 2) ;
    result := #0;

    case ToAscii(
        vk,
        MapVirtualKey(vk, 0),
        ks, @s[1], 0
    ) of
        1: result := s[1];
    end;
end;

function CompactWhitespace(s : string) : string;
var
    wc : TWIdeChar;
const
    MIDDLE_DOT = WideChar($B0);
    ELLIPSES = WideChar($2026);
    VERTICAL_ELLIPSES = WideChar($22EE);
    RETURN_SYMBOL = WideChar($23ce);
    SMALL_BOX = WideChar($25A0);     { $25A0 is a nice box }
    SMALL_CIRCLE = WideChar($2022);
    TAB_SYMBOL = WideChar($21D2);      { $27AA is nice $21E8 is ok but too small}
    THIN_SPACE = WideChar($200B);    {200B ZERO WIDTH SPACE}
    NOBREAK_SPACE = WideChar($00A0);
begin
    wc := TWideChar.Create;
    with wc do begin
        AppendUnicode(s);

        Replace(WideChar(#9),WideChar(TAB_SYMBOL));
        {remove LF, replace CR}
        Replace(WideString(WideChar(#13)), WideString(SMALL_CIRCLE+THIN_SPACE));
        Replace(WideChar(#10),WideChar(0));
        {replace space streams with ellipses}
        while Pos('   ',PChar(wc.Memory)) > 0 do begin
            Replace(WideString('   '),WideString('  '), true);
        end;
        Replace(WideString('  '), WideString(WideChar(ELLIPSES)), true);
        Replace(WideChar(' '), NOBREAK_SPACE);

        result := wc.GetString;

        myfree(wc);
    end;
end;

function Between(value, small, large : integer) : boolean;
begin
    result := (value >= small) and (value <= large);
end;


var c : cardinal;
procedure LogTimeStart;
begin
    c := Windows.GetTickCount;
end;
procedure LogTimeEnd(s : string);
begin
    FrmDebug.AppendLog(s + ' TimeMS= ' + IntToSTr(Windows.GetTickCount - c));
    LogTimeStart;
end;



procedure CompressZip(ins : TStream; var outs : TStream);
var z : TZipFile;
begin

    z := TZipfile.create;
//    ms := TMemoryStream.Create;
//    ms.Position := 0;
    z.Open(outs, zmWrite);
    z.Add(ins,'test',zcDeflate);
    z.Close;
    //outs.CopyFrom(ms, 0);

//    myfree(ms);
    myfree(z);
end;
procedure DecompressZip(ins : TStream; var outs : TStream);
var z : TZipFile;
    lh : TZipHeader;
begin
    z := TZipfile.create;
    ins.Position := 0;
    z.Open(ins, zmRead);
    outs.Position := 0;

    z.Read('test', outs, lh);
    z.Close;
    myfree(z);
end;

procedure DecompressZip(ins : TStream; var outs : TBytes);
var z : TZipFile;


begin
    z := TZipfile.create;
    ins.Position := 0;

    z.Open(ins, zmRead);

    z.Read('test', outs);
    z.Close;
    myfree(z);
end;

{
procedure Compress(ins, outs : TStream);
var
    z : TCustomZLibStream;
begin
    ins.Position := 0;
    outs.Size := 0;
    z := TCompressionStream.Create(clFastest, outs);
    try
        z.CopyFrom(ins, 0);
    finally
        z.Free;
    end;
end;
procedure Decompress(ins, outs : TStream);
var
    z: TCustomZLibStream;
begin
     ins.Position := 0;
     outs.Size := 0;
     z := TDecompressionStream.Create(ins);
     try
        outs.CopyFrom(z, 0);
     finally
        z.Free;
     end;
end;
}

procedure ScaleSize(destwd, destht : Integer; var srcwd, srcht : Integer);
var iw, ih, iratio : double;
begin
    iw :=  destwd / srcwd;
    ih :=  destht / srcht;

    iratio := min(iw, ih);
    if iratio > 1 then iratio := 1.0;

    srcwd := round(srcwd * iratio);
    srcht := round(srcht * iratio)
end;

function AnsiClipToString(p : Pointer; size : cardinal) : string;
var
	pwc : PAnsiChar;
begin
    Windows.SetLastError(ERROR_SUCCESS);
    if size = 0 then EXIT;

    pwc := p;
    if (pwc <> nil) then begin
        result := string(pwc);
    end;
end;

function ClipToString(p : Pointer; size : Cardinal) : string;
var
	pwc : PWideChar;
begin
    Windows.SetLastError(ERROR_SUCCESS);
    if size = 0 then EXIT;

    pwc := p;
    if (pwc <> nil) then begin
        result := pwc;
    end;
end;

function StrSize(s : string) : cardinal;
begin
    result := length(s) * sizeof(char);
end;

procedure CallEventSafe(ne : TNotifyEvent; Sender : TObject);
begin
    if assigned(ne) then ne(Sender);
end;
procedure DrawArrow(c : TCanvas;Direction: TScrollDirection; r : TRect);
var

    pt : array[0..3] of TPoint;
    OldWidth : Integer;
    OldColor : TColor;
    function FudgeMiddle(x,y:integer) : integer;
    begin
        result := (x+y) div 2;

        if odd(x+y) then begin
        case direction of
        sdLeft:
            result := (x+y) div 2+1;
        sdRight:
            result := (x+y) div 2+1;
        sdUp:
            result := (x+y) div 2+1;
        sdDown:
            result := (x+y) div 2+1;
        end;
        end;
    end;
begin
    if c = nil then exit;
    OldColor := c.Brush.Color;
    c.Brush.Color := c.Pen.Color;

    case Direction of
    sdLeft: begin
        pt[0] := r.BottomRight;
        pt[1] := pt[0];
        pt[1].Y := r.Top;
        pt[2] := point(r.Right, (r.top+r.bottom) div 2);
        pt[3] := point(r.Right, fudgemiddle(r.top,r.bottom));
    end;
    sdRight: begin
        pt[0] := r.topleft;
        pt[1] := pt[0];
        pt[1].Y := r.bottom;
        pt[2] := point(r.Right, (r.top+r.bottom) div 2);
        pt[3] := point(r.left, fudgemiddle(r.top,r.bottom));
    end;
    sdUp: begin
        pt[0] := r.bottomright;
        pt[1] := pt[0];
        pt[1].X := r.left;
        pt[2] := point(fudgemiddle(r.left,r.right), r.top);
        pt[3].Y := r.top;
        pt[3].X := (r.left+r.Right) div 2;
    end;
    sdDown: begin
        pt[0].y := r.Top;
        pt[0].X := r.left;
        pt[1].y := r.top;
        pt[1].X := r.right;
        pt[2].y := r.bottom;
        pt[2].X := fudgemiddle(r.left,r.Right);
        pt[3].Y := r.bottom;
        pt[3].X := (r.Left+r.Right) div 2;
    end;
    end;

    with c do begin
        OldWidth := Pen.Width;
        Pen.Width := 1;
        Polygon(pt);
        Pen.Width := OldWidth;
        Brush.Color := OldColor;
     end;
end;


function BlendOrReverse(BaseColor, BlendColor, ReverseColor: TColor; BaseAlphaPercent: Byte): TColor;
begin
    result := Blend(BaseColor, BlendColor, BaseAlphaPercent);
    if result = BaseColor then begin
        result := Blend(BaseColor, ReverseColor, BaseAlphaPercent);
    end;
end;
function Blend(Col1, Col2 : TColor; Col1AlphaPercent : Byte): TColor;
var
    ra, ga, ba : integer;
    percent : double;
begin
    percent := Col1AlphaPercent/100;

    Col1 := ColorToRGB(Col1);
    Col2 := ColorToRGB(Col2);

    ra := round(GetRValue(Col1)*percent  + GetRValue(Col2)*(1-percent));
    ga := round(GetGValue(Col1)*percent  + GetGValue(Col2)*(1-percent));
    ba := round(GetBValue(Col1)*percent  + GetBValue(Col2)*(1-percent));


    result := RGB(byte(ra and $FF), byte(ga and $FF), byte(ba and $FF));
end;
function SetBlueColor(c : TColor; saturation : double) : TColor;
var r,g,b : byte;
begin
    c := ColorToRGB(c);
    r := GetRValue(c);
    g := GetGValue(c);
    b := GetBValue(c);

    result := RGB(
        min(r,255),
        min(g,255),
        min(trunc( b * saturation),255)
    );

end;


function Brightness(c : TColor) : integer;
var r,g,b : byte;
begin
    c := ColorToRGB(c);
    r := GetRValue(c);
    g := GetGValue(c);
    b := GetBValue(c);

    Result := round(
        (r+g+b) / 3 / 255 * 100
    );
end;

function GetAssociation(const filename: string; verb : string = 'open'): string;
var
    FileClass, s : string;
    Reg: TRegistry;
begin
    Result := '';
    Reg := TRegistry.Create(KEY_EXECUTE);

    // First, try the user's OpenWith choice
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKeyReadOnly(
        'Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\' +
        ExtractFileExt(filename) + '\UserChoice'
    ) then begin
        s := Reg.ReadString('Progid');
        Reg.CloseKey;

        Reg.RootKey := HKEY_CURRENT_USER;
        if Reg.OpenKeyReadOnly('Software\Classes\' + s+ '\Shell\' + verb + '\command')  then begin
            result := Reg.ReadString('');
            Reg.CloseKey;
        end;
        // go ahead and let an Open override any system set associations
        if result = '' then begin
            Reg.RootKey := HKEY_CURRENT_USER;
            if Reg.OpenKeyReadOnly('Software\Classes\' + s+ '\Shell\Open\command')  then begin
                result := Reg.ReadString('');
                Reg.CloseKey;
            end;
        end;

    end;
    if result <> '' then EXIT;



    Reg.RootKey := HKEY_CLASSES_ROOT;
    FileClass := '';
    if Reg.OpenKeyReadOnly(ExtractFileExt(filename)) then begin
        FileClass := Reg.ReadString('');
        Reg.CloseKey;
    end;
    if FileClass <> '' then begin
        if Reg.OpenKeyReadOnly(FileClass + '\Shell\'+verb+'\Command') then begin
            Result := Reg.ReadString('');
            Reg.CloseKey;
        end;
    end;
    Reg.Free;
end;




function saturate(c : TColor; percent : double = 0.95) : TColor;
var h,l,s : word;
begin
    c := ColorToRGB(c);
    {HLS is ranged 0..240}
    GraphUtil.ColorRGBToHLS(c, h,l,s);
    s := round(
        percent * 240
    );
    s := min(s, 240);
    result := GraphUtil.ColorHLSToRGB(h,l,s);
end;
function dimColor(c : TColor; alpha : double = 0.95) : TColor;
var
    r,g,b: byte;
    function AlterChannel(c : byte; alpha : double) : byte;
    var r : double;
    const MINVAL = 15;  // this keeps a 0 value from not being able to increase in value
    begin
        if c < MINVAL then begin
            r := (( (c+MINVAL)/255 - (1-alpha)) * 255);
            r := r - MINVAL;
        end else begin
            r := (( c/255 - (1-alpha)) * 255);
            if r < 0 then begin
                r := $0;
            end else if r > $FF then begin
                r := $FF;
            end else begin

            end;
        end;
        result := Max(0,round(r));
    end;
begin
    if (alpha < 1.0) and (Brightness(c) < 15) then begin
        result := colortorgb(clBLack);
        EXIT;
    end;
    if (alpha > 1.0) and (Brightness(c) > 97) then begin
        result := ColorToRGB(clWhite);
        EXIT;
    end;


    {Luminance Y = 0.33 R + 0.5 G + 0.16 B }
    {in percentages 66  / 100 / 32}
    {percentage boost needed 44 / 0 / 78}

    {add a very small boost to the lower luminance channels}
    c := ColorToRGB(c);
    r := AlterChannel(GetRValue(c), alpha * 1.0044);
    g := AlterChannel(GetGValue(c), alpha * 1.00);
    b := AlterChannel(GetBValue(c), alpha * 1.0078);

    result := RGB(r,g,b);
end;

function DimColorOrReverse(c : TColor; alpha : double = 0.95) : TColor;
var
    r,g,b: byte;
    function AlterChannel(c : byte; alpha : double) : byte;
    var r : double;
    const MINVAL = 20;  // this keeps a 0 value from not being able to increase in value
    begin
        if c < MINVAL then begin
            r := (( (c+MINVAL+10)/255 - (1-alpha)) * 255);
            r := r - MINVAL;
        end else begin
            r := (( c/255 - (1-alpha)) * 255);
            if r < 0 then begin
                r := $0;
            end else if r > $FF then begin
                r := $FF;
            end else begin

            end;
        end;
        result := Max(0,round(r));
    end;
var i : integer;
    d : Double;
begin
    c := ColorToRGB(c);

    i := Brightness(c) div 10;
    case i of
    0: begin
        alpha := 1 - ((1 - alpha )*4);
    end;
    1: begin
        alpha := 1 - ((1 - alpha )*2.5);
    end;
    2: begin
        alpha := 1 - ((1 - alpha )*1.5);
    end;
    3: begin
        alpha := 1 - ((1 - alpha )*1.2);
    end;
    4,5,6: begin
        alpha := 1 - (1-alpha) * 1;
    end;
    7,8: begin
        alpha := 1 - (1-alpha) * 0.9;
    end;
    9,10: begin
            alpha := 1 + (alpha - 1) * 2.8;
    end;
    end;




    {Luminance Y = 0.33 R + 0.5 G + 0.16 B }
    {in percentages 66  / 100 / 32}
    {percentage boost needed 44 / 0 / 78}

    {add a very small boost to the lower luminance channels}
    r := GetRValue(c);
    g := GetGValue(c);
    b := GetbValue(c);
    r := AlterChannel(r, alpha * 1.0044);
    g := AlterChannel(g, alpha * 1.00);
    b := AlterChannel(b, alpha * 1.0078);

    result := RGB(r,g,b);

    d := max(0,Brightness(result)) / max(1,Brightness(c));
    if (alpha>1) and (Abs(1-alpha)>d) then begin // not bright enough
        result := dimColor(c, 1-(alpha-1)); // decrease instead
    end else if (alpha<1) and (Abs(1-alpha)>d) then begin // not dark enough
        result := dimColor(c, 1+(1-alpha)); // increase instead
    end;
end;

procedure ShowPopupBottom(b : TControl; pm : TPopupMenu);
var p : TPoint;
begin
    p := b.ClientToScreen(point(0, b.height));
    pm.Popup(p.x, p.y);
end;
procedure ShowPopupRight(b : TControl; pm : TPopupMenu);
var p : TPoint;
begin
    p := b.ClientToScreen(point(b.width, 0));
    pm.Popup(p.x, p.y);
end;

function GetIconFromBitmap(bm : TBitmap): HICON;
var i : TIcon;
    il : TImageList;
begin
    i := TIcon.Create;
    il := TImageList.CreateSize(bm.Width, bm.Height);
    il.AddMasked(bm, bm.TransparentColor);
    il.GetIcon(0, i);
    result := UnitMisc.CloneIcon(i.handle);
    il.Free;
    i.free
end;


//var ThreadAttached : boolean;
//    ThreadTarget : THandle;
//    ThreadOurs : THandle;
//
//function ThreadAttach(TargetWindow: cardinal) : boolean;
//begin
//    If (ThreadAttached) then begin
//        showmessage('Error: Thread already attached');
//        //self.Close;
//    end;
//
//    ThreadTarget := Windows.GetWindowThreadProcessId(TargetWindow, nil);
//    ThreadOurs := Windows.GetCurrentThreadId();
//    if (ThreadTarget <> ThreadOurs) then begin
//        result := Windows.AttachThreadInput(ThreadTarget, ThreadOurs, true);
//    end else begin
//        result := true;
//    end;
//    ThreadAttached := result;
//end;
//procedure ThreadDetach();
//begin
//    if (ThreadTarget <> ThreadOurs) then begin
//        Windows.AttachThreadInput(ThreadTarget, ThreadOurs, false);
//    end;
//    ThreadAttached := false;
//end;
//function IsThreadAttached : boolean;
//begin
//    result := ThreadAttached;
//end;


function IconCRC(icon : HICON) : cardinal;
var b : TBitmap;
    ms : TMemoryStream;

    crc : TCRC32;
    info : _ICONINFO;
    buff : array of byte;


    i : integer;
begin
    b := TBitmap.Create;
    ms := TMemoryStream.create;
    crc := TCRC32.Create;
    // convert icon to buffer
    Windows.GetIconInfo(icon, info);
    b.Handle := info.hbmColor;
    b.SaveToStream(ms);
    SetLength(buff, ms.size);
    ms.Seek(0, soFromBeginning);
    ms.Read(buff[0], ms.size);
    result := 0;
    // buffer to CRC to index in file
    for I := low(buff) to high(buff) do begin
        result := crc.Update(buff[i]);
    end;

    DeleteObject(info.hbmMask);
    DeleteObject(Info.hbmColor);

    myfree(crc);
    myfree(ms);    
    myfree(b);
end;





function GetNextWindow(start : THandle = 0): THandle;
var h : THandle;
begin
    if start = 0 then
        h := Windows.GetForegroundWindow
    else
        h := start;

    result := 0;

    if (h = 0) then begin
        FrmDebug.AppendLog('Can''t get foreground window', true);
        exit;
    end;
    h := Windows.GetNextWindow(h, GW_HWNDNEXT);
    if (h = 0) then begin
        FrmDebug.AppendLog('Can''t get next window', true);
        exit;
    end;

    while (not Windows.IsWindowVisible(h)) and (h <> 0) do begin
        h := Windows.GetNextWindow(h, GW_HWNDNEXT);
        if (h = 0) then begin
            FrmDebug.AppendLog('Can''t get next window in loop', true);
            exit;
        end;
    end;

    result := h;
end;

function UniSupported : boolean;
begin
    result := lo(Windows.GetVersion)>=5;
end;

function CloneIcon(inIcon : HICON) : HICON;
    var hIconNew : HICON;
        info : _ICONINFO;
    begin
        result := 0;

        // info from PCMagazine's TrayManager
        // Get information about the specified icon
        // Create a clone of the icon

        if (not Windows.GetIconInfo(inIcon, info)) then begin
            FrmDebug.AppendLog('clone icon: ' + SysErrorMessage(GetLastError));
            EXIT;
        end;

        hIconNew := Windows.CreateIconIndirect(info);
        if (hIconNew = 0) then begin
            FrmDebug.AppendLog('CreateIconIndirect failed: ' + SysErrorMessage(GetLastError));
        end;

        // Delete the info item's bitmaps -- otherwise we get a very
        // ugly memory leak
        if (not Windows.DeleteObject(info.hbmMask)) then begin
            FrmDebug.AppendLog('DeleteObject failed: ' + SysErrorMessage(GetLastError));
        end;
        if (not Windows.DeleteObject(info.hbmColor)) then begin
            FrmDebug.AppendLog('DeleteObject failed: ' + SysErrorMessage(GetLastError));
        end;
        result := hIconNew;
    end;

function RunCommandResultSuccess(cmdResult : integer) : boolean;
begin
    result := cmdResult > 0;
end;

function RunCommandResultToSysErrorCode(cmdResult : integer) : integer;
begin
    result := cmdResult * -1;
end;
function RunCommandLine(command : string) : integer;
var  StartInfo  : _StartupInfo;
     ProcInfo   : _PROCESS_INFORMATION;
     b : boolean;
    i : integer;

begin
    // nil for the program name treats the program name
    // as a command line to execute
    FillChar(StartInfo, SizeOf(StartInfo), #0);
    FillChar(ProcInfo, SizeOf(ProcInfo), #0);
    StartInfo.cb := SizeOf(TStartupInfo);

    // detect command prompt, and hide unless "keep open" is used
    if IsHiddenCommandPrompt(command) then begin
        StartInfo.dwFlags := StartInfo.dwFlags or STARTF_USESHOWWINDOW;
        StartInfo.wShowWindow := SW_HIDE;
    end;

    i := Windows.GetLastError;
    if (i<>0) then Windows.SetLastError(NO_ERROR);
    result := 0;
    b := CreateProcess(nil, PChar(command),
                nil, nil, False,
                CREATE_NEW_PROCESS_GROUP or NORMAL_PRIORITY_CLASS or  CREATE_NO_WINDOW,
                nil, nil, StartInfo, ProcInfo);
    i := Windows.GetLastError;

    // > 0 is success
    // < 0 is Win32 error
    // 0 is failed to run with no
    if (i <> 0)then begin
        result := i*-1;
    end else if (not b) then begin
        result := 0;
    end else begin
        result := ProcInfo.hProcess;
    end;
end;
function ShellExecute(F : THandle; command : string; ShowAs : TShellExecuteShow = SES_SHOWNORMAL) : integer;
var s : string;
    i : integer;
begin
    Windows.SetLastError(ERROR_SUCCESS);
    //
    // try to run it as a mail address if it fails
    // the first time - report any error otherwise

    // trim any whitespace - CRLFs
    s := trim(command);
    result := 0;
    if s = '' then EXIT;

    while CharInSet(s[length(s)],[#13, #10]) do begin
        s := Copy(s, 1, length(s) - 1);
    end;

    i := ShellAPI.ShellExecute(F,nil,
        PChar(s),nil,nil,Integer(ShowAs));
    if (i <= 32) then begin

        if (pos('@',s) <> 0) then begin
            s := 'mailto:' + s;
            i := shellAPI.ShellExecute(F,nil,
                PChar(s),nil,nil, Integer(ShowAs));
        end;
    end;

    result := i;
    if (i <= 32) then begin
        result := RunCommandLine(s);

        if not (ShowAs in [SES_SHOWNOACTIVATE,SES_SHOWNA,SES_SHOWMINNOACTIVE,SES_MINIMIZE]) then begin
            Windows.SetForegroundWindow(F);
        end;
    end;
end;


procedure MySleep(milli : integer);
var j : integer;
begin
    j := 0;
    while (j < milli) do begin
        if ((j mod 100)=0) then Application.ProcessMessages;
        sleep(20);
        if (Application.Terminated) then EXIT;
        inc(j, 20);
    end;
end;


var AppendCount : cardinal;
var AppendStr : string;
var TimerSnapshot : cardinal;
var AppPath : string;

var MyCF_HTML, MyCF_RICHTEXT : UINT;

function GetCF_HTML : UINT;
begin
    if MyCF_HTML = 0 then begin
        MyCF_HTML := RegisterClipboardFormat('HTML Format');
    end;
    result := MyCF_HTML;
end;
function GetCF_RICHTEXT : UINT;
begin
    if MyCF_RICHTEXT = 0 then begin
        MyCF_RICHTEXT := RegisterClipboardFormat('Rich Text Format');
    end;

    result := MyCF_RICHTEXT;
end;

function isProgramFilesPath : boolean;
begin
    result := isProgramFilesPath(GetAppPath);
end;
function isProgramFilesPath(path : string) : boolean;
begin
    result := (Pos('Program Files' ,ExtractFileDir(path)) > 0);
end;

function GetAppPath : string;
var par : string;
	i : integer;
    found : boolean;
begin
    if AppPath = '' then begin
        par := '';
        found := false;
        for i := 1 to ParamCount do begin
            if (lowercase(ParamStr(i)) = '-data') then begin
                UnitMisc.SetDataFolderDefault;
                found := true;
                BREAK;
            end;
        end;

        if not found then begin
            AppPath := IncludeTrailingPathDelimiter(
                ExtractFilePath(Application.ExeName)
            );
            found := FileExists(appPath+'arsclip.ini');

            if (not found) and isProgramFilesPath(AppPath) then begin
                UnitMisc.SetDataFolderDefault;
            end;
        end;
    end;
    result := AppPath;
end;
procedure SetDataFolderDefault;
begin
    AppPath := IncludeTrailingPathDelimiter(SpecialPaths.GetAppDataPath) + 'Arsclip\';
    ForceDirectories(AppPath);
end;
procedure SetDataFolder(folder : string);
begin
    AppPath := IncludeTrailingPathDelimiter(folder);
end;

procedure TimerStart;
begin
    TimerSnapshot := Windows.GetTickCount;
end;
procedure TimerEndAt(milliseconds : cardinal);
begin
    while (Windows.GetTickCount - TimerSnapshot) < milliseconds do begin
        // this procedures purposely stalls the program, so ProcessMessages
        // is NOT used here
    end;
end;

//
// I want "free" object references to be nil for easy testing
// Notes: The .Free documenation is very misleading, this function
// make it 100% clear
//
// - Free only if not null
// - Make null when freed
//

procedure MyFree(var o);
begin
    if (Pointer(o) <> nil) then begin
        TObject(o).free;
        Pointer(o) := nil;
    end;
end;
procedure MyDestroyIcon(h : HICON);
begin
    if (h <> 0) then begin
//        FrmDebug.AppendLog('^DestroyIcon^');
        if not Windows.DestroyIcon(h) then begin
            FrmDebug.AppendLog('Icon not destroyed', true);
        end;
    end;
end;

//
// Only returns Empty String when the handle is not found,
// not on an error
//

function WindowsHandleToProcessEntry32(handle : THandle) : tagPROCESSENTRY32;
var snap : THandle;
    pe : tagPROCESSENTRY32;
    pid : cardinal;
    found : boolean;
begin
    Windows.SetLastError(ERROR_SUCCESS);
    FillChar(result, sizeof(result), #0);
    if (handle = 0) then begin
        EXIT;
    end;

    snap := TLHelp32.CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    if (snap = Cardinal(-1)) then begin
        //result := EXENAME_ERROR;
        EXIT;
    end;

    Windows.GetWindowThreadProcessId(handle, pid);
    pe.dwSize := Sizeof(pe);
    found := TLHelp32.Process32First(snap, pe);

    while found do begin
        if (pe.th32ProcessID = pid) then begin
            result := pe;
            break;
        end;

        found := TLHelp32.Process32Next(snap, pe);
    end;
    CloseHandle(snap);
end;
function WindowHandleToEXEName(handle : THandle) : string;
var snap : THandle;
    pe : tagPROCESSENTRY32;
    pid : cardinal;
    found : boolean;
begin
    Windows.SetLastError(ERROR_SUCCESS);

    result := '';
    if (handle = 0) then begin
        EXIT;
    end;
    snap := TLHelp32.CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    if (snap = Cardinal(-1)) then begin
        result := EXENAME_ERROR;
        EXIT;
    end;

    Windows.GetWindowThreadProcessId(handle, pid);
    pe.dwSize := Sizeof(pe);
    found := TLHelp32.Process32First(snap, pe);

    while found do begin
        if (pe.th32ProcessID = pid) then begin
            result := String(pe.szExeFile);
            break;
        end;

        found := TLHelp32.Process32Next(snap, pe);
    end;
    CloseHandle(snap);
end;


function DupPointerToHandle(p : Pointer; sizeh : cardinal) : THandle;
var p2 : Pointer;
begin
    result := Windows.GlobalAlloc(GMEM_MOVEABLE, sizeh);
    p2 := Windows.GlobalLock(result);
    MoveMemory(p2,p,sizeh);
    Windows.GlobalUnlock(result);
end;
function DupStreamToHandle(s : TStream) : THandle;
var p2 : Pointer;
    sz : Int64;
begin
    sz := s.Size;
    s.Position := 0;
    result := Windows.GlobalAlloc(GMEM_MOVEABLE, sz);
    p2 := Windows.GlobalLock(result);
    s.Read(p2^, sz);
    Windows.GlobalUnlock(result);
end;

function DupHandleToPointer(h : Thandle; var sizeh : cardinal; SizeLimit : boolean = false) : Pointer;
var
    sz : Cardinal;
    p1 : pointer;

begin
    Windows.SetLastError(ERROR_SUCCESS);

    result := nil;
    if (h = 0) then begin
        FrmDebug.AppendLog('<DupHandle - Empty handle>');
        EXIT;
    end;

    // make sure size is non-zero
    // and not bigger than size restrictions
    sz := Windows.GlobalSize(h);
    if (sz = 0) then begin
        FrmDebug.AppendLog('<DupHandle - GlobalSize failed >', true);
        sizeh := 0;
        EXIT;
    end;

    // abort if too big
    // make sure to return size of item
    if (SizeLimit) and (sz > sizeh) then begin
        FrmDebug.AppendLog('<DupHandle - too big, size limit>');
        sizeh := sz;
        EXIT;
    end else begin
        sizeh := sz;
    end;

    // Lock and copy
    GetMem(result, sizeh);
    p1 := Windows.GlobalLock(h);
    if (p1 = nil) then begin
        FrmDebug.AppendLog('<DupHandle lock1 >', true);
        EXIT;
    end;
    MoveMemory(result, p1, sizeh);


    Windows.GlobalUnlock(h);
end;
function DupHandle(h : Thandle; var sizeh : cardinal; SizeLimit : boolean = false) : Thandle;
var sz : Cardinal;
    newh : Thandle;
    p1, p2 : pointer;
begin
    Windows.SetLastError(ERROR_SUCCESS);

    result := 0;
    if (h = 0) then begin
        FrmDebug.AppendLog('<DupHandle - Empty handle>');
        EXIT;
    end;
    //
    // make sure size is non-zero
    // and not bigger than size restrictions
    //
    sz := Windows.GlobalSize(h);
    if (sz = 0) then begin
        FrmDebug.AppendLog('<DupHandle - GlobalSize failed >', true);
        sizeh := 0;
        EXIT;
    end;

    // abort if too big
    // make sure to return size of item
    if (SizeLimit) and (sz > sizeh) then begin
        FrmDebug.AppendLog('<DupHandle - too big, size limit>');
        sizeh := sz;
        EXIT;
    end else begin
        sizeh := sz;
    end;

    //
    // Lock and copy
    //

    newh := Windows.GlobalAlloc(GMEM_MOVEABLE, sizeh);
    if (newh=0) then begin
        FrmDebug.AppendLog('<DupHandle - GlobalAlloc failed >', true);
        EXIT;
    end;
    p1 := Windows.GlobalLock(newh);
    if (p1=nil) then begin
        FrmDebug.AppendLog('<DupHandle lock1 >', true);
        EXIT;
    end;

    p2 := Windows.GlobalLock(h);
    if (p2=nil) then begin
        Windows.GlobalUnlock(newh);
        FrmDebug.AppendLog('<DupHandle lock2 >', true);
        EXIT;
    end;

    MoveMemory(p1, p2, sizeh);

    //
    // This should never occur, maybe hardware failure might cause this
    //
//    b := CompareMem(p1, p2, sizeh);
//    AppendLog('<DupHandle compare=>' + BoolToStr(b));
//    if ( not b) then begin
//        Application.ShowException(Exception.Create('DupHandle - Failed to copy memory'));
//        Application.Terminate;
//    end;


    Windows.GlobalUnlock(h);
    Windows.GlobalUnlock(newh);

    result := newh;
end;

{
procedure AppendLog( s : string; IncludeLastError : boolean = false);
begin
    if (IncludeLastError) then begin
        s := s + ' : ' + SysErrorMessage(GetLastError);
    end;
    if (AppendStr = '') then begin
        AppendStr := TimeToStr(Now) + ': ' + s;
    end else begin
        AppendStr :=  TimeToStr(Now) + ': ' + s +  #13#10 + AppendStr;
    end;


    AppendCount := (AppendCount + 1) mod 5;
    if (AppendCount = 0) then begin
        if Assigned(FrmMainPopup) then begin
            FrmMainPopup.AppendLogControl(AppendStr);
        end else begin
            AppendStr := TimeToStr(Now) + ': Main for not created' + #13#10 + AppendStr;
        end;
        AppendStr := '';
    end;

    //showmessage(s);
end;
procedure FlushLog;
begin
    FrmMainPopup.AppendLogControl(AppendStr);
    Application.ProcessMessages;
    AppendCount := 0;
end;
procedure ApplicationException(Sender: TObject; E: Exception);
begin
    FlushLog;
    AppendLog(e.Message);
    DumpLog('Debug.txt');

    Windows.SetLastError(ERROR_SUCCESS);
    ShowMessage(
        e.Message + #13#10 +
        '[Debug.txt] log created.'
    );
end;
procedure DumpLog(filename : string);
begin
    FlushLog;
    filename := UnitMisc.GetAppPath + filename;

    FrmMainPopup.Memo1.Lines.SaveToFile(filename);
end;
}
function GetCliptypeSymbol(Format : Cardinal) : string;
begin
    case Format of
        CF_UNICODETEXT : begin
            result := '[U]';
        end;
        CF_HDROP : begin
            result := '[F]' ;
        end;
        CF_TEXT : begin
            result := '[T]' ;
        end;
        CF_DIB : begin
            result := '[P]' ;
        end;
    end;
    if (Format = UnitMisc.GetCF_RICHTEXT) then begin
        result := '[R]' ;
    end else if (Format = UnitMisc.GetCF_HTML) then begin
        result := '[H]' ;
    end;
end;


{ TIntList }
function TIntList.Add(Item: Integer): Integer;
begin
    result := inherited Add(Pointer(item));
end;
function TIntList.Get(Index: Integer): Integer;
begin
    // Automatically grow, if index is sequential
    if Index = self.Count then begin
        self.Add(0);
    end;

    result := Integer(Inherited Get(index));
end;
function TIntList.IndexOf(Item: Integer): Integer;
begin
    result := inherited IndexOf(Pointer(Item));
end;
procedure TIntList.Put(Index, Item: Integer);
begin
    if Index = self.Count then begin
        self.Add(0);
    end;
    inherited Put(Index, Pointer(Item));
end;
function TIntList.Remove(Item: Integer): Integer;
begin
    result := inherited Remove(Pointer(item));
end;


initialization
begin
    AppendCount := 1;
    MyCF_HTML := 0;
    MyCF_RICHTEXT := 0;
end;
end.
