Tudo sobre Arquivos, Diretórios e Discos

[Surfistinha£ 20]

Indice

 

Obter a letra do drive onde está o Windows

Obter tamanho de um arquivo

Criar sub-diretório no diretório do EXE

Definir data/hora de um arquivo

Executar um programa e aguardar sua finalização antes de continuar

Obter os atributos de um arquivo/diretório

Obter o espaço total e livre de um disco

Obter o tipo de um drive (removível, fixo, CD-ROM, unidade de rede, etc)

Obter informações de um volume/disco (label, serial, sistema de arquivos, etc)

Alterar o nome de volume (Label) de um disco

Saber quais as unidades de disco (drives) estão presentes

Formatar um disquete através de um programa Delphi

Copiar arquivos usando o Shell do Windows

Enviar um arquivo para a lixeira

Copiar arquivos usando curingas (*.*)

Copiar arquivos

Excluir arquivos usando curingas (*.*)

Verificar se uma unidade de disco (disk-drive) está preparada

Verificar se um diretório existe

Verificar se um arquivo existe

 

Obter a letra do drive onde está o Windows

 

Inclua na seção uses: Windows

Problema:

 

Como saber em qual unidade de disco (drive) o Windows está

instalado?

 

Solução:

 

Esta função retorna a letra do drive onde está instalado o

Windows:

 

function GetWindowsDrive: Char;

var

S: string;

begin

SetLength(S, MAX_PATH);

if GetWindowsDirectory(PChar(S), MAX_PATH) > 0 then

Result := string(S)[1]

else

Result := #0;

end;

 

{ Exemplo de uso: }

 

procedure TForm1.Button1Click(Sender: TObject);

begin

Caption := GetWindowsDrive;

end;

Obter tamanho de um arquivo

 

Inclua na seção uses: SysUtils

{ A função abaixo retorna o tamanho do arquivo, ou -1

se o arquivo não for encontrado }

 

function tbFileSize(const FileName: string): integer;

var

SR: TSearchRec;

I: integer;

begin

I := FindFirst(FileName, faArchive, SR);

try

if I = 0 then

Result := SR.Size

else

Result := -1;

finally

FindClose(SR);

end;

Criar sub-diretório no diretório do EXE

 

Inclua na seção uses: FileCtrl, SysUtils

Problema:

 

Gostaria de criar um sub-diretório dentro do diretório

onde se encontra o EXE de minha aplicação. Como fazer?

 

Solução:

 

Primeiramente vamos conhecer algumas funções do Delphi

que precisaremos usá-las:

 

ParamStr(Indice) - Retorna valores passados

na linha de comando quando executamos o programa. Se o valor

de Indice for 0 (zero) será retornado o caminho+nome do EXE.

 

ExtractFilePath(NomeArq) - Retorna o caminho (path) do

nome de arquivo informado.

Exemplo:

S := 'C:\NomeDir\Programa.exe';

