0.33a/Code/Functions.pas

unit Functions;

interface

uses Classes, Dialogs, SysUtils, StrUtils, Math, Data;

function BoolToStr(bool: Boolean): String;
function HexToLong(hex: String): LongWord;
function Decode_Int(buffer: Tdata): LongWord;
function Encode_Int(input: LongWord): Tdata;
function Decode_Float(buffer: Tdata): Single;
function Encode_Float(input: Single): Tdata;
function DataToBin(Data: Tdata): String;
function BinToInt(bin: String): Byte;

function StringSmaller(string1, string2: String): Boolean;

function FormatNumber(Value: LongWord; Width: Byte; leadingzeros: Char): String;
function FormatFileSize(size: LongWord): String;
function CreateHexString(Data: Tdata; HexOnly: Boolean): String;
function DecodeHexString(hex: String): Tdata;
function GetWinFileName(Name: String): String;
function GetExtractPath: String;

function Explode(_string: String; delimiter: Char): TStringArray;


implementation

uses Exporters, OniDataClass;

type
  TValueSwitcher = record
    case IsFloat: Boolean of
      True: (ValueFloat: Single);
      False: (ValueInt: LongWord);
  end;


function BoolToStr(bool: Boolean): String;
begin
  if bool then
    Result := 'true'
  else
    Result := 'false';
end;


function HexToLong(hex: String): LongWord;


  function NormalizeHexString(var hex: String): Boolean;
  var
    i: Byte;
  begin
    if hex[1] = '$' then
    begin
      for i := 1 to Length(hex) - 1 do
      begin
        hex[i] := hex[i + 1];
      end;
      SetLength(hex, Length(hex) - 1);
    end;
    if (hex[1] = '0') and (UpCase(hex[2]) = 'X') then
    begin
      for i := 1 to Length(hex) - 2 do
      begin
        hex[i] := hex[i + 2];
      end;
      SetLength(hex, Length(hex) - 2);
    end;
    if Length(hex) = 0 then
      Result := False
    else
      Result := True;
  end;

var
  i: Byte;
begin
  if NormalizeHexString(hex) then
  begin
    hex    := UpperCase(hex);
    Result := 0;
    for i := 1 to Length(hex) do
    begin
      Result := Result shl 4;
      case hex[i] of
        '0'..'9':
          Result := Result + Ord(hex[i]) - 48;
        'A'..'F':
          Result := Result + Ord(hex[i]) - 55;
        else
          Result := 0;
          Exit;
      end;
    end;
  end
  else
  begin
    Result := 0;
  end;
end;


function Decode_Int(buffer: Tdata): LongWord;
begin
  Result := buffer[0] + buffer[1] * 256 + buffer[2] * 256 * 256 + buffer[3] * 256 * 256 * 256;
end;


function Encode_Int(input: LongWord): Tdata;
begin
  SetLength(Result, 4);
  Result[0] := input mod 256;
  input     := input div 256;
  Result[1] := input mod 256;
  input     := input div 256;
  Result[2] := input mod 256;
  input     := input div 256;
  Result[3] := input mod 256;
end;


function Decode_Float(buffer: Tdata): Single;
var
  _valueswitcher: TValueSwitcher;
begin
  _valueswitcher.ValueInt := Decode_Int(buffer);
  Result := _valueswitcher.ValueFloat;
  if IsNAN(Result) then
    Result := 0.0;
end;


function Encode_Float(input: Single): Tdata;
var
  _valueswitcher: TValueSwitcher;
begin
  _valueswitcher.ValueFloat := input;
  Result := Encode_Int(_valueswitcher.ValueInt);
end;


function DataToBin(Data: Tdata): String;
var
  i, j:     Byte;
  singlebyte: Byte;
  bytepart: String;
begin
  SetLength(bytepart, 8);
  Result := '';
  for i := 0 to High(Data) do
  begin
    singlebyte := Data[i];
    for j := 7 downto 0 do
    begin
      bytepart[j + 1] := Char((singlebyte and $01) + 48);
      singlebyte      := singlebyte shr 1;
    end;
    Result := Result + bytepart + ' ';
  end;
end;


function BinToInt(bin: String): Byte;
var
  Add: Integer;
  i:   Byte;
begin
  Result := 0;
  if Length(bin) <> 8 then
    Exit;
  Add := 1;
  for i := 8 downto 1 do
  begin
    if not (bin[i] in ['0', '1']) then
      Exit;
    if bin[i] = '1' then
      Inc(Result, Add);
    Add := Add shl 1;
  end;
