Buscar por:
Biblioteca para operações com arquivos

Código
//Biblioteca para operações com Arquivos

{*******************************************************}

{ }

{ Delphi Runtime Library }

{ Windows Messages and Types }

{ }

{ Copyright (c) 1991,96 Walter Alves Chagas Junior }

{ }

{*******************************************************}

unit Arquivos;

interface

uses

Windows, Dialogs, Messages, SysUtils, Classes, Controls, StdCtrls,FileCtrl,

Graphics, shellapi, Printers;

function fileSize(const FileName: String): LongInt;

function GetFileDate(çeFileName: string): string;

function FileDate(Arquivo: String): String;

function FillDir(Const AMask: string): TStringList;

function WinExecAndWait32(FileName:String; Visibility : integer):integer;

Function RecycleBin(sFileName : string ) : boolean;

function NumLinhasArq(Arqtexto:String): integer;

function FileCopy(source,dest: String): Boolean;

function ExtractName(const Filename: String): String;

function FileTypeName(const aFile: String): String;

Procedure CopyFile( Const sourcefilename, targetfilename: String );

Procedure ZapFiles(vMasc:String);

function PrintImage(Origem: String):Boolean;

implementation

function fileSize(const FileName: String): LongInt;

{Retorna o tamanho de um arquivo}

var

  SearchRec : TSearchRec;

begin { !Win32! -> GetFileSize }

  if FindFirst(FileName,faAnyFile,SearchRec)=0

  then Result:=SearchRec.Size

  else Result:=0;

  FindClose(SearchRec);

end;

function GetFileDate(çeFileName: string): string;

var

FHandle: integer;

begin

FHandle := FileOpen(çeFileName, 0);

result := DateToStr((FileDateToDateTime(FileGetDate(FHandle))));

FileClose(FHandle);

end;

function FileDate(Arquivo: String): String;

{Retorna a data e a hora de um arquivo}

var

FHandle: integer;

begin

if not fileexists(Arquivo) then

  begin

  Result := 'Nome de Arquivo Inválido';

  end

else

  begin

  FHandle := FileOpen(Arquivo, 0);

  try

  Result := DateTimeToStr(FileDateToDateTime(FileGetDate(FHandle)));

  finally

  FileClose(FHandle);

  end;

  end;

end;

Procedure ZapFiles(vMasc:String);

{Apaga arquivos usando mascaras tipo: *.zip, *.* }

Var Dir : TsearchRec;

  Erro: Integer;

Begin

  Erro := FindFirst(vMasc,faArchive,Dir);

  While Erro = 0 do Begin

  DeleteFile( ExtractFilepath(vMasc)+Dir.Name );

  Erro := FindNext(Dir);

  End;

  FindClose(Dir);

End;

function FillDir(Const AMask: string): TStringList;

{Retorna uma TStringlist de todos os arquivos localizados

 no path corrente , Esta função trabalha com mascaras}

var

  SearchRec : TSearchRec;

  intControl : integer;

begin

  Result := TStringList.create;

  intControl := FindFirst( AMask, faAnyFile, SearchRec );

  if intControl = 0 then

  begin

  while (intControl = 0) do

  begin

  Result.Add( SearchRec.Name );

  intControl := FindNext( SearchRec );

  end;

  FindClose( SearchRec );

  end;

end;

function WinExecAndWait32(FileName:String; Visibility : integer):integer;

{ Tenta executar o aplicativo finalizando-o corretamente apos o uso. Retorna -1 em caso de falha}

var

zAppName:array[0..512] of char;

zCurDir:array[0..255] of char;

WorkDir:String;

StartupInfo:TStartupInfo;

ProcessInfo:TProcessInformation;

begin

StrPCopy(zAppName,FileName);

GetDir(0,WorkDir);

StrPCopy(zCurDir,WorkDir);

FillChar(StartupInfo,Sizeof(StartupInfo),#0);

StartupInfo.cb := Sizeof(StartupInfo);

StartupInfo.dwFlags := STARTF_USESHOWWINDOW;

StartupInfo.wShowWindow := Visibility;

if not CreateProcess(nil,zAppName,nil,nil,false,CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLass,nil, nil,StartupInfo,ProcessInfo) then

  begin

  Result := -1;

  end

else

  begin

  WaitforSingleObject(ProcessInfo.hProcess,INFINITE);

  GetExitCodeProcess(ProcessInfo.hProcess,Result);

  end;

end;

Function RecycleBin(sFileName : string ) : boolean;

// Envia um arquivo para a lixeira ( requer a unit Shellapi.pas)

var

fos : TSHFileOpStruct;

Begin

FillChar( fos, SizeOf( fos ), 0 );

with fos do

begin

wFunc := FO_DELETE;

pFrom := PChar( sFileName );

fFlags := FOF_ALLOWUNDO

or FOF_NOCONFIRMATION

or FOF_SILENT;

end;

Result := (0 = ShFileOperation(fos));

end;

function NumLinhasArq(Arqtexto:String): integer;

// Retorna o número de linhas que um arquivo possui

Var

  f: Textfile;

  linha, cont:integer;

Begin

linha := 0;

cont := 0;

assignFile(f,Arqtexto);

Reset(f);

While not eof(f) Do

  begin

  ReadLn(f);

  Cont := Cont + 1;

  end;

Closefile(f);

result := cont;

end;

function FileCopy(source,dest: String): Boolean;

{copia um arquivo de um lugar para outro. Retornando falso em caso de erro}

var

fSrc,fDst,len: Integer;

size: Longint;

buffer: packed array [0..2047] of Byte;

begin

if source <> dest then

  begin

  fSrc := FileOpen(source,fmOpenRead);

  if fSrc >= 0 then

  begin

  size := FileSeek(fSrc,0,2);

  FileSeek(fSrc,0,0);

  fDst := FileCreate(dest);

  if fDst >= 0 then

  begin

  while size > 0 do

  begin

  len := FileRead(fSrc,buffer,sizeof(buffer));

  FileWrite(fDst,buffer,len);

  size := size - len;

  end;

  FileSetDate(fDst,FileGetDate(fSrc));

  FileClose(fDst);

  FileSetAttr(dest,FileGetAttr(source));

  Result := True;

  end

  else

  begin

  Result := False;

  end;

  FileClose(fSrc);

  end;

  end;

end;

Procedure CopyFile( Const sourcefilename, targetfilename: String );

{Copia um arquivo de um lugar para outro}

Var

  S, T: TFileStream;

Begin

  S := TFileStream.Create( sourcefilename, fmOpenRead );

  try

  T := TFileStream.Create( targetfilename, fmOpenWrite or fmCreate );

  try

  T.CopyFrom(S, S.Size ) ;

  finally

  T.Free;

  end;

  finally

  S.Free;

  end;

end;

function ExtractName(const Filename: String): String;

{Retorna o nome do Arquivo sem extensão}

var

aExt : String;

aPos : Integer;

begin

aExt := ExtractFileExt(Filename);

Result := ExtractFileName(Filename);

if aExt <> '' then

  begin

  aPos := Pos(aExt,Result);

  if aPos > 0 then

  begin

  Delete(Result,aPos,length(aExt));

  end;

  end;

end;

function FileTypeName(const aFile: String): String;

{Retorna descrição do tipo do arquivo. Requer a unit ShellApi}

var

  aInfo: TSHFileInfo;

begin

  if SHGetFileInfo(PChar(aFile),0,aInfo,Sizeof(aInfo),SHGFI_TYPENAME)<>0 then

  Result := StrPas(aInfo.szTypeName)

  else begin

  Result := ExtractFileExt(aFile);

  Delete(Result,1,1);

  Result := Result +' File';

  end;

end;

function PrintImage(Origem: String):Boolean;

// imprime um bitmap selecionado retornando falso em caso negativo

// requer as units Graphics e printers declaradas na clausula Uses

var

Imagem: TBitmap;

begin

if fileExists(Origem) then

  begin

  Imagem := TBitmap.Create;

  Imagem.LoadFromFile(Origem);

  with Printer do

  begin

  BeginDoc;

  Canvas.Draw((PageWidth - Imagem.Width) div 2,(PageHeight - Imagem.Height) div 2,Imagem);

  EndDoc;

  end;

  Imagem.Free;

  Result := True;

  end

else

  begin

  Result := False;

  end;

end;

end.