1 { Copyright (C) <2005> <Andrew Haines> chmbase.pas
2
3 This library is free software; you can redistribute it and/or modify it
4 under the terms of the GNU Library General Public License as published by
5 the Free Software Foundation; either version 2 of the License, or (at your
6 option) any later version.
7
8 This program is distributed in the hope that it will be useful, but WITHOUT
9 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
10 FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
11 for more details.
12
13 You should have received a copy of the GNU Library General Public License
14 along with this library; if not, write to the Free Software Foundation,
15 Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
16 }
17 {
18 See the file COPYING.FPC, included in this distribution,
19 for details about the copyright.
20 }
21 unit chmbase;
22
23 {$mode objfpc}{$H+}
24
25 interface
26
27 uses
28 Classes, SysUtils;
29
30 const
31 CHMPackageVersion = '3.2.2'; // to be put in readme
32
33 type
34 {$PACKRECORDS C}
35 TITSFHeader= record
36 ITSFsig: array [0..3] of char;
37 Version: LongWord;
38 HeaderLength: LongWord;
39 Unknown_1: LongWord;
40 TimeStamp: LongWord; //bigendian
41 LanguageID: LongWord;
42 end;
43 TITSFHeaderEntry = record
44 PosFromZero: QWord;
45 Length: QWord;
46 end;
47
48 //Version 3 has this qword. 2 does not
49 TITSFHeaderSuffix = record
50 Offset: QWord; // offset within file of content section 0
51 end;
52
53 TITSPHeaderPrefix = record
54 Unknown1: LongWord;// = $01FE
55 Unknown2: LongWord;// = 0
56 FileSize: QWord;
57 Unknown3: LongWord;// =0
58 Unknown4: LongWord;// =0
59 end;
60
61 TITSPHeader = record
62 ITSPsig: array [0..3] of char; // = 'ITSP'
63 Version: LongWord; // =1
64 DirHeaderLength: Longword; // Length of the directory header
65 Unknown1: LongWord; // =$0a
66 ChunkSize: LongWord; // $1000
67 Density: LongWord; // usually = 2
68 IndexTreeDepth: LongWord;// 1 if there is no index 2 if there is one level of PMGI chunks
69 IndexOfRootChunk: LongInt;// -1 if no root chunk
70 FirstPMGLChunkIndex,
71 LastPMGLChunkIndex: LongWord;
72 Unknown2: LongInt; // = -1
73 DirectoryChunkCount: LongWord;
74 LanguageID: LongWord;
75 GUID: TGuid;
76 LengthAgain: LongWord; //??? $54
77 Unknown3: LongInt; // = -1
78 Unknown4: LongInt; // = -1
79 Unknown5: LongInt; // = -1
80 end;
81
82 TDirChunkType = (ctPMGL, ctPMGI, ctAOLL, ctAOLI, ctUnknown);
83
84 TPMGListChunk = record
85 PMGLsig: array [0..3] of char;
86 UnusedSpace: Longword; ///!!! this value can also represent the size of quickref area in the end of the chunk
87 Unknown1: Longword; //always 0
88 PreviousChunkIndex: LongInt; // chunk number of the prev listing chunk when reading dir in sequence
89 // (-1 if this is the first listing chunk)
90 NextChunkIndex: LongInt; // chunk number of the next listing chunk (-1 if this is the last chunk)
91 end;
92
93 PPMGListChunkEntry = ^TPMGListChunkEntry;
94 TPMGListChunkEntry = record
95 //NameLength: LongInt; we don't need this permanantly so I've moved it to a temp var
96 Name: String;
97 ContentSection: LongWord;//QWord;
98 ContentOffset: QWord;
99 DecompressedLength: QWord;
100 end;
101
102 TPMGIIndexChunk = record
103 PMGIsig: array [0..3] of char;
104 UnusedSpace: LongWord; // has a quickref area
105 end;
106
107 TPMGIIndexChunkEntry = record
108 Name: String;
109 ListingChunk: DWord;
110 end;
111
112
113 const
114 ITSFHeaderGUID : TGuid = '{7C01FD10-7BAA-11D0-9E0C-00A0C922E6EC}';
115 ITSFFileSig: array [0..3] of char = 'ITSF';
116
117 ITSPHeaderGUID : TGuid = '{5D02926A-212E-11D0-9DF9-00A0C922E6EC}';
118 ITSPHeaderSig: array [0..3] of char = 'ITSP';
119
willnull120 // this function will advance the stream to the end of the compressed integer
121 // and return the value
122 function GetCompressedInteger(const Stream: TStream): DWord;
123 // returns the number of bytes written to the stream
WriteCompressedIntegernull124 function WriteCompressedInteger(const Stream: TStream; ANumber: DWord): DWord;
WriteCompressedIntegernull125 function WriteCompressedInteger(Buffer: Pointer; ANumber: DWord): DWord;
126
127 // stupid needed function
functionnull128 function ChmCompareText(const S1, S2: String): Integer; inline;
129
130
131 implementation
132
GetCompressedIntegernull133 function GetCompressedInteger(const Stream: TStream): DWord;
134 var
135 total: QWord = 0;
136 temp: Byte;
137 Sanity: Integer = 0;
138 begin
139 try
140 temp := Stream.ReadByte;
141 while temp >= $80 do
142 begin
143 total := total shl 7;
144 total := total + temp and $7f;
145 temp := Stream.ReadByte;
146 Inc(Sanity);
147 if Sanity > 8 then
148 begin
149 Result := 0;
150 Exit;
151 end;
152 end;
153 Result := (total shl 7) + temp;
154 except
155 Result := 0;
156 end;
157 end;
158
159 // returns how many bytes were written
WriteCompressedIntegernull160 function WriteCompressedInteger(const Stream: TStream; ANumber: DWord): DWord;
161 var
162 Buffer: QWord; // Easily large enough
163 begin
164 Result := WriteCompressedInteger(@Buffer, ANumber);
165 Result := Stream.Write(Buffer, Result);
166 end;
167
168 // returns how many bytes were written
WriteCompressedIntegernull169 function WriteCompressedInteger(Buffer: Pointer; ANumber: DWord): DWord;
170 var
171 bit: dword;
172 mask: QWord;
173 buf: PByte;
174 Value: QWord = 0;
175 TheEnd: DWord = 0;
176 begin
177 bit := 28; //((sizeof(dWord)*8)div 7)*7; // = 28
178 buf := @Value;
179 {$push}
180 {$R-}
181 while True do begin
182 mask := $7f shl bit;
183 if (bit = 0) or ((ANumber and mask)<>0) then break;
184 Dec(bit, 7);
185 end;
186 while True do begin
187 buf^ := Byte(((ANumber shr bit)and $7f));
188 if(bit = 0) then break;
189 buf^ := buf^ or $80;
190 Inc(buf);
191 Dec(bit, 7);
192 Inc(TheEnd);
193 end;
194
195 {$pop}
196
197 buf := @Value;
198 Result := TheEnd+1;
199 Move(Value, Buffer^, Result);
200 {$ifdef chm_debug}
201 if Result > 8 then WriteLn(' ', ANumber,' WRITE_COMPRESSED_INTEGER too big!: ', Result, ' ');
202 {$endif}
203 end;
204
ChmCompareTextnull205 function ChmCompareText(const S1, S2: String): Integer;
206 begin
willnull207 // for our purposes the CompareText function will not work.
208 Result := CompareStr(LowerCase(S1), Lowercase(S2));
209 end;
210
211 end.
212
213