Datei hexadezimal laden

[Steve]

Jo das wäre eigentlich geschickter...

Das sähe dann in etwa so aus:

Delphi-Quellcode:

  THexProgressEvent = procedure (const aPercent : Byte; var Cancel : Boolean) of object;

  THexLoader = class(TObject)
  private
    FOnProgress : THexProgressEvent;
    procedure SetOnProgress(const Value: THexProgressEvent);
  public
    function LoadFileAsHex(const aFileName : string;
                                 SL        : TStrings;
                                 Formatted : Boolean = TRUE) : Boolean;
  published
    property OnProgress : THexProgressEvent read FOnProgress write SetOnProgress;
  end;

Die Implementierung:

Delphi-Quellcode:

function THexLoader.LoadFileAsHex(const aFileName : string;
                                        SL        : TStrings;
                                        Formatted : Boolean = TRUE) : Boolean;
{ **************************************************************************** }
{ *  ----------------------     LoadFileAsHex     -------------------------  * }
{ **************************************************************************** }
{ * LoadFileAsHex 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]                * }
{ * ------------------------------------------------------------------------ * }
{ * LoadFileAsHex returns TRUE if everything worked fine, otherwise FALSE.   * }
{ * Reasons for failing: SL=NIL, File doesn't exist, Abort, Errors/Exceptions* }
{ * ------------------------------------------------------------------------ * }
{ * 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.1 [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 DoEvent : Boolean;
  begin
    Result := TRUE;
    if Assigned(FOnProgress) then
    begin
      FOnProgress(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; // --- DoEvent (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 executing an event...
       if not DoEvent 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 executing an event...
          if not DoEvent then Break;
        end;
        if Erg<>'' then SL.Add(Erg);
      end; { IF NOT Cancel }

      // We're done :-)
      if Assigned(FOnProgress) then
        FOnProgress(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;  { THexLoader.LoadFileAsHex }


procedure THexer.SetOnProgress(const Value: THexProgressEvent);
begin
  FOnProgress := Value;
end;

Die Anwendung könnte dann so aussehen:

Delphi-Quellcode:

procedure TForm1.Progress(const aPercent : Byte; var Cancel : Boolean);
begin
  ProgressBar1.Position := aPercent;
  Cancel                := DoCancel;
  Application.ProcessMessages;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    DoCancel := FALSE;
    with THexLoader.Create do
    begin
      OnProgress := Progress;
      LoadFileAsHex(OpenDialog1.FileName, Memo1.Lines, False);
      Free;
    end;
  end;
end;

Aus der Callback-Routine wird also kurz gesagt einfach ein Event, mehr ändert sich eigentlich nicht.

Gruß
Stephan

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