Lenguaje de programación Borland Delphi
A continuación os mostramos tres funciones para obtener el tamaño de un fichero. Salvo la función 1, las demás, obtienen el tamaño de un fichero abierto, para la realización hemos utilizado cuatro TLabel (etiquetas), un TEdit (cuadro de texto) y un TButton (botón):
unit UnidadMenuPrincipal;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TformMenuPrincipal = class(TForm)
txtFichero: TEdit;
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Button2: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure txtFicheroChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
formMenuPrincipal: TformMenuPrincipal;
implementation
{$R *.dfm}
function tamanoFichero1 (sFileToExamine: string) : Longword;
var
FileHandle: THandle;
FileSize: Longword;
d1: Double;
begin
FileHandle := CreateFile(PChar(sFileToExamine),
GENERIC_READ,
0, {exclusivo}
nil, {seguridad}
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0);
FileSize := GetFileSize(FileHandle, nil);
Result := FileSize;
CloseHandle(FileHandle);
end;
function tamanoFichero2 (sFileToExamine: string) : Integer;
var
SearchRec: TSearchRec;
sgPath: string;
inRetval, I1: Integer;
begin
sgPath := ExpandFileName(sFileToExamine);
try
inRetval := FindFirst(ExpandFileName(sFileToExamine), faAnyFile, SearchRec);
if inRetval = 0 then
I1 := SearchRec.Size
else
I1 := -1;
finally
SysUtils.FindClose(SearchRec);
end;
Result := I1;
end;
function tamanoFichero3(const FileName: string): TULargeInteger;
var
Find: THandle;
Data: TWin32FindData;
begin
Result.QuadPart := -1;
Find := FindFirstFile(PChar(FileName), Data);
if (Find <> INVALID_HANDLE_VALUE) then
begin
Result.LowPart := Data.nFileSizeLow;
Result.HighPart := Data.nFileSizeHigh;
Windows.FindClose(Find);
end;
end;
procedure TformMenuPrincipal.Button1Click(Sender: TObject);
begin
Label1.Caption := 'Función 1: ' + FormatFloat('#,### Bytes', tamanoFichero1 (txtFichero.Text));
Label2.Caption := 'Función 2: ' + FormatFloat('#,### Bytes', tamanoFichero2 (txtFichero.Text));
Label3.Caption := 'Función 3: ' + FormatFloat('#,### Bytes', tamanoFichero3(txtFichero.Text).QuadPart);
// FormatFloat('#,###', bytesPorSector))
end;
procedure TformMenuPrincipal.Button2Click(Sender: TObject);
begin
if OpenDialog1.Execute then
txtFichero.Text := OpenDialog1.FileName;
end;
procedure TformMenuPrincipal.txtFicheroChange(Sender: TObject);
begin
Label1.Caption := '';
Label2.Caption := '';
Label3.Caption := '';
end;
end.
Si es usuario registrado puede descargar/download el código fuente del truco pulsando aquí.
Publicado el: 2005-04-16