/AKdTopic/AKTools/akDataUtils.pas

  1// AKTools akDataUtils unit.
  2//         ������, ���������� ������� �� ������ � ���������� �������.
  3//=============================================================================
  4
  5unit akDataUtils;
  6
  7interface
  8
  9uses SysUtils, Classes, Windows;
 10
 11// ���������� ���������� ����� �������� ������� � ������� �������� ��������
 12// Data. ���� ������ �������� �� �������, �� �������� -1.
 13function DataInArray(Data: Integer; Arr: array of Integer): Integer; overload;
 14function DataInArray(Data: Boolean; Arr: array of Boolean): Integer; overload;
 15function DataInArray(Data: Double; Arr: array of Double): Integer; overload;
 16function DataInArray(Data: string; Arr: array of string; IgnoreCase: Boolean): Integer; overload;
 17function DataInArray(Data: string; Arr: TStrings; IgnoreCase: Boolean): Integer; overload;
 18function DataInArray(Data: Pointer; Arr: TList): Integer; overload;
 19
 20// ���������� �����, ���������� � ����� first-last � value.
 21function GetBits(value: Integer; first, last: Byte): DWORD;
 22
 23// ������� CRC32 ��������� ������.
 24function GetStringCRC(Str: string; UseZero: Boolean = true): Cardinal;
 25
 26// ���� �������� ����� ������� ������ v1, ����� - v2
 27function iifs(Expr: boolean; v1, v2: Integer): Integer; overload;
 28function iifs(Expr: boolean; v1, v2: string): string; overload;
 29function iifs(Expr: boolean; v1, v2: Boolean): Boolean; overload;
 30function iif(Expr: boolean; v1, v2: variant): variant;
 31
 32// ���������� �������� ���� ����������. ���������� :
 33//  ������������� ����� - ���� a ������ b
 34//                 ���� - ��� ����
 35//  ������������� ����� - a ������ b
 36function UniCompare(val1, val2: string): Integer; overload;
 37function UniCompare(val1, val2: TDateTime): Integer; overload;
 38function UniCompare(val1, val2: Integer): Integer; overload;
 39
 40
 41
 42implementation
 43
 44const CRC32Polynomial = $EDB88320;
 45var crc_32_tab: array[byte] of longword;
 46
 47function DataInArray(Data: string; Arr: array of string; IgnoreCase: Boolean): Integer;
 48var i: Integer;
 49begin
 50  Result := -1;
 51  for i := Low(Arr) to High(Arr) do
 52    if ((IgnoreCase) and (AnsiCompareText(Data, Arr[i]) = 0)) or
 53      ((not IgnoreCase) and (AnsiCompareStr(Data, Arr[i]) = 0)) then
 54    begin
 55      Result := i;
 56      Break;
 57    end;
 58end;
 59
 60function DataInArray(Data: Integer; Arr: array of Integer): Integer;
 61var i: Integer;
 62begin
 63  Result := -1;
 64  for i := Low(Arr) to High(Arr) do
 65    if (Data = Arr[i]) then
 66    begin
 67      Result := i;
 68      Break;
 69    end;
 70end;
 71
 72function DataInArray(Data: Boolean; Arr: array of Boolean): Integer;
 73var i: Integer;
 74begin
 75  Result := -1;
 76  for i := Low(Arr) to High(Arr) do
 77    if (Data = Arr[i]) then
 78    begin
 79      Result := i;
 80      Break;
 81    end;
 82end;
 83
 84function DataInArray(Data: Double; Arr: array of Double): Integer;
 85var i: Integer;
 86begin
 87  Result := -1;
 88  for i := Low(Arr) to High(Arr) do
 89    if (Data = Arr[i]) then
 90    begin
 91      Result := i;
 92      Break;
 93    end;
 94end;
 95
 96function DataInArray(Data: string; Arr: TStrings; IgnoreCase: Boolean): Integer; overload;
 97var i: Integer;
 98begin
 99  Result := -1;
