Rotinas para Manipulação de Arquivos
Nesse artigo, demonstro para vocês como uma biblioteca padrão de manipulação de arquivos pode ser criado para que você e sua equipe, não necessitem reinventar a roda a todo momento. Ou seja rotinas que possuem processos repetitivos podem ser morosos e ainda permitir erros por parte do desenvolvedor, que com o passar do tempo tem que administrar milhares de linhas de código.
Por essa razão esse artigo é o primeiro de uma pequena série que permitirá termos uma visão de algumas rotinas que podem nos ajudar:
· Tratamento de arquivos(este artigo);
· Operações com DisksDrives;
· Operações de Hardware;
· Operações com Mouse;
· Operações com o Sistema;
· Operações com Strings;
Creio que com essas rotinas, padronizadas, vão servir de uma boa base para proteger e manter o seu sistema de maneira harmoniosa com sua equipe.
Várias vezes necessitamos ter rotinas de tratamento de arquivos, principalmente quando importamos dados de outros programas, de terceiros, ou até mesmo para proteger documentos, arquivos e nosso projeto.
Então.. mãos na massa. Crie um arquivo e dê o nome de “Arquivos”, no seu Delphi.
1: unit Arquivos;
2:
3: interface
4:
5: uses
6: Windows, Dialogs, Messages, SysUtils, Classes, Controls, StdCtrls,FileCtrl,
7: Graphics, shellapi, Printers;
8:
9:
10: function fileSize(const FileName: String): LongInt;
11: function GetFileDate(TheFileName: string): string;
12: function FileDate(Arquivo: String): String;
13: function FillDir(Const AMask: string): TStringList;
14: function WinExecAndWait32(FileName:String; Visibility : integer):integer;
15: Function RecycleBin(sFileName : string ) : boolean;
16: function NumLinhasArq(Arqtexto:String): integer;
17: function FileCopy(source,dest: String): Boolean;
18: function ExtractName(const Filename: String): String;
19: function FileTypeName(const aFile: String): String;
20: Procedure CopyFile( Const sourcefilename, targetfilename: String );
21: Procedure ZapFiles(vMasc:String);
22: function PrintImage(Origem: String):Boolean;
23:
24: implementation
25:
26: function fileSize(const FileName: String): LongInt;
27: {Retorna o tamanho de um arquivo}
28: var
29: SearchRec : TSearchRec;
30: begin { !Win32! -> GetFileSize }
31: if FindFirst(FileName,faAnyFile,SearchRec)=0
32: then Result:=SearchRec.Size
33: else Result:=0;
34: FindClose(SearchRec);
35: end;
36:
37:
38: function GetFileDate(TheFileName: string): string;
39: var
40: FHandle: integer;
41: begin
42: FHandle := FileOpen(TheFileName, 0);
43: result := DateToStr((FileDateToDateTime(FileGetDate(FHandle))));
44: FileClose(FHandle);
45: end;
46:
47:
48: function FileDate(Arquivo: String): String;
49: {Retorna a data e a hora de um arquivo}
50: var
51: FHandle: integer;
52: begin
53: if not fileexists(Arquivo) then
54: begin
55: Result := 'Nome de Arquivo Inválido';
56: end
57: else
58: begin
59: FHandle := FileOpen(Arquivo, 0);
60: try
61: Result := DateTimeToStr(FileDateToDateTime(FileGetDate(FHandle)));
62: finally
63: FileClose(FHandle);
64: end;
65: end;
66: end;
67:
68:
69: Procedure ZapFiles(vMasc:String);
70: {Apaga arquivos usando mascaras tipo: *.zip, *.* }
71: Var Dir : TsearchRec;
Unit1.pas 09/06/2010 18:37:20 Page 2 of 4
72: Erro: Integer;
73: Begin
74: Erro := FindFirst(vMasc,faArchive,Dir);
75: While Erro = 0 do Begin
76: DeleteFile( ExtractFilePAth(vMasc)+Dir.Name );
77: Erro := FindNext(Dir);
78: End;
79: FindClose(Dir);
80: End;
81:
82:
83: function FillDir(Const AMask: string): TStringList;
84: {Retorna uma TStringlist de todos os arquivos localizados
85: no path corrente , Esta função trabalha com mascaras}
86: var
87: SearchRec : TSearchRec;
88: intControl : integer;
89: begin
90: Result := TStringList.create;
91: intControl := FindFirst( AMask, faAnyFile, SearchRec );
92: if intControl = 0 then
93: begin
94: while (intControl = 0) do
95: begin
96: Result.Add( SearchRec.Name );
97: intControl := FindNext( SearchRec );
98: end;
99: FindClose( SearchRec );
100: end;
101: end;
102:
103:
104: function WinExecAndWait32(FileName:String; Visibility : integer):integer;
105: { Tenta executar o aplicativo finalizando-o corretamente apos o uso. Retorna -1 em caso de falha}
106: var
107: zAppName:array[0..512] of char;
108: zCurDir:array[0..255] of char;
109: WorkDir:String;
110: StartupInfo:TStartupInfo;
111: ProcessInfo:TProcessInformation;
112: begin
113: StrPCopy(zAppName,FileName);
114: GetDir(0,WorkDir);
115: StrPCopy(zCurDir,WorkDir);
116: FillChar(StartupInfo,Sizeof(StartupInfo),#0);
117: StartupInfo.cb := Sizeof(StartupInfo);
118: StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
119: StartupInfo.wShowWindow := Visibility;
120: if not CreateProcess(nil,zAppName,nil,nil,false,CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,nil,
121: begin
122: Result := -1;
123: end
124: else
125: begin
126: WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
127: GetExitCodeProcess(ProcessInfo.hProcess,Result);
128: end;
129: end;
130:
131:
132: Function RecycleBin(sFileName : string ) : boolean;
133: // Envia um arquivo para a lixeira ( requer a unit Shellapi.pas)
134: var
135: fos : TSHFileOpStruct;
136: Begin
137: FillChar( fos, SizeOf( fos ), 0 );
138: With fos do
139: begin
140: wFunc := FO_DELETE;
141: pFrom := PChar( sFileName );
142: fFlags := FOF_ALLOWUNDO
Unit1.pas 09/06/2010 18:37:20 Page 3 of 4
143: or FOF_NOCONFIRMATION
144: or FOF_SILENT;
145: end;
146: Result := (0 = ShFileOperation(fos));
147: end;
148:
149: function NumLinhasArq(Arqtexto:String): integer;
150: // Retorna o número de linhas que um arquivo possui
151: Var
152: f: Textfile;
153: linha, cont:integer;
154: Begin
155: linha := 0;
156: cont := 0;
157: AssignFile(f,Arqtexto);
158: Reset(f);
159: While not eof(f) Do
160: begin
161: ReadLn(f);
162: Cont := Cont + 1;
163: end;
164: Closefile(f);
165: result := cont;
166: end;
167:
168:
169: function FileCopy(source,dest: String): Boolean;
170: {copia um arquivo de um lugar para outro. Retornando falso em caso de erro}
171: var
172: fSrc,fDst,len: Integer;
173: size: Longint;
174: buffer: packed array [0..2047] of Byte;
175: begin
176: if source <> dest then
177: begin
178: fSrc := FileOpen(source,fmOpenRead);
179: if fSrc >= 0 then
180: begin
181: size := FileSeek(fSrc,0,2);
182: FileSeek(fSrc,0,0);
183: fDst := FileCreate(dest);
184: if fDst >= 0 then
185: begin
186: while size > 0 do
187: begin
188: len := FileRead(fSrc,buffer,sizeof(buffer));
189: FileWrite(fDst,buffer,len);
190: size := size - len;
191: end;
192: FileSetDate(fDst,FileGetDate(fSrc));
193: FileClose(fDst);
194: FileSetAttr(dest,FileGetAttr(source));
195: Result := True;
196: end
197: else
198: begin
199: Result := False;
200: end;
201: FileClose(fSrc);
202: end;
203: end;
204: end;
205:
206:
207: Procedure CopyFile( Const sourcefilename, targetfilename: String );
208: {Copia um arquivo de um lugar para outro}
209: Var
210: S, T: TFileStream;
211: Begin
212: S := TFileStream.Create( sourcefilename, fmOpenRead );
213: try
Unit1.pas 09/06/2010 18:37:20 Page 4 of 4
214: T := TFileStream.Create( targetfilename, fmOpenWrite or fmCreate );
215: try
216: T.CopyFrom(S, S.Size ) ;
217: finally
218: T.Free;
219: end;
220: finally
221: S.Free;
222: end;
223: end;
224:
225:
226: function ExtractName(const Filename: String): String;
227: {Retorna o nome do Arquivo sem extensão}
228: var
229: aExt : String;
230: aPos : Integer;
231: begin
232: aExt := ExtractFileExt(Filename);
233: Result := ExtractFileName(Filename);
234: if aExt <> '' then
235: begin
236: aPos := Pos(aExt,Result);
237: if aPos > 0 then
238: begin
239: Delete(Result,aPos,Length(aExt));
240: end;
241: end;
242: end;
243:
244:
245: function FileTypeName(const aFile: String): String;
246: {Retorna descrição do tipo do arquivo. Requer a unit ShellApi}
247: var
248: aInfo: TSHFileInfo;
249: begin
250: if SHGetFileInfo(PChar(aFile),0,aInfo,Sizeof(aInfo),SHGFI_TYPENAME)<>0 then
251: Result := StrPas(aInfo.szTypeName)
252: else begin
253: Result := ExtractFileExt(aFile);
254: Delete(Result,1,1);
255: Result := Result +' File';
256: end;
257: end;
258:
259:
260: function PrintImage(Origem: String):Boolean;
261: // imprime um bitmap selecionado retornando falso em caso negativo
262: // requer as units Graphics e printers declaradas na clausula Uses
263: var
264: Imagem: TBitmap;
265: begin
266: if fileExists(Origem) then
267: begin
268: Imagem := TBitmap.Create;
269: Imagem.LoadFromFile(Origem);
270: with Printer do
271: begin
272: BeginDoc;
273: Canvas.Draw((PageWidth - Imagem.Width) div 2,(PageHeight - Imagem.Height) div 2,Imagem);
274: EndDoc;
275: end;
276: Imagem.Free;
277: Result := True;
278: end
279: else
280: begin
281: Result := False;
282: end;
283: end;
284:
285: end.
286:
287:
Pronto pessoal!, Biblioteca de funções de arquivo, concluída.
Até a próxima. Abraços++
