source: oup/current/Global/Functions.pas @ 111

Last change on this file since 111 was 111, checked in by alloc, 15 years ago
File size: 7.0 KB
Line 
1unit Functions;
2
3interface
4
5uses TypeDefs, Classes;
6
7function BoolToStr(bool: Boolean): String;
8function HexToLong(hex: String): LongWord;
9function Decode_Int(buffer: TByteData): LongWord;
10function Encode_Int(input: LongWord): TByteData;
11function Decode_Float(buffer: TByteData): Single;
12function Encode_Float(input: Single): TByteData;
13function IntToBin(Value: Byte): String;
14function DataToBin(Data: TByteData): String;
15function BinToInt(bin: String): Byte;
16
17function StringSmaller(string1, string2: String): Boolean;
18
19function FormatNumber(Value: LongWord; Width: Byte; leadingzeros: Char): String;
20function FormatFileSize(size: LongWord): String;
21function CreateHexString(Data: TByteData; HexOnly: Boolean): String;
22function DecodeHexString(hex: String): TByteData;
23function GetWinFileName(Name: String): String;
24//function GetExtractPath: String;
25
26function Explode(_string: String; delimiter: Char): TStrings;
27
28
29implementation
30
31uses SysUtils, Math, StrUtils;
32
33type
34  TValueSwitcher = record
35    case IsFloat: Boolean of
36      True: (ValueFloat: Single);
37      False: (ValueInt: LongWord);
38  end;
39
40
41
42function BoolToStr(bool: Boolean): String;
43begin
44  if bool then
45    Result := 'true'
46  else
47    Result := 'false';
48end;
49
50
51function HexToLong(hex: String): LongWord;
52
53  function NormalizeHexString(var hex: String): Boolean;
54  var
55    i: Byte;
56  begin
57    Result := True;
58    if hex[1] = '$' then
59    begin
60      for i := 1 to Length(hex) - 1 do
61        hex[i] := hex[i + 1];
62      SetLength(hex, Length(hex) - 1);
63    end;
64    if (hex[1] = '0') and (UpCase(hex[2]) = 'X') then
65    begin
66      for i := 1 to Length(hex) - 2 do
67        hex[i] := hex[i + 2];
68      SetLength(hex, Length(hex) - 2);
69    end;
70    if Length(hex) = 0 then
71      Result := False;
72  end;
73
74begin
75  if NormalizeHexString(hex) then
76    Result := StrToInt(hex)
77  else
78    Result := 0;
79end;
80
81
82function Decode_Int(buffer: TByteData): LongWord;
83begin
84  Result := buffer[0] + buffer[1] * 256 + buffer[2] * 256 * 256 + buffer[3] * 256 * 256 * 256;
85end;
86
87
88function Encode_Int(input: LongWord): TByteData;
89begin
90  SetLength(Result, 4);
91  Result[0] := input mod 256;
92  input     := input div 256;
93  Result[1] := input mod 256;
94  input     := input div 256;
95  Result[2] := input mod 256;
96  input     := input div 256;
97  Result[3] := input mod 256;
98end;
99
100
101function Decode_Float(buffer: TByteData): Single;
102var
103  _valueswitcher: TValueSwitcher;
104begin
105  _valueswitcher.ValueInt := Decode_Int(buffer);
106  Result := _valueswitcher.ValueFloat;
107  if IsNAN(Result) then
108    Result := 0.0;
109end;
110
111
112function Encode_Float(input: Single): TByteData;
113var
114  _valueswitcher: TValueSwitcher;
115begin
116  _valueswitcher.ValueFloat := input;
117  Result := Encode_Int(_valueswitcher.ValueInt);
118end;
119
120
121function IntToBin(Value: Byte): String;
122var
123  i: Byte;
124begin
125  Result := '';
126  for i := 7 downto 0 do
127    Result := Result + IntToStr((Value shr i) and $01);
128end;
129
130
131function DataToBin(Data: TByteData): String;
132var
133  i, j:     Byte;
134  singlebyte: Byte;
135  bytepart: String;
136begin
137  SetLength(bytepart, 8);
138  Result := '';
139  for i := 0 to High(Data) do
140  begin
141    singlebyte := Data[i];
142    for j := 7 downto 0 do
143    begin
144      bytepart[j + 1] := Char((singlebyte and $01) + 48);
145      singlebyte      := singlebyte shr 1;
146    end;
147    Result := Result + bytepart + ' ';
148  end;
149end;
150
151
152function BinToInt(bin: String): Byte;
153var
154  Add: Integer;
155  i:   Byte;
156begin
157  Result := 0;
158  if Length(bin) <> 8 then
159    Exit;
160  Add := 1;
161  for i := 8 downto 1 do
162  begin
163    if not (bin[i] in ['0', '1']) then
164      Exit;
165    if bin[i] = '1' then
166      Inc(Result, Add);
167    Add := Add shl 1;
168  end;
169end;
170
171
172
173function FormatNumber(Value: LongWord; Width: Byte; leadingzeros: Char): String;
174begin
175  Result := AnsiReplaceStr(Format('%' + IntToStr(Width) + 'u', [Value]), ' ', leadingzeros);
176end;
177
178
179
180
181function FormatFileSize(size: LongWord): String;
182var
183  floatformat: TFormatSettings;
184begin
185  floatformat.DecimalSeparator := '.';
186  if size >= 1000 * 1024 * 1024 then
187    Result := FloatToStrF(size / 1024 / 1024 / 1024, ffFixed, 5, 1, floatformat) + ' GB'
188  else
189    if size >= 1000 * 1024 then
190      Result := FloatToStrF(size / 1024 / 1024, ffFixed, 5, 1, floatformat) + ' MB'
191    else
192      if size >= 1000 then
193        Result := FloatToStrF(size / 1024, ffFixed, 5, 1, floatformat) + ' KB'
194      else
195        Result := IntToStr(size) + ' B';
196end;
197
198
199
200
201function CreateHexString(Data: TByteData; HexOnly: Boolean): String;
202var
203  string_build, ascii_version: String;
204  i: Integer;
205begin
206  string_build  := '';
207  ascii_version := '';
208  for i := 0 to High(Data) do
209  begin
210    if not HexOnly then
211      if (i mod 16) = 0 then
212        string_build := string_build + '0x' + IntToHex(i, 6) + '  ';
213    string_build := string_build + IntToHex(Data[i], 2);
214    if not HexOnly then
215    begin
216      if Data[i] >= 32 then
217        ascii_version := ascii_version + Chr(Data[i])
218      else
219        ascii_version := ascii_version + '.';
220      if ((i + 1) mod 2) = 0 then
221        string_build := string_build + #32;
222      if ((i + 1) mod 16) = 0 then
223      begin
224        string_build  := string_build + #32 + ascii_version + CrLf;
225        ascii_version := '';
226      end;
227    end;
228  end;
229  Result := string_build;
230end;
231
232
233
234
235function DecodeHexString(hex: String): TByteData;
236var
237  i: Integer;
238begin
239  SetLength(Result, Length(hex) div 2);
240  for i := 0 to Length(Result) do
241  begin
242    Result[i] := 0;
243    case UpCase(hex[1 + i * 2]) of
244      '0'..'9':
245        Result[i] := (Ord(UpCase(hex[1 + i * 2])) - 48) * 16;
246      'A'..'F':
247        Result[i] := (Ord(UpCase(hex[1 + i * 2])) - 55) * 16;
248    end;
249    case UpCase(hex[1 + i * 2 + 1]) of
250      '0'..'9':
251        Result[i] := Result[i] + (Ord(UpCase(hex[1 + i * 2 + 1])) - 48);
252      'A'..'F':
253        Result[i] := Result[i] + (Ord(UpCase(hex[1 + i * 2 + 1])) - 55);
254    end;
255  end;
256end;
257
258
259
260
261function StringSmaller(string1, string2: String): Boolean;
262var
263  i:   Integer;
264  len: Integer;
265begin
266  len := Min(Length(string1), Length(string2));
267  for i := 1 to len do
268    if Ord(string1[i]) <> Ord(string2[i]) then
269    begin
270      Result := Ord(string1[i]) < Ord(string2[i]);
271      Exit;
272    end;
273  Result := Length(string1) < Length(string2);
274end;
275
276
277
278function Explode(_string: String; delimiter: Char): TStrings;
279var
280  start, len: Word;
281begin
282  Result := TStringList.Create;
283  start := 1;
284  while PosEx(delimiter, _string, start) > 0 do
285  begin
286    len := PosEx(delimiter, _string, start) - start;
287    Result.Add(MidStr(_string, start, len));
288    start := start + len + 1;
289  end;
290  Result.Add(MidStr(_string, start, Length(_string) - start + 1));
291end;
292
293
294function GetWinFileName(Name: String): String;
295begin
296  Result := Name;
297  Result := AnsiReplaceStr(Result, '\', '__');
298  Result := AnsiReplaceStr(Result, '/', '__');
299  Result := AnsiReplaceStr(Result, '>', '__');
300  Result := AnsiReplaceStr(Result, '<', '__');
301end;
302
303
304end.
Note: See TracBrowser for help on using the repository browser.