100  for i := 0 to Arr.Count - 1 do
101    if ((AnsiCompareText(Arr[i], Data) = 0) and (IgnoreCase)) or
102      ((CompareStr(Arr[i], Data) = 0) and (not IgnoreCase)) then
103    begin
104      Result := i;
105      Break;
106    end;
107end;
108
109function DataInArray(Data: Pointer; Arr: TList): Integer; overload;
110var i: Integer;
111begin
112  Result := -1;
113  for i := 0 to Arr.Count - 1 do
114    if (Arr[i] = Data) then begin
115      Result := i;
116      Break;
117    end;
118end;
119
120function GetBits(value: Integer; first, last: Byte): DWORD;
121var f, l: Integer;
122  a1, a2: DWord;
123begin
124  l := last; f := first;
125  if f < 0 then f := 0;
126  if l > 31 then l := 31;
127  a1 := (value shr (f));
128  a2 := a1 shl (31 - (l - f));
129  Result := a2 shr (31 - (l - f))
130end;
131
132procedure BuildCRC32Table;
133{* (c) Burnashov Alexander alexburn@metrocom.ru *}
134var i, j: byte; crc: longword;
135begin
136  for i := 0 to 255 do
137  begin
138    crc := i;
139    for j := 8 downto 1 do
140      if (crc and 1) <> 0 then
141        crc := (crc shr 1) xor CRC32Polynomial
142      else
143        crc := crc shr 1;
144    crc_32_tab[i] := crc;
145  end;
146end;
147
148function UpdC32(octet: BYTE; crc: Cardinal): Cardinal;
149begin
150  Result := crc_32_tab[BYTE(crc xor Cardinal(octet))] xor
151    ((crc shr 8) and $00FFFFFF)
152end;
153
154function GetStringCRC(Str: string; UseZero: Boolean): Cardinal;
155const FirstRun: Boolean = true;
156type TAr = array[0..3] of byte;
157var
158  l, crc: Cardinal;
159  counter: SmallInt;
160  ar: TAr absolute crc;
161  am: TAr absolute l;
162begin
163  if FirstRun then
164  begin
165    BuildCRC32Table;
166    FirstRun := False;
167  end;
168
169  crc := $FFFFFFFF;
170  for counter := 1 to Length(Str) do
171    crc := UpdC32(Byte(Str[counter]), crc);
172
173  am[0] := ar[3]; am[1] := ar[2]; am[2] := ar[1]; am[3] := ar[0];
174  Result := l;
175
176  if (Result = 0) and (not UseZero) then Result := 1;
177end;
178
179function iif(Expr: boolean; v1, v2: variant): variant;
180begin
181  if Expr then
182    Result := v1
183  else
184    Result := v2;
185end;
186
187function iifs(Expr: boolean; v1, v2: Integer): Integer; overload;
188begin
189  if Expr then
190    Result := v1
191  else
192    Result := v2;
193end;
194
195function iifs(Expr: boolean; v1, v2: string): string; overload;
196begin
197  if Expr then
198    Result := v1
199  else
200    Result := v2;
201end;
202
203function iifs(Expr: boolean; v1, v2: Boolean): Boolean; overload;
204begin
205  if Expr then
206    Result := v1
207  else
208    Result := v2;
209end;
210
211function UniCompare(val1, val2: string): Integer; overload;
212begin
213  Result := CompareText(val1, val2);
214end;
215
216function UniCompare(val1, val2: TDateTime): Integer; overload;
217begin
218  Result := 0;
219  if val1 = val2 then Result := 0;
220  if val1 > val2 then Result := 1;
221  if val1 < val2 then Result := -1;
222end;
223
224function UniCompare(val1, val2: Integer): Integer; overload;
225begin
226  Result := 0;
227  if val1 = val2 then Result := 0;
228  if val1 > val2 then Result := 1;
229  if val1 < val2 then Result := -1;
230end;
231
232
233end.
234