Datei hexadezimal laden

[Steve]

Hi,

also eigentlich wollte ich nur mal wieder nen bisschen mit Callback-Routinen und so Zeugs was rumprobieren und da kam dann folgendes dabei raus..
Die Funktion GetFileAsHex öffnet eine Datei, übergibt ihren Inhalt im Hexadezimal-Format an einen TStrings-Parameter und liefert ein Boolsches Ergebnis, ob alles funktioniert hat.
Über eine Callback-Routine erfährt man den Fortschritt der Aktion und man kann diese darüber auch abbrechen.

Tja, sonst alles soweit auch alles erklärt sein, kommentiert ist's auch...

Ein Anwendungsbeispiel folgt weiter unten.

Delphi-Quellcode:

uses
  System, Classes, Windows, SysUtils;

Type
  TFileToHexCallback= PROCEDURE(const aPercent:Byte; var Cancel:Boolean);

function GetFileAsHex(const aFileName : String;
                            SL        : TStrings;
                            Formatted : Boolean = TRUE;
                            aCallback : TFileToHexCallback = NIL) : Boolean;
{ **************************************************************************** }
{ *  ----------------------      GetFileAsHex     -------------------------  * }
{ **************************************************************************** }
{ * GetFileAsHex opens a file from given 'aFileName'                         * }
{ * The binary HEX-code of the file is written into 'SL', 16 bytes per line  * }
{ * If 'Formatted' is set, a blank is inserted after each byte and one more  * }
{ *  between the two words in each line. [optional parameter]                * }
{ * If aCallback is given you are able to show the progress (in percent)     * }
{ *  and to cancel it [optional parameter]                                   * }
{ * ------------------------------------------------------------------------ * }
{ * GetFileAsHex returns TRUE if everything worked fine, otherwise FALSE.    * }
{ * Reasons for failing: SL=NIL, File doesn't exist, Abort, Errors/Exceptions* }
{ * ------------------------------------------------------------------------ * }
{ * Definition of the Callback-Routine:                                      * }
{ *  TFileToHexCallback= PROCEDURE(const aPercent:Byte; var Cancel:Boolean); * }
{ * ------------------------------------------------------------------------ * }
{ * Note: "Huge-Strings" must be set! (*$H+*)                                * }
{ * ------------------------------------------------------------------------ * }
{ * At the moment the number of bytes per line, the kind of formatting and   * }
{ *  the frequency of calling the 'aCallback'-routine are completely fixed   * }
{ *  but you are free to change them (and everything else as well ;-)        * }
{ **************************************************************************** }
{ * Author: Steve, delphipraxis.net   *  Version: v1.0 [07/2005]             * }
{ **************************************************************************** }
var
  F          : TFileStream;
  hex, erg   : string;
  ii         : LongWord; {4Byte}
  value, max : Int64;    {8Byte}
  bVal, nn   : Byte;     {1Byte}
  ch         : PChar;    {1Byte}
  cancel     : Boolean;  {1Byte}
const
  SPACE     : Char      = ' ';
  ERROR_MSG : PAnsiChar = 'Error';
  INFO_MSG  : PAnsiChar = 'Information';
  ABORT_MSG : PAnsiChar = 'Aborted!';

  // --------- Internal procedure ----------------------------------------------
  function DoCallback : Boolean;
  begin
    Result := TRUE;
    if Assigned(aCallback) then
    begin
      aCallback(Trunc(F.Position/max*100), Cancel);
      Result := not Cancel;
      if Cancel then
        MessageBox(0, ABORT_MSG, INFO_MSG, MB_OK or MB_ICONWARNING);
    end;
  end; // --- DoCallback (Internal procedure) ----------------------------------

begin
  // ----------------
  // Checking for errors and stuff...
  // ----------------
  Cancel := FALSE;
  Result := FALSE;
  if not Assigned(SL) then Exit;
  SL.Clear;
  if not FileExists(aFileName) then
    Result := FALSE
  else

  // ----------------
  // Okay, let's go....
  // ----------------
  try
    try
      F   := TFileStream.Create(aFileName, fmOpenRead or fmShareDenyNone);
      max := F.Size;

      // ------ First, we read blocks of 2*8 bytes: ----------------------------
      while F.Position+2*SizeOf(Value) <= Max do
      begin
        Erg := '';
        // 3 Characters (0-F,0-F,Space) * 2 "blocks" * Count of Bytes + 1 Space
        if Formatted then
          SetLength(Erg, 3*2*SizeOf(Value)+1)
        else
          SetLength(Erg, 2*2*SizeOf(Value));
        ch := @Erg[1];
        Dec(ch);
        // ========= READ AND CONVERT NOW ======================================
        for nn:=1 to 2 do
        begin
          F.Read(Value, SizeOf(Value));
          for ii:=0 to SizeOf(Value)-1 do
          begin
            hex := IntToHex(Byte(Value shr (ii*8)), 2);
            Inc(ch); ch^ := hex[1];
            Inc(ch); ch^ := hex[2];
            if Formatted then
            begin
              Inc(ch); ch^ := SPACE;
            end;
          end;
          // 8 Bytes read -> next "block"
          if (nn=1) then
          begin
            if Formatted then
            begin
              Inc(ch); ch^ := SPACE
            end;
          end
          else SL.Add(Erg);
        end;
       // Time for a callback...
       if not DoCallback then Break;
      end;

      Erg := '';
      // ------ The rest of the file we get single bytes: ----------------------
      if not Cancel then
      begin
        // Initialize variables ERG and CH
        if Formatted then
          SetLength(Erg, 3*16+1)
        else
          SetLength(Erg, 2*16);
        ch := @Erg[1];
        Dec(ch);
        for nn:=1 to Length(Erg) do
        begin
          Inc(ch); ch^:= #0;
        end;
        ch := @Erg[1];
        Dec(ch);
        while F.Position+SizeOf(bVal) <= Max do
        begin
          // 3 Characters (0-F,0-F,Space) * 2 "blocks" à 8 Bytes + 1 Space
          // ========= READ AND CONVERT NOW ====================================
          F.Read(bVal, SizeOf(bVal));
          hex := IntToHex(bVal, SizeOf(bVal)*2);
          for ii:=1 to SizeOf(bVal)*2 do
          begin
            Inc(ch); ch^ := hex[ii];
          end;
          if Formatted then
          begin
            Inc(ch); ch^ := SPACE;
            if F.Position mod 8 = 0 then
            begin
              Inc(ch); ch^ := SPACE;
            end;
          end;
          // Time for a callback...
          if not DoCallback then Break;
        end;
        if Erg<>'' then SL.Add(Erg);
      end; { IF NOT Cancel }

      // We're done :-)
      if Assigned(aCallback) then
        aCallback(100, Cancel);
      Result := TRUE;

    // ----------------
    // Exception-Handling
    // ----------------
    except

      on E:Exception do
      begin
        MessageBox(0, PChar(E.Message), ERROR_MSG, MB_OK or MB_ICONERROR);
        result := false;
      end;
    end;

  // ----------------
  // Clean up again...
  // ----------------
  finally
    FreeAndNil(F);
  end;

end;  { GetFileAsHex }

So, nun mal ein Anwendungsbeispiel:

Delphi-Quellcode:

type
  TForm1 = class(TForm)
    ...
    OpenDialog1  : TOpenDialog;
    Memo1        : TMemo;
    ProgressBar1 : TProgressBar;
    Button3      : TButton;
  public
    DoCancel : Boolean;
  end;

...

// Bei Buttonklick Abbruchbedingung setzen 
procedure TForm1.Button3Click(Sender: TObject);
begin
  DoCancel := TRUE;
end;


// Die Callback-Routine - Keine Methode, da in Deklaration kein 'of object'
PROCEDURE Progress(const aPercent : Byte; var Cancel : Boolean);
BEGIN
  Form1.ProgressBar1.Position := aPercent;
  Application.ProcessMessages;
  Cancel := Form1.DoCancel;
END;

// -- Hier nun der eigentliche Aufruf --
procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    DoCancel   := FALSE;
    GetFileAsHex(OpenDialog1.FileName,memo1.Lines,TRUE,Progress);
  end;
end;

Das Ergebnis sieht dann folgendermaßen aus:

Code:

// Formatted=TRUE
42 4D 10 01 00 00 00 00  00 00 76 00 00 00 28 00 
00 00 10 00 00 00 10 00  00 00 01 00 04 00 00 00 
00 00 80 00 00 00 00 00  00 00 00 00 00 00 00 00 
00 00 00 00 00 00 00 00  00 00 00 00 80 00 00 80 
00 00 00 80 80 00 80 00  00 00 80 00 80 00 80 80 
00 00 C0 C0 C0 00 80 80  80 00 00 00 FF 00 00 FF 
00 00 00 FF FF 00 FF 00  00 00 FF 00 FF 00 FF FF 
...

//Formatted=FALSE
424D1001000000000000760000002800
00001000000010000000010004000000
00008000000000000000000000000000
00000000000000000000000080000080
00000080800080000000800080008080
0000C0C0C000808080000000FF0000FF
000000FFFF00FF000000FF00FF00FFFF
...

Abschließend sei noch erwähnt, dass sich das Ganze mit Sicherheit noch an zig Stellen verbessern, beschleunigen und vereinfachen lässt... also nur zu!


Gruß
Stephan

[edit=fkerber]Neu abgespeichert wg. Code-Highlighting. Mfg, fkerber[/edit]