HEX Viewer

private
{ Private declarations }
    procedure Progress(Address:LongInt);

type
  THexConversion = class(TConversion)
  public
    function ConvertReadStream(Stream:TStream; Buffer:PChar;
                               BufSize:integer): integer; override;
 end;
 
 //
 
 // This implements a callback procedure used by TRichEdit when loading
// a file.  Gets called repeatedly until stream is empty.
function THexConversion.ConvertReadStream(Stream:TStream; Buffer:PChar;
                                          BufSize:integer): integer;
var s:string;
    buf:array[1..16] of char;
    i,n:integer;
begin
  Result := 0;
  if BufSize <= 82 then Exit;
  s := Format(';%.5x  ',[Stream.Position]);
  n := Stream.Read(buf,16);
  if n = 0 then Exit;
  for i := 1 to n do
    begin
      AppendStr(s,IntToHex(ord(buf[i]),2)+' ');
      if i mod 4 = 0 then AppendStr(s,' ');
    end;
  AppendStr(s,StringOfChar(' ',62-length(s)));
  for i := 1 to n do
    begin
      if (buf[i] < #32) or (buf[i] > #126) then
        buf[i] := '.';
      AppendStr(s,buf[i]);
    end;
  AppendStr(s,#13#10);
  StrPCopy(Buffer,s);
  Result := length(s);
  if Stream.Position and $FFF = 0 then Form1.Progress(Stream.Position);
end;

procedure TForm1.Progress(Address:LongInt);
begin
  StatusBar.SimpleText := 'Reading...  $' + IntToHex(Address,5);
  StatusBar.Update;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Rich.RegisterConversionFormat('bin',THexConversion);
  Rich.RegisterConversionFormat('obj',THexConversion);
  Rich.RegisterConversionFormat('exe',THexConversion);
end;

procedure TForm1.MenuOpenClick(Sender: TObject);
var fname:string;
begin
 if OpenDlg.Execute then
   begin
     try
       Screen.Cursor := crHourglass;
       fname := ExtractFileName(OpenDlg.Filename);
       StatusBar.SimpleText := 'Reading...';
       Rich.Lines.Clear;
       Application.ProcessMessages;
       try
         Rich.Lines.LoadFromFile(OpenDlg.Filename);
         StatusBar.SimpleText := fname;
       except on E:EFOpenError do
         begin
           StatusBar.SimpleText := '';
           MessageDlg(Format('Cant open file %s.',[fname]),mtError,[mbOk],0);
         end;
       end;
     finally
       Screen.Cursor := crDefault;
     end;
   end;
end;

procedure TForm1.MenuSaveAsClick(Sender: TObject);
begin
  SaveDlg.Filename := ChangeFileExt(OpenDlg.FileName,'.txt');
  if SaveDlg.Execute then
    Rich.Lines.SaveToFile(SaveDlg.FileName);
end;

procedure TForm1.MenuExitClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.MenuPopupPopup(Sender: TObject);
var SelStart,SelEnd:LongInt;
begin
  Rich.Perform(EM_GETSEL,WPARAM(@SelStart),WPARAM(@SelEnd));
  MenuCopy.Enabled := SelStart <> SelEnd;
end;

procedure TForm1.MenuSelectAllClick(Sender: TObject);
begin
  Rich.Perform(EM_SETSEL,0,-1);
end;

procedure TForm1.MenuCopyClick(Sender: TObject);
begin
  Rich.Perform(WM_COPY,0,0);
end;

Andere Methode :

procedure hexview(datei : String;
          re:TRichedit; OffsetAnzeige, AnsiZeichen : boolean);
const Breite = 16;
var
  ms:TMemoryStream;
  sl:TStringlist;
  Buffer:array [0..Breite-1] of Char;
  x,y:Integer;
  hlp:string;
    begin
    if not fileexists(datei) then begin
    messagebox(application.handle,pchar('Datei "'+ ExtractFileName(datei)+
    '" nicht gefunden'),'FEHLER (HexView)',16);
    exit;
    end;
  screen.cursor:=crHourglass;
  ms:=TMemoryStream.create;
  sl:=TStringlist.create;
  try
    re.clear;
    ms.LoadFromFile(datei);
    if ms.size > 0 then begin
    re.font.name:='Courier New';
    re.font.size:=9;
    re.font.style:=[];
    for x:=0 to ms.Size div Breite do
    begin
      // Memory leeren
      ZeroMemory(@Buffer,Breite);
      if OffsetAnzeige then hlp:=IntToHex(x * Breite, 8) + #32#32
      else hlp:='';
      for y:=0 to ms.Read(Buffer, Breite) - 1 do
        begin
        hlp:=hlp + IntToHex(Byte(Buffer[y]),2) + #32;
        if Buffer[y] < #32 then
        Buffer[y]:=#183;
        end;
      hlp:=hlp + StringOfChar(#32,Breite * 3 - Length(hlp) + ord(OffsetAnzeige) * 10 + 1);
      if AnsiZeichen then hlp:=hlp + Buffer;
      sl.Add(hlp);
    end;
    re.lines.beginupdate;
    re.lines:=sl;
    re.scrollbars := ssVertical;
    re.clientwidth:=(length(sl.strings[0]) + 1) * 7; // bezogen auf obigen Font
    re.lines.endupdate;
  end;
  finally
  ms.Free;
  sl.free;
  screen.cursor := crdefault;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    begin
      hexview(OpenDialog1.FileName, RichEdit1,true,true);
  end;
end;