fpc/utils/fpmc/readmsg.pp
fpc 790a4fe2d3 * log and id tags removed
git-svn-id: trunk@42 -
2005-05-21 09:42:41 +00:00

86 lines
1.9 KiB
ObjectPascal

{
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team
reads and dumps a message file to screen.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{$mode objfpc}
{$h+}
program readmsg;
Type
PCardinal = ^Cardinal;
Var
F : File of Cardinal;
PO,PI : PCardinal;
I,J,Count,C,S : Cardinal;
Buf : String;
begin
Assign(F,Paramstr(1));
Reset(F);
Read(F,Count);
Writeln('Message count: ',Count);
S:=SizeOf(Cardinal)*Count+1;
GetMem(PO,S);
GetMem(PI,S);
FillChar(PI^,S,0);
FillChar(PO^,S,0);
For I:=1 to Count do
begin
Read(F,C);
PI[I]:=C;
Read(F,C);
If (C<>PI[I]) then
Writeln('Error in ID: ',C,'<>ID',PI[I])
else
Writeln('Found ID ',C);
Read(F,C);
PO[I]:=C;
Writeln('Found offset : ',C);
end;
For I:=1 to Count do
begin
Seek(F,PO[I] div 4);
Read(F,S);
Writeln('Found offset ',S,' at item ',i,' offset ',PO[I]);
For J:=1 to (S div 4)-1 do
begin
Read(F,C);
Move(C,Buf[J*4-3],4);
end;
J:=S-4;
While Buf[J]=#0 do
dec(J);
SetLength(Buf,J);
Writeln('String (',J,') : ',Buf);
end;
Writeln('Seqential read : ');
Seek(F,PO[1] div 4);
For I:=1 to Count do
begin
Read(F,S);
Writeln('Found offset ',S,' at item ',i,' offset ',FilePos(F));
For J:=1 to (S div 4)-1 do
begin
Read(F,C);
Move(C,Buf[J*4-3],4);
end;
J:=S-4;
While Buf[J]=#0 do
dec(J);
SetLength(Buf,J);
Writeln('String (',J,') : ',Buf);
end;
Close(F);
end.