current/Global/Functions.pas

unit Functions;

interface

uses TypeDefs, Classes;

function BoolToStr(bool: Boolean): String;
function HexToLong(hex: String): LongWord;
function Decode_Int(buffer: TByteData): LongWord;
function Encode_Int(input: LongWord): TByteData;
function Decode_Float(buffer: TByteData): Single;
function Encode_Float(input: Single): TByteData;
function DataToBin(Data: TByteData): 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: TByteData; HexOnly: Boolean): String;
function DecodeHexString(hex: String): TByteData;
function GetWinFileName(Name: String): String;
//function GetExtractPath: String;

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


implementation

uses SysUtils, Math, StrUtils;

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
    Result := True;
    if hex[1] = '$' then
    begin
      for i := 1 to Length(hex) - 1 do
        hex[i] := hex[i + 1];
      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
        hex[i] := hex[i + 2];
      SetLength(hex, Length(hex) - 2);
    end;
    if Length(hex) = 0 then
      Result := False;
  end;

begin
  if NormalizeHexString(hex) then
  begin
    Result := StrToInt(hex);
{
    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: TByteData): LongWord;
begin
  Result := buffer[0] + buffer[1] * 256 + buffer[2] * 256 * 256 + buffer[3] * 256 * 256 * 256;
end;


function Encode_Int(input: LongWord): TByteData;
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: TByteData): 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): TByteData;
var
  _valueswitcher: TValueSwitcher;
begin
  _valueswitcher.ValueFloat := input;
  Result := Encode_Int(_valueswitcher.ValueInt);
end;


function DataToBin(Data: TByteData): 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
    Result := FloatToStrF(size / 1024 / 1024 / 1024, ffFixed, 5, 1, floatformat) + ' GB'
  else
    if size >= 1000 * 1024 then
      Result := FloatToStrF(size / 1024 / 1024, ffFixed, 5, 1, floatformat) + ' MB'
    else
      if size >= 1000 then
        Result := FloatToStrF(size / 1024, ffFixed, 5, 1, floatformat) + ' KB'
      else
        Result := IntToStr(size) + ' B';
end;


function CreateHexString(Data: TByteData; 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): TByteData;
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): TStrings;
var
  start, len: Word;
begin
  Result := TStringList.Create;
  start := 1;
  while PosEx(delimiter, _string, start) > 0 do
  begin
    len := PosEx(delimiter, _string, start) - start;
    Result.Add(MidStr(_string, start, len));
    start := start + len + 1;
  end;
  Result.Add(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;


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