-
Notifications
You must be signed in to change notification settings - Fork 1
/
tzxblock32.inc
147 lines (125 loc) · 3.54 KB
/
tzxblock32.inc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
// Copyright 2022-2024 Zoran Vučenović
// SPDX-License-Identifier: Apache-2.0
{$ifdef tzx_header_section}
TTzxBlock32 = class (TTzxBlock)
strict private
type
TTextStructure = record
TextIdByte: Byte;
Text: AnsiString;
end;
TTextStructures = Array of TTextStructure;
strict private
FLen: Integer;
TextStructures: TTextStructures;
class function DecodeTextIdByte(TextIdByte: Byte): String;
public
constructor Create(ATapePlayer: TTapePlayer); override;
class function GetBlockId: DWord; override;
class function GetBlockDescription: String; override;
function LoadBlock(const Stream: TStream): Boolean; override;
function GetBlockLength: Integer; override;
procedure Details(out S: String); override;
end;
{$else}
class function {TTzxPlayer.}TTzxBlock32.DecodeTextIdByte(TextIdByte: Byte): String;
begin
case TextIdByte of
$00: Result := 'Full title';
$01: Result := 'Software house/publisher';
$02: Result := 'Author(s)';
$03: Result := 'Year of publication';
$04: Result := 'Language';
$05: Result := 'Game/utility type';
$06: Result := 'Price';
$07: Result := 'Protection scheme/loader';
$08: Result := 'Origin';
$FF: Result := 'Comment(s)';
otherwise
Result := '';
end;
if Result <> '' then
Result := ' - ' + Result;
Result := '0x' + IntToHex(TextIdByte) + Result;
end;
constructor TTzxBlock32.Create(ATapePlayer: TTapePlayer);
begin
inherited Create(ATapePlayer);
FLen := 0;
SetLength(TextStructures, 0);
end;
class function {TTzxPlayer.}TTzxBlock32.GetBlockId: DWord;
begin
Result := $32;
end;
class function {TTzxPlayer.}TTzxBlock32.GetBlockDescription: String;
begin
Result := 'Archive info';
end;
function {TTzxPlayer.}TTzxBlock32.LoadBlock(const Stream: TStream): Boolean;
var
W: Word;
I, L: Integer;
B: Byte;
N: Integer;
begin
if Stream.Size >= Stream.Position + 2 then begin
if Stream.Read(W{%H-}, 2) = 2 then begin
W := LEtoN(W);
L := W;
if Stream.Size - Stream.Position >= L then begin
FLen := L + 2;
if L >= 1 then begin
if Stream.Read(B{%H-}, 1) = 1 then begin
Dec(L);
N := B;
if N > 0 then begin
SetLength(TextStructures, N);
for I := 0 to N - 1 do begin
if L < 2 then
Exit(False);
if Stream.Read(B, 1) <> 1 then
Exit(False);
TextStructures[I].TextIdByte := B;
if Stream.Read(B, 1) <> 1 then
Exit(False);
L := L - 2;
if L < B then
Exit(False);
SetLength(TextStructures[I].Text, B);
if B > 0 then begin
if Stream.Read(TextStructures[I].Text[1], B) <> B then
Exit(False);
TCommonFunctions.ConvertCodePageFromCp1252ToUtf8(TextStructures[I].Text);
L := L - B;
end;
end;
end;
Exit(True);
end;
end;
end;
end;
end;
Result := False;
end;
function {TTzxPlayer.}TTzxBlock32.GetBlockLength: Integer;
begin
Result := FLen;
end;
procedure {TTzxPlayer.}TTzxBlock32.Details(out S: String);
var
I: Integer;
S1: String;
begin
inherited Details(S);
for I := 0 to High(TextStructures) do begin
if I > 0 then
S := S + #13;
S := S + DecodeTextIdByte(TextStructures[I].TextIdByte);
S1 := Trim(TextStructures[I].Text);
if S1 <> '' then
S := S + ': ' + S1;
end;
end;
{$endif}