end;


function FormatNumber(Value: LongWord; Width: Byte; leadingzeros: Char): String;
begin
  Result := AnsiReplaceStr(Format('%' + IntToStr(Width) + 'u', [Value]), ' ', leadingzeros);
end;


function FormatFileSize(size: LongWord): String;
var
  floatformat: TFormatSettings;
begin
  floatformat.DecimalSeparator := '.';
  if size >= 1000 * 1024 * 1024 then
  begin
    Result := FloatToStrF(size / 1024 / 1024 / 1024, ffFixed, 5, 1, floatformat) + ' GB';
  end
  else
  begin
    if size >= 1000 * 1024 then
    begin
      Result := FloatToStrF(size / 1024 / 1024, ffFixed, 5, 1, floatformat) + ' MB';
    end
    else
    begin
      if size >= 1000 then
      begin
        Result := FloatToStrF(size / 1024, ffFixed, 5, 1, floatformat) + ' KB';
      end
      else
      begin
        Result := IntToStr(size) + ' B';
      end;
    end;
  end;
end;


function CreateHexString(Data: Tdata; HexOnly: Boolean): String;
var
  string_build, ascii_version: String;
  i: LongWord;
begin
  string_build  := '';
  ascii_version := '';
  for i := 0 to High(Data) do
  begin
    if not HexOnly then
      if (i mod 16) = 0 then
        string_build := string_build + '0x' + IntToHex(i, 6) + '  ';
    string_build := string_build + IntToHex(Data[i], 2);
    if not HexOnly then
    begin
      if Data[i] >= 32 then
        ascii_version := ascii_version + Chr(Data[i])
      else
        ascii_version := ascii_version + '.';
      if ((i + 1) mod 2) = 0 then
        string_build := string_build + #32;
      if ((i + 1) mod 16) = 0 then
      begin
        string_build  := string_build + #32 + ascii_version + CrLf;
        ascii_version := '';
      end;
    end;
  end;
  Result := string_build;
end;


function DecodeHexString(hex: String): Tdata;
var
  i: LongWord;
begin
  SetLength(Result, Length(hex) div 2);
  for i := 0 to Length(Result) do
  begin
    Result[i] := 0;
    case UpCase(hex[1 + i * 2]) of
      '0'..'9':
        Result[i] := (Ord(UpCase(hex[1 + i * 2])) - 48) * 16;
      'A'..'F':
        Result[i] := (Ord(UpCase(hex[1 + i * 2])) - 55) * 16;
    end;
    case UpCase(hex[1 + i * 2 + 1]) of
      '0'..'9':
        Result[i] := Result[i] + (Ord(UpCase(hex[1 + i * 2 + 1])) - 48);
      'A'..'F':
        Result[i] := Result[i] + (Ord(UpCase(hex[1 + i * 2 + 1])) - 55);
    end;
  end;
end;


function StringSmaller(string1, string2: String): Boolean;
var
  i:   Integer;
  len: Integer;
begin
  len := Min(Length(string1), Length(string2));
  for i := 1 to len do
    if Ord(string1[i]) <> Ord(string2[i]) then
    begin
      Result := Ord(string1[i]) < Ord(string2[i]);
      Exit;
    end;
  Result := Length(string1) < Length(string2);
end;


function Explode(_string: String; delimiter: Char): TStringArray;
var
  start, len: Word;
begin
  SetLength(Result, 0);
  start := 1;
  while PosEx(delimiter, _string, start) > 0 do
  begin
    len := PosEx(delimiter, _string, start) - start;
    SetLength(Result, Length(Result) + 1);
    Result[High(Result)] := MidStr(_string, start, len);
    start := start + len + 1;
  end;
  SetLength(Result, Length(Result) + 1);
  Result[High(Result)] := MidStr(_string, start, Length(_string) - start + 1);
end;


function GetWinFileName(Name: String): String;
begin
  Result := Name;
  Result := AnsiReplaceStr(Result, '\', '__');
  Result := AnsiReplaceStr(Result, '/', '__');
  Result := AnsiReplaceStr(Result, '>', '__');
  Result := AnsiReplaceStr(Result, '<', '__');
end;


function GetExtractPath: String;
begin
  Result := ExtractFilePath(OniDataConnection.FileName) + '\extracted_' +
    ExtractFileName(OniDataConnection.Filename);
end;


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