0.33a/Code/Functions.pas

unit Functions;

interface

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

type
  TExportSet = set of (DO_dat, DO_raw, DO_convert, DO_toone);

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 ExportFile(fileid: LongWord; filename: String; settings: TExportSet;
  path: String): Integer;

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