ExtractFilePath(S); { retorna: 'C:\NomeDir\' }

 

DirectoryExists(CaminhoDir) - Retorna true se o diretório

informado existe. False em caso contrário.

 

CreateDir(CaminhoDir) - Tenta criar o diretório informado.

Se conseguir, retorna true. Caso contrário retorna false.

 

Agora que sabemos como trabalham estas funções, vamos

escrever uma função que precisamos para criar um

sub-diretório conforme proposto.

 

function CriaSubDir(const NomeSubDir: string): boolean;

var

Caminho: string;

begin

Caminho := ExtractFilePath(ParamStr(0)) + NomeSubDir;

if DirectoryExists(Caminho) then

Result := true

else

Result := CreateDir(Caminho);

end;

 

Exemplo de uso:

 

- Chame a função no evento OnCreate do form:

 

procedure TForm1.FormCreate(Sender: TObject);

begin

if not CriaSubDir('MeuSubDir') then

ShowMessage('Não foi possível criar o sub-diretório MeuSubDir.');

end;

Definir data/hora de um arquivo

 

Inclua na seção uses: SysUtils

{ Esta função altera a data e hora de um arquivo. Se obter

sucesso retorna true, caso contrário retorna false. }

 

function DefineDataHoraArq(NomeArq: string; DataHora: TDateTime): boolean;

var

F: integer;

begin

Result := false;

F := FileOpen(NomeArq, fmOpenWrite or fmShareDenyNone);

try

if F > 0 then

Result := FileSetDate(F, DateTimeToFileDate(DataHora)) = 0;

finally

FileClose(F);

end;

end;

 

{ Exemplo de uso 1: Usa a data atual do sistema (Now) }

 

if DefineDataHoraArq('c:\teste\logo.bmp', Now) then

ShowMessage('Data/Hora do arquivo definida com sucesso.')

else

ShowMessage('Não foi possível definir data/hora do arquivo.');

 

{ Exemplo de uso 2: Usa uma data fixa }

var

DataHora: TDateTime;

begin

{ Define a data para 5-Fev-1999 e a hora para 10:30 }

DataHora := EncodeDate(1999, 2, 5) + EncodeTime(10, 30, 0, 0);

 

if DefineDataHoraArq('c:\teste\logo.bmp', DataHora) then

ShowMessage('Data/Hora do arquivo definida com sucesso.')

else

ShowMessage('Não foi possível definir data/hora do arquivo.');

end;

Executar um programa e aguardar sua finalização antes de continuar

 

Inclua na seção uses: Windows

{ Esta função faz isto. }

 

function ExecAndWait(const FileName, Params: string;

const WindowState: Word): boolean;

var

SUInfo: TStartupInfo;

ProcInfo: TProcessInformation;

CmdLine: string;

begin

{ Coloca o nome do arquivo entre aspas. Isto é necessário devido

aos espaços contidos em nomes longos }

CmdLine := '"' + Filename + '"' + Params;

FillChar(SUInfo, SizeOf(SUInfo), #0);

with SUInfo do begin

cb := SizeOf(SUInfo);

dwFlags := STARTF_USESHOWWINDOW;

wShowWindow := WindowState;

end;

Result := CreateProcess(nil, PChar(CmdLine), nil, nil, false,

CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil,

PChar(ExtractFilePath(Filename)), SUInfo, ProcInfo);

 

{ Aguarda até ser finalizado }

if Result then begin

WaitForSingleObject(ProcInfo.hProcess, INFINITE);

{ Libera os Handles }

CloseHandle(ProcInfo.hProcess);

CloseHandle(ProcInfo.hThread);

end;

end;

 

- Exemplo de uso:

 

ExecAndWait('c:\windows\notepad.exe', '', SW_SHOW);

 

Observações

 

Não se esqueça de informar o caminho (path) do arquivo completo. Esta função foi desenvolvida para Delphi 32 bits (2, 3, 4,...).

Obter os atributos de um arquivo/diretório

Inclua na seção uses: Windows

{ No form:

- Coloque um memo;

- Coloque um edit;

- Coloque um botão e escreva seu OnClick como abaixo: }

 

procedure TForm1.Button1Click(Sender: TObject);

var

Attr: DWord;

begin

Memo1.Clear;

Attr := GetFileAttributes(PChar(Edit1.Text));

if Attr > 0 then

with Memo1.Lines do begin

if (Attr and FILE_ATTRIBUTE_ARCHIVE) > 0 then

Add('Archive');

if (Attr and FILE_ATTRIBUTE_COMPRESSED) > 0 then

Add('Compressed');

if (Attr and FILE_ATTRIBUTE_DIRECTORY) > 0 then

Add('Directory');

if (Attr and FILE_ATTRIBUTE_HIDDEN) > 0 then

Add('Hidden');

if (Attr and FILE_ATTRIBUTE_NORMAL) > 0 then

Add('Normal');

if (Attr and FILE_ATTRIBUTE_OFFLINE) > 0 then

Add('OffLine');

if (Attr and FILE_ATTRIBUTE_READONLY) > 0 then

Add('ReadOnly');

if (Attr and FILE_ATTRIBUTE_SYSTEM) > 0 then

Add('System');

if (Attr and FILE_ATTRIBUTE_TEMPORARY) > 0 then

Add('Temporary');

end;

end;

 

Obter o espaço total e livre de um disco

 

Inclua na seção uses: Windows

{ - Coloque um memo (TMemo) no form;

- Coloque um botão e altere seu OnClick como abaixo: }

 

procedure TForm1.Button1Click(Sender: TObject);

var

SetoresPorAgrup, BytesPorSetor, AgrupLivres,

TotalAgrup: DWord;

begin

Memo1.Clear;

if GetDiskFreeSpace('C:\', SetoresPorAgrup,

BytesPorSetor, AgrupLivres, TotalAgrup) then

with Memo1.Lines do begin

Add('Setores por agrupamento: ' + IntToStr(SetoresPorAgrup));

Add('Bytes por setor: ' + IntToStr(BytesPorSetor));

Add('Agrupamentos livres: ' + IntToStr(AgrupLivres));

Add('Total de agrupamentos: ' + IntToStr(TotalAgrup));

Add('----- Resumo -----');

Add('Total de bytes: ' +

IntToStr(TotalAgrup * SetoresPorAgrup * BytesPorSetor));

Add('Bytes livres: ' +

IntToStr(AgrupLivres * SetoresPorAgrup * BytesPorSetor));

end;

end;

 

{ O exemplo acima retorna as medidas em Bytes, Setores e

Agrupamentos. Se preferir algo mais simples,

use funções do Delphi. Veja: }

 

Memo1.Lines.Add('Total de bytes: ' + IntToStr(DiskSize(3)));

Memo1.Lines.Add('Bytes livres: ' + IntToStr(DiskFree(3)));

 

{ Onde o parâmetro (3) é o número da unidade, sendo

1=A, 2=B, 3=C, ... }

 

Observações

 

Para usar as funções DiskSize e DiskFree coloque SysUtils em uses.

 

Obter o tipo de um drive (removível, fixo, CD-ROM, unidade de rede, etc)

 

Inclua na seção uses: Windows, Dialogs

{ - Coloque um edit (Edit1) e um botão no form;

- Altere o OnClick do botão conforme abaixo: }

 

procedure TForm1.Button1Click(Sender: TObject);

var

S: string;

Tipo: byte;

begin

Tipo := GetDriveType(PChar(Edit1.Text[1] + ':\'));

case Tipo of

0: S := 'Tipo indeterminado';

1: S := 'Drive não existe';

DRIVE_REMOVABLE: S := 'Disco removível';

DRIVE_FIXED: S := 'Disco Fixo';

DRIVE_REMOTE: S := 'Unidade de rede';

DRIVE_CDROM: S := 'CD-ROM';

DRIVE_RAMDISK: S := 'RAM Disk';

else

S := 'Erro';

end;

ShowMessage(S);

end;

 

{ Para pegar o tipo da unidade atual troque...}

Tipo := GetDriveType(PChar(Edit1.Text[1] + ':\'));

{ por }

Tipo := GetDriveType(nil);

 

Observações

 

Para testar digite a letra do drive no Edit1 e clique no botão. A unit Dialogs foi colocada no uses apenas por causa da procedure ShowMessage. Para exibir todas as unidades existentes e seus respectivos tipos, use a função tbGetDrives (da pergunta 64) em conjunto com este exemplo.

 

Obter informações de um volume/disco (label, serial, sistema de arquivos, etc

 

Inclua na seção uses: Windows, System

{ - Coloque um memo (TMemo) no form;

- Coloque um botão e escreve seu evento

OnClick como abaixo: }

 

procedure TForm1.Button1Click(Sender: TObject);

var

SLabel, SSysName: PChar;

Serial, FileNameLen, X: DWord;

begin

Memo1.Clear;

GetMem(SLabel, 255);

GetMem(SSysName, 255);

try

GetVolumeInformation('C:\', SLabel, 255,

@Serial, FileNameLen, X, SSysName, 255);

with Memo1.Lines do begin

Add('Nome do volume (Label): ' + string(SLabel));

Add('Número Serial: ' + IntToHex(Serial, 8));

Add('Tamanho máximo p/ nome arquivo: ' +

IntToStr(FileNameLen));

Add('Sistema de Arquivos: ' + string(SSysName));

end;

finally

FreeMem(SLAbel, 255);

FreeMem(SSysName, 255);

end;

end;

 

 

 

Alterar o nome de volume (Label) de um disco

 

Inclua na seção uses: Windows

{ Da unidade C: }

SetVolumeLabel('c:\', 'NovoLabel');

 

{ Da unidade atual: }

SetVolumeLabel(nil, 'NovoLabel');

 

 

Saber quais as unidades de disco (drives) estão presentes

 

Inclua na seção uses: Windows

{ A função abaixo retorna uma string contendo

as letras de unidades de discos presentes. }

 

function tbGetDrives: string;

var

Drives: DWord;

I: byte;

begin

Result := '';

Drives := GetLogicalDrives;

if Drives <> 0 then

for I := 65 to 90 do

if ((Drives shl (31 - (I - 65))) shr 31) = 1 then

Result := Result + Char(I);

end;

 

{ Para saber se uma determinada unidade está presente,

basta fazer algo como: }

if Pos('A', tbGetDrives) > 0 then

ShowMessage('Unidade A: presente.')

else

ShowMessage('Unidade A: ausente.');

 

Observações

 

A string retornada pela função tbGetDrives está sempre em letras maiúsculas.

 

Formatar um disquete através de um programa Delphi

 

{ Coloque o código abaixo imediatamente abaixo da palavra

implementation: }

 

const

SHFMT_ID_DEFAULT = $FFFF;

 

{ Opções de formatação }

SHFMT_OPT_QUICKFORMAT = $0000; { Formatação rápida }

SHFMT_OPT_FULL = $0001; { Formatação completa }

SHFMT_OPT_SYSONLY = $0002; { Copia sistema }

 

{ Códigos de errros }

SHFMT_ERROR = $FFFFFFFF; { Ocorreu erro }

SHFMT_CANCEL = $FFFFFFFE; { Foi cancelado }

SHFMT_NOFORMAT = $FFFFFFFD; { Não formatou }

 

function SHFormatDrive(Handle: HWND; Drive, ID, Options: Word):

LongInt; stdcall; external 'shell32.dll' name 'SHFormatDrive'

 

{ Coloque um botão no form e altere o evento OnClick dele

conforme abaixo: }

 

procedure TForm1.Button3Click(Sender: TObject);

var

Erro: DWord;

Msg: string;

begin

Erro := SHFormatDrive(Handle, 0, SHFMT_ID_DEFAULT, SHFMT_OPT_QUICKFORMAT);

case Erro of

SHFMT_ERROR: Msg := 'Ocorreu um erro.';

SHFMT_CANCEL: Msg := 'A formatação foi cancelada.';

SHFMT_NOFORMAT: Msg := 'Não foi possível formatar.';

else

Msg := 'Disco formatado com sucesso.';

end;

ShowMessage(Msg);

end;

 

Observações

 

Para formatação completa troque SHFMT_OPT_QUICKFORMAT por SHFMT_OPT_FULL. O segundo parâmetro (zero no exemplo) indica a unidade, sendo que A é 0 (zero), B é 1, etc.

Copiar arquivos usando o Shell do Windows

 

Inclua na seção uses: ShellApi

{ - Coloque um botão no form e altere o evento OnClick

deste botão conforme abaixo: }

 

procedure TForm1.Button1Click(Sender: TObject);

var

Dados: TSHFileOpStruct;

begin

FillChar(Dados,SizeOf(Dados), 0);

with Dados do

begin

wFunc := FO_COPY;

pFrom := PChar('c:\teste\*.txt');

pTo := PChar('a:\');

fFlags:= FOF_ALLOWUNDO;

end;

SHFileOperation(Dados);

end;

 

Observações

 

Esta forma de copiar arquivos oferecem várias vantagens. O Shell avisa para pôr um próximo disco quando o atual estiver cheio. Mostra a barra de progresso. Pode copiar arquivos usando máscara de uma forma extremamente simples.

 

Enviar um arquivo para a lixeira

Inclua na seção uses: ShellApi

{ Coloque a procedure abaixo na seção implementation }

 

procedure ArqParaLixeira(const NomeArq: string; var MsgErro: string);

var

Op: TSHFileOpStruct;

begin

MsgErro := '';

if not FileExists(NomeArq) then begin

MsgErro := 'Arquivo não encontrado.';

Exit;

end;

FillChar(Op, SizeOf(Op), 0);

with Op do begin

wFunc := FO_DELETE;

pFrom := PChar(NomeArq);

fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT;

end;

if ShFileOperation(Op) <> 0 then

MsgErro := 'Não foi possível enviar o arquivo para a lixeira.';

end;

 

{ - Coloque um botão no Form;

- Altere o evento OnClick do botão conforme abaixo: }

 

procedure TForm1.Button1Click(Sender: TObject);

var

S: string;

begin

ArqParaLixeira('c:\Diretorio\Teste.doc', S);

if S = '' then

ShowMessage('O arquivo foi enviado para a lixeira.')

else

ShowMessage(S);

end;

 

Copiar arquivos usando curingas (*.*)

 

{ - Coloque um Button no Form;

- Altere o evento OnClick deste Button conforme abaixo: }

 

procedure TForm1.Button2Click(Sender: TObject);

var

SR: TSearchRec;

I: integer;

Origem, Destino: string;

begin

I := FindFirst('c:\Origem\*.*', faAnyFile, SR);

while I = 0 do begin

if (SR.Attr and faDirectory) <> faDirectory then begin

Origem := 'c:\Origem\' + SR.Name;

Destino := 'c:\Destino\' + SR.Name;

if not CopyFile(PChar(Origem), PChar(Destino), true) then

ShowMessage('Erro ao copiar ' + Origem + ' para ' + Destino);

end;

I := FindNext(SR);

end;

end;

 

Observações

 

No exemplo acima, se o arquivo já existir no destino, a função falha (não copia). Para que a função possa sobreescrever o arquivo destino (caso exista), altere o último parâmetro de CopyFile para false. CUIDADO! Se um arquivo for sobreescrito, estará perdido para sempre!

Copiar arquivos

 

{ - Coloque um Button no Form;

- Altere o evento OnClick deste Button conforme abaixo: }

 

procedure TForm1.Button2Click(Sender: TObject);

var

Origem, Destino: string;

begin

Origem := 'c:\Origem\NomeArq.txt';

Destino := 'c:\Destino\NomeArq.txt';

if not CopyFile(PChar(Origem), PChar(Destino), true) then

ShowMessage('Erro ao copiar ' + Origem + ' para ' + Destino);

end;

 

Observações

 

No exemplo acima, se o arquivo já existir no destino, a função falha (não copia). Para que a função possa sobreescrever o arquivo destino (caso exista), altere o último parâmetro de CopyFile para false. CUIDADO! Se um arquivo for sobreescrito, estará perdido para sempre!

Excluir arquivos usando curingas (*.*)

 

{ - Coloque um Button no Form;

- Altere o evento OnClick do Button conforme abaixo: }

 

procedure TForm1.Button2Click(Sender: TObject);

var

SR: TSearchRec;

I: integer;

begin

I := FindFirst('c:\Teste\*.*', faAnyFile, SR);

while I = 0 do begin

if (SR.Attr and faDirectory) <> faDirectory then

if not DeleteFile('c:\Teste\' + SR.Name) then

ShowMessage('Não consegui excluir c:\Teste\' + SR.Name);

I := FindNext(SR);

end;

end;

 

Observações

 

No exemplo acima todos os arquivos do diretório c:\Teste serão excluídos. CUIDADO! Arquivos excluídos desta forma não vão para a lixeira.

 

Verificar se uma unidade de disco (disk-drive) está preparada

 

Inclua na seção uses: System, SysUtils

{ - Crie um novo projeto;

- Na seção implementation da Unit1 digite a função abaixo: }

 

function DriveOk(Drive: Char): boolean;

var

I: byte;

begin

Drive := UpCase(Drive);

if not (Drive in ['A'..'Z']) then

raise Exception.Create('Unidade incorreta');

I := Ord(Drive) - 64;

Result := DiskSize(I) >= 0;

end;

 

{ - Coloque no Form1 um TEdit (Edit1)

- Coloque no Form1 um TButton

- Altere o evento OnClick do Button1 conforme abaixo: }

 

procedure TForm1.Button1Click(Sender: TObject);

begin

if DriveOk(Edit1.Text[1]) then

ShowMessage('Drive OK')

else

ShowMessage('Drive não preparado');

end;

 

Observações

 

Para testar você deverá executar o exemplo e digitar no Edit a letra do drive a ser testado (não precisa os dois-pontos). Após digitar, clique no Button1.

Verificar se um diretório existe

 

Inclua na seção uses: FileCtrl, Dialogs

if DirectoryExists('C:\MEUSDOCS') then

ShowMessage('O diretório existe')

else

ShowMessage('O diretório não existe');

Créditos

Surfistinha

Daniel

[mgbcrazy 0]

Keralwoooo mto pikaaaaaa

 

vou criar algum programinha e tentar reunir todos eles em uma seção de utilitarios (:

[DragonBoss 8]

olhaa, curti mesmo... varias dicas uteis.... ae o copyfile ta bem explikado, tira as duvidas de kem tava confuso sobre a funçao completa... entre varias outras dicas legais...

 

vlw

flw, abraços