AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Code-Bibliothek Library: Sonstiges Delphi Datei hexadezimal laden
Thema durchsuchen
Ansicht
Themen-Optionen

Datei hexadezimal laden

Ein Thema von Steve · begonnen am 22. Jul 2005 · letzter Beitrag vom 25. Jul 2005
 
Benutzerbild von Steve
Steve

Registriert seit: 2. Mär 2004
Ort: Würzburg
730 Beiträge
 
Delphi 2006 Personal
 
#2

Re: Datei hexadezimal laden

  Alt 25. Jul 2005, 08:53
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]
Stephan B.
Wer andern eine Grube gräbt ist Bauarbeiter!
Wer im Glashaus sitzt, sollte sich lieber im Dunkeln ausziehen!
Außerdem dieser Satz kein Verb...
  Mit Zitat antworten Zitat
 

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 22:55 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz