Club Delphi  
    Paypal   FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > FireMonkey
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

 
 
Herramientas Buscar en Tema Desplegado
  #29  
Antiguo 11-05-2014
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Poder: 23
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
elmago00,

Cita:
Empezado por elmago00
...finalice el proyecto y mañana lo entrego a la empresa...
Falta una pequeña corrección

Revisa este código:
Código Delphi [-]
 unit Unit1;
 
 interface
 
 uses
   System.SysUtils, System.Types, System.UITypes, System.Rtti, System.Classes,
   System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
   FMX.StdCtrls;
 
 type
   TForm1 = class(TForm)
     Button1: TButton;
     Button2: TButton;
     procedure Button1Click(Sender: TObject);
     procedure Button2Click(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
   end;
 
 var
   Form1: TForm1;
 
 implementation
 
 {$R *.fmx}
 
 // Cambia n ocurrencias de una cadena Hex por una nueva cadena Hex en un archivo
 function ChangeFileHex(OldHex, NewHex, FileName : String) : Boolean;
 var
    F1, F2 : TFileStream;
    Buffer : Array of Byte;
    AuxHex : String;
    i,p : Integer;
    BPF, NBR : Integer;  // BPF = Bytes Per Row, NBR = Number of Bytes Read
 
 begin
 
    try
 
       F1 := TFileStream.Create(FileName, fmOpenRead);
       F2 := TFileStream.Create(ChangeFileExt(FileName,'.new'), fmCreate);
 
       BPF := Length(OldHex) div 2;
 
       SetLength(Buffer, BPF);
 
       while F1.Position < F1.Size do
       begin
          NBR := F1.Read(Buffer[0], BPF);
 
          AuxHex := EmptyStr;
          for i := Low(Buffer) to High(Buffer) do
             AuxHex := AuxHex + IntToHex(Buffer[i],2);
 
          if OldHex = AuxHex then
          begin
             p := 1;
             i := 0;
             while p <= Length(NewHex) do
             begin
                Buffer[i] := StrToInt('$' + Copy(NewHex,p,2));
                Inc(p,2);
                Inc(i,1);
             end;
             F2.Write(Buffer[0], NBR);
          end
          else
             F2.Write(Buffer[0], NBR);
       end;
 
       F1.Free;
       F2.Free;
       Result := True;
 
    except
 
       F1.Free;
       F2.Free;
       Result := False;
 
    end;
 
 end;
 
 // Sustituye en un Offset de archivo una cadena Hex
 function ChangeFileOffset(Offset : Integer; NewHex, FileName : String) : Boolean;
 var
    F1, F2 : TFileStream;
    Buffer : Array of Byte;
    AuxHex : String;
    i,p : Integer;
    CurrOffset : Integer;
    BPF, NBR : Integer;  // BPF = Bytes Per Row, NBR = Number of Bytes Read
 
 begin
 
    try
 
       F1 := TFileStream.Create(FileName, fmOpenRead);
       F2 := TFileStream.Create(ChangeFileExt(FileName,'.new'), fmCreate);
 
       BPF := Length(NewHex) div 2;
 
       SetLength(Buffer, BPF);
 
       CurrOffset := 0;
 
       while F1.Position < F1.Size do
       begin
 
          NBR := F1.Read(Buffer[0], BPF);
 
          if Offset = CurrOffset then
          begin
             p := 1;
             i := 0;
             while p <= Length(NewHex) do
             begin
                Buffer[i] := StrToInt('$' + Copy(NewHex,p,2));
                Inc(p,2);
                Inc(i,1);
             end;
             F2.Write(Buffer[0], NBR);
          end
          else
             F2.Write(Buffer[0], NBR);
 
          Inc(CurrOffset, BPF);
       end;
 
       F1.Free;
       F2.Free;
       Result := True;
 
    except
 
       F1.Free;
       F2.Free;
       Result := False;
 
    end;
 
 end;
 
 // Cambia n ocurrencias de una cadena Hex por una nueva cadena Hex en un archivo
 procedure TForm1.Button1Click(Sender: TObject);
 var
    OldHex, NewHex, Filename : String;
 
 begin
 
    OldHex := '671254437573746F6D466F726D2E4C6F';
    NewHex := 'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF';
    FileName := 'C:\Developers\Delphi XE4\Test-17 (ChangeFileHex)\FileTest.dcu';
 
    if ChangeFileHex(OldHex,NewHex,Filename) then
       MessageDlg('Cambio de Archivo Realizado', TMsgDlgType.mtInformation,[TMsgDlgBtn.mbOk],0)
    else
       MessageDlg('Error en Cambio de Archivo', TMsgDlgType.mtError,[TMsgDlgBtn.mbOk],0);
 
 end;
 
 // Sustituye en un Offset de archivo una cadena Hex
 procedure TForm1.Button2Click(Sender: TObject);
 var
    Offset : Integer;
    NewHex, Filename : String;
 
 begin
 
    Offset := 480;
    NewHex := 'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA';
    FileName := 'C:\Developers\Delphi XE4\Test-17 (ChangeFileHex)\FileTest.dcu';
 
    if ChangeFileOffset(Offset,NewHex,Filename) then
       MessageDlg('Cambio de Archivo Realizado', TMsgDlgType.mtInformation,[TMsgDlgBtn.mbOk],0)
    else
       MessageDlg('Error en Cambio de Archivo', TMsgDlgType.mtError,[TMsgDlgBtn.mbOk],0);
 
 end;
 
 end.
El código anterior en Delphi XE4 (FireMonkey) bajo Windows 7 Professional x32, es la versión 2 del código del Msg #41 con los siguientes cambios:

1- Optimiza el código y lo hace más legible.

2- Corrige el Número de Bytes a Escribir en función del NBR (Number of Bytes Read) en el caso de que los archivos procesados no sean múltiplos de BPF (Bytes Per Row).

Espero sea útil

Nelson.
Responder Con Cita
 



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
ayuda con este codigo kurono Varios 5 02-04-2014 00:25:11
Se estrena este foro sobre FireMonkey Neftali [Germán.Estévez] FireMonkey 9 09-11-2012 13:05:30
ayuda con este codigo kurono Varios 4 13-06-2008 01:03:29
necesito ayuda con este codigo kurono Varios 4 06-05-2008 07:02:07
procedimiento almacenado ayuda con este codigo pipecato Varios 5 16-12-2005 12:24:34


La franja horaria es GMT +2. Ahora son las 23:42:57.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi