ImageHash/uUtils.pas at master · martok/ImageHash · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
unit uUtils;

{$mode objfpc}{$H+}
{$ModeSwitch advancedrecords}
{$ModeSwitch nestedprocvars}

interface

uses
  Classes, SysUtils, Forms, fgl;

type
  PThread = ^TThread;

procedure WaitForMultipleThreads(a: PThread; NThreads: Integer; CB: TProcedureOfObject; cancelflag: PBoolean = nil);


type
  generic TListTool<T> = record
  type
    TAList = specialize TFPGList<T>;
    TAArray = array of T;
    TACompareFunc = function(const Item1, Item2: T): Integer;
    TACompareNest = function(const Item1, Item2: T): Integer is nested;

    class function FindSmallestValue(AList: TAList; ACompare: TACompareFunc; out Value: T): integer; static; overload;
    class function FindSmallestValue(AList: TAList; ACompare: TACompareNest; out Value: T): integer; static; overload;
    class function FindSmallestValue(AArray: TAArray; ACompare: TACompareFunc; out Value: T): integer; static; overload;
    class function FindSmallestValue(AArray: TAArray; ACompare: TACompareNest; out Value: T): integer; static; overload;
  end;

function GetFileInfos(AFileName: string; out AInfos: TSearchRec): boolean;

function SendFilesToTrash(AFileNames: TStringArray): boolean;

function GetBitCount32(const Num: DWord): NativeUInt; inline;
function GetBitCount64(const Num: QWord): NativeUInt; inline;

implementation

uses
  ShellApi;

procedure WaitForMultipleThreads(a: PThread; NThreads: Integer; CB: TProcedureOfObject; cancelflag: PBoolean = nil);
var
  i: Integer;
begin
  for i:= 0 to NThreads-1 do begin
    repeat
      if Assigned(cancelflag) and cancelflag^ then
        a[i].Terminate;
      if Assigned(CB) then
        CB();
      Sleep(1);
    until a[i].Finished;
  end;
  // Make sure any queued events are processed before returning to where the threads may be freed
  // This should be done by the callback function
  if GetCurrentThreadId = MainThreadID then begin
    if Assigned(CB) then
      CB();
  end;
end;

{ TListTool }

class function TListTool.FindSmallestValue(AList: TAList; ACompare: TACompareFunc; out Value: T): integer;
  function Comp(const Item1, Item2: T): Integer;
  begin
    Result:= ACompare(Item1, Item2);
  end;

begin
  Result:= FindSmallestValue(AList, @Comp, Value);
end;

class function TListTool.FindSmallestValue(AList: TAList; ACompare: TACompareNest; out Value: T): integer;
var
  i: integer;
begin
  if AList.Count = 0 then
    Exit(-1);

  Value:= AList[0];
  Result:= 0;

  for i:= 1 to AList.Count - 1 do begin
    if ACompare(AList[i], Value) < 0 then begin
      Result:= i;
      Value:= AList[i];
    end;
  end;
end;

class function TListTool.FindSmallestValue(AArray: TAArray; ACompare: TACompareFunc; out Value: T): integer;
  function Comp(const Item1, Item2: T): Integer;
  begin
    Result:= ACompare(Item1, Item2);
  end;

begin
  Result:= FindSmallestValue(AArray, @Comp, Value);
end;

class function TListTool.FindSmallestValue(AArray: TAArray; ACompare: TACompareNest; out Value: T): integer;
var
  i: integer;
begin
  if Length(AArray) = 0 then
    Exit(-1);

  Value:= AArray[0];
  Result:= 0;

  for i:= 1 to high(AArray) do begin
    if ACompare(AArray[i], Value) < 0 then begin
      Result:= i;
      Value:= AArray[i];
    end;
  end;
end;

function GetFileInfos(AFileName: string; out AInfos: TSearchRec): boolean;
begin
  Result:= FindFirst(AFileName, faAnyFile, AInfos) = 0;
  if Result then
    FindClose(AInfos);
end;

function SendFilesToTrash(AFileNames: TStringArray): boolean;
var
  fop: TSHFILEOPSTRUCTW;
  ws: WideString;
begin
  fop.wnd:= 0;
  fop.wFunc:= FO_DELETE;
  fop.fFlags:= FOF_NOCONFIRMATION or FOF_ALLOWUNDO;
  ws:= WideString(AnsiString.Join(#0, AFileNames) + #0);
  fop.pFrom:= PWideChar(ws);
  Result:= 0 = SHFileOperationW(@fop);
end;


{$AsmMode intel}
function GetBitCount32(const Num: DWord): NativeUInt; inline; assembler; nostackframe;
asm
  POPCNT @result, num
end;

{$IFDEF CPUX86}
function GetBitCount64(const Num: QWord): NativeUInt; inline;
begin
  Result:= GetBitCount32(Lo(Num)) + GetBitCount32(Hi(Num));
end;

{$ELSE}

function GetBitCount64(const Num: QWord): NativeUInt; inline; assembler; nostackframe;
asm
  POPCNT @result, num
end;

{$ENDIF}

end.