public
{ Public declarations }
browsefilename:string;
f_in : TFileStream;
buffer:array of byte;
buflen:integer;
bytesread:integer;
curpage,maxpage:integer;
charsperline:integer;
list:TStringlist;
procedure setupPage;
procedure showpage;
procedure resetbrowsefile;
var
Form1: TForm1;
hexchars:array[0..15] of char=('0','1','2','3','4','5','6','7','8',
'9','A','B','C','D','E','F');
//
procedure TForm1.FormActivate(Sender: TObject);
begin
memo1.doublebuffered:=true;
list:=TStringlist.create;
end;
procedure TForm1.SetupPage;
var
savefont:TFont;
w,h:integer;
pagecharwidth, pagelines:integer;
begin
if not fileexists(browsefilename) then exit;
savefont:=font;
font:=memo1.font;
w:=canvas.textwidth('X');
h:=canvas.textheight('X');
font:=savefont;
pagecharwidth:=memo1.width div w;
pagelines:=memo1.height div h-1;
charsperline:=4*((4*pagecharwidth div 13 -2) div 4);
buflen:=charsperline*pagelines;
setlength(buffer,buflen);
maxpage:=f_in.size div buflen ;
curpage:=0;
showpage;
end;
procedure TForm1.showpage;
var
lines:integer;
i,j,n:integer;
text:string;
hex:string;
bytesread, byteswritten:integer;
hexsize:integer;
begin
if browsefilename='' then exit;
f_in.seek(curpage*buflen, soFromBeginning);
bytesread:=f_in.read(buffer[0],buflen);
label1.caption:=inttostr(curpage+1) +#13+'of '+ #13+ inttostr(maxpage+1);
list.clear;
lines:=bytesread div charsperline;
hexsize:=charsperline*2+charsperline div 4;
if lines>=0 then
begin
byteswritten:=0;
for i:= 0 to lines do
begin
hex:='';
n:=i*charsperline;
text:='';
for j:=0 to charsperline -1 do
begin
if (buffer[n+j]>=32) and (buffer[n+j]<=127) then text:=text+ char(buffer[n+j])
else text:=text+char($90);
if (j mod 4=0) and (j>0) then hex:=hex+' ';
hex:=hex+hexchars[(buffer[n+j] and $F0) shr 4]
+ hexchars[(buffer[n+j] and $0F)];
inc(byteswritten);
if byteswritten>=bytesread then break;
end;
if length(hex)< hexsize then hex:=hex+stringofchar(' ',hexsize-length(hex));
list.add(hex+' '+text);
if byteswritten>=bytesread then break;
end;
memo1.lines.assign(list);
end;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
If (key=vk_Next) or (key=vk_down) then
begin
if ssCtrl in shift then curpage:=maxpage
else if curpage<maxpage then inc(curpage) else beep;
showpage;
end
else if (key=vk_Prior) or (key=vk_up) then
begin
if ssctrl in shift then curpage:=0
else if curpage>0 then dec(curpage) else beep;
showpage;
end
else if key=vk_escape then
begin
resetbrowsefile;
end;
key:=0;
end;
procedure TForm1.resetbrowsefile;
begin
browsefilename:='';
Caption:='Hex View: No file selected';
Memo1.clear;
freeandnil(f_in);
end;
procedure TForm1.FormDeactivate(Sender: TObject);
begin
resetbrowsefile;
end;
Beispiel :
procedure TForm1.Button1Click(Sender: TObject);
begin
if assigned(f_in) then freeandnil(f_in);
If OpenDialog1.Execute then
begin
if fileexists(opendialog1.filename)
then
begin
browsefilename:=opendialog1.filename;
caption:='Hex View: File: ' +browsefilename;
f_in:=TFileStream.create(browsefilename,fmOpenread);
end
else resetbrowsefile;
setupPage;
showpage;
end;
end;
Keine Kommentare:
Kommentar veröffentlichen