Delphi Brasil - Nosso esporte é desenvolver!

{*******************************************************}
{ }
{ 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(TheFileName: 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(TheFileName: string): string;
var
FHandle: integer;
begin
FHandle := FileOpen(TheFileName, 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.

< Anterior		Próximo >

Menu Principal

Parceiros

Wgets downloads