Compara dois arquivos textos

procedure TForm1.Button1Click(Sender: TObject);
var
       filename1 : string;
       filename2 : string;
begin
      filename1 := Edit1.Text;
      filename2 := Edit2.Text;
      compfile(filename1, filename2);
      showmessage('Veja o resultado no arquivo c:Tempdiff.txt');
end;
 
procedure tform1.compfile(filename1, filename2 : string);
var
     f1 : system.textfile;
     f2 : system.textfile;
     diff : system.textfile;
     buf1 : string;
     buf2 : string;
     l : integer;
begin
    assignfile(f1, filename1);
    assignfile(f2, filename2);
    assignfile(diff, 'c:Tempdiff.txt');
    reset(f1);
    reset(f2);
    rewrite(diff);
    l := 1;
   while not eof(f1) do begin
       readln(f1, buf1);
       readln(f2, buf2);
       if not (compstr(buf1, buf2) )then begin
           writeln(diff, 'line: '+ inttostr(l) + '-' + buf1);
           writeln(diff, 'line: '+ inttostr(l) + '-' + buf2);
           writeln(diff, ' ');
       end;
       inc(l);
   end;
   closefile(f1);
   closefile(f2);
   closefile(diff);
end;
 
function tform1.compstr(s1, s2 : string) : boolean;
var
     i : integer;
     btemp : boolean;
begin
     btemp := true;
     if (length(s1) <> length(s2)) then begin
         btemp := false;
     end{if}
     else begin
          for i:= 1 to length(s1) do begin
               if (s1[i] <> s2[i]) then begin
                   btemp := false;
                   exit;
               end;{if}
          end;{for}
     end;{else}
     result := btemp;
end;

Como extrair o tamanho de um arquivo

function TForm1.TamArquivo(Arquivo: string): Integer;
begin
with TFileStream.Create(Arquivo, fmOpenRead or fmShareExclusive) do
try
Result := Size;
finally
Free;
end;
end;

Utilize a função assim:

procedure TForm1.Button1Click(Sender: TObject);
begin
edit1.text:= inttostr(TamArquivo('CAMINHO\NOMEDOARQUIVO'));
end;

Adiciona a barra invertida a um texto selecionado

function AddBarra(S: string): string;
var
Temp: string;
begin
Temp := S;
if S[Length(Temp)] <> '\' then
Temp := Temp + '\';
Result := Temp;
end;

Abrir arquivos com aplicativo associado

Inclua a unit SHELLAPI na clausula uses do seu form.

procedure TForm1.ExecFile(F: String);
var
r: String;
begin
case ShellExecute(Handle, nil, PChar(F), nil, nil, SW_SHOWNORMAL) of
ERROR_FILE_NOT_FOUND: r := 'The specified file was not found.';
ERROR_PATH_NOT_FOUND: r := 'The specified path was not found.';
ERROR_BAD_FORMAT: r := 'The .EXE file is invalid (non-Win32 .EXE or error in .EXE image).';
SE_ERR_ACCESSDENIED: r := 'Windows 95 only: The operating system denied access to the specified file.';
SE_ERR_ASSOCINCOMPLETE: r := 'The filename association is incomplete or invalid.';
SE_ERR_DDEBUSY: r := 'The DDE transaction could not be completed because other DDE transactions were being processed.';
SE_ERR_DDEFAIL: r := 'The DDE transaction failed.';
SE_ERR_DDETIMEOUT: r := 'The DDE transaction could not be completed because the request timed out.';
SE_ERR_DLLNOTFOUND: r := 'Windows 95 only: The specified dynamic-link library was not found.';
SE_ERR_NOASSOC: r := 'There is no application associated with the given filename extension.';
SE_ERR_OOM: r := 'Windows 95 only: There was not enough memory to complete the operation.';
SE_ERR_SHARE: r := 'A sharing violation occurred.';
else
Exit;
end;
ShowMessage(r);
end;

Utilize a função assim: 

procedure TForm1.Button1Click(Sender: TObject);
begin
ExecFile('c:\windows\ladrilhos.bmp');
end;
 

Apagando todos os registros da tabela

Para apagar os registros de uma tabela utiliza-se a função delete.

Através de um comando de repetição (While) é possível excluir todos os registros da tabela, usando como flag a quantidade de registros existentes na tabela (RecordCount > 0).

Código Completo:

Procedure ApagarTodosReg(Origem:TDataSet);
Begin
With Origem do
 While RecordCount > 0 do
Delete;
End;
Como Usar:

ApagarTodosReg(Table1);

Arquivos AVI e WAV em tabelas

O Exemplo Abaixo Demonstra Como Gravar Um Arquivo .Avi Ou .Wav Dentro De Um Arquivo Paradox. Mostra Também Como Reproduzir Estes Arquivos.

Para Que O Código Abaixo Funcione Inclua Em Um Form 02 Componentes Button, 01 Componente Panel, 01 Componente Dbgrid, 01 Componente Table, 01 Componente Datasource E 01 Componente Opendialog.

Crie Um Arquivo Paradox Com A Seguinte Estrutura:

Nome Tipo Tamanho

Codigo +

Nome A 100
Avi B

Unit Unit1;
Interface
Uses
Windows, Messages, Sysutils, Classes, Graphics, Controls, Forms, Dialogs,
Stdctrls, Db, Dbtables, Extctrls, Mplayer, Dbctrls, Grids, Dbgrids;
Type
Tform1 = Class(Tform)
Button1: Tbutton;
Button2: Tbutton;
Table1: Ttable;
Datasource1: Tdatasource;
Dbgrid1: Tdbgrid;
Panel1: Tpanel;
Opendialog1: Topendialog;
Table1codigo: Tautoincfield;
Table1nome: Tstringfield;
Table1avi: Tblobfield;
Procedure Button1click(Sender: Tobject);
Procedure Button2click(Sender: Tobject);
Procedure Formdestroy(Sender: Tobject);
Procedure Formshow(Sender: Tobject);
Procedure Formclose(Sender: Tobject; Var Action: Tcloseaction);
Private
{ Private Declarations }
Public
{ Public Declarations }
End;
Var Form1: Tform1;
Filename : String;
Mediaplayer1 : Tmediaplayer;

Implementation
{$R *.Dfm}
{Esta Função Cria Um Arquivo Temporário Para O Sistema}
Function Gettemporaryfilename : String;
{$Ifndef Win32}
Const Max_path = 144;
{$Endif}
Var
{$Ifdef Win32}
Lppathbuffer : Pchar;
{$Endif}
Lpbuffer : Pchar;
Begin
{Get The File Name Buffer}
Getmem(Lpbuffer, Max_path);
{$Ifdef Win32}
{Get The Temp Path Buffer}
Getmem(Lppathbuffer, Max_path); {Get The Temp Path}
Gettemppath(Max_path, Lppathbuffer); {Get The Temp File Name}
Gettempfilename(Lppathbuffer,'Tmp',0,Lpbuffer);
Freemem(Lppathbuffer, Max_path);
{$Else} {Get The Temp File Name}
Gettempfilename(Gettempdrive('C'),'Tmp',0,Lpbuffer);
{$Endif} {Create A Pascal String Containg}
{The Temp File Name And Return It}
Result := Strpas(Lpbuffer);
{Free The File Name Buffer}
Freemem(Lpbuffer, Max_path);
End;
{Grava Avi Ou Wav No Arquivo Paradox}
Procedure Tform1.Button1click(Sender: Tobject);
Var Filestream: Tfilestream; {Para Ler O Arquivo Avi}
Blobstream: Tblobstream; {Para Salvar No Campo Blob}
Begin
Application.Processmessages;
Button1.Enabled := False;
Button2.Enabled := False;

If Opendialog1.Execute Then
Filestream := Tfilestream.Create(Opendialog1.Filename,Fmopenread);
Table1.Append;
Table1nome.Value := Opendialog1.Filename;
Blobstream := Tblobstream.Create(Table1avi, Bmreadwrite);
Blobstream.Seek(0, Sofrombeginning);
Blobstream.Truncate;
Blobstream.Copyfrom(Filestream, Filestream.Size);
Filestream.Free;
Blobstream.Free;
Table1.Post;
Button1.Enabled := True;
Button2.Enabled := True;
End;
{Reproduz O Que Está Gravado No Campo Blob}
Procedure Tform1.Button2click(Sender: Tobject);
Var Filestream: Tfilestream; {A Temp File}
Blobstream: Tblobstream; {The Avi Blob}
Begin
Blobstream := Tblobstream.Create(Table1avi, Bmread);
If Blobstream.Size = 0 Then
Begin
Blobstream.Free;
Exit;
End;
Mediaplayer1.Close; {Reset The File Name}
Mediaplayer1.Filename := ''; {Refresh The Play Window}
Mediaplayer1.Display := Panel1;
Panel1.Refresh;
If Filename <> '' Then
Deletefile(Filename); {Get A Temp File Name}
Filename := Gettemporaryfilename; {Create A Temp File Stream}
Filestream := Tfilestream.Create(Filename,Fmcreate Or Fmopenwrite);
Filestream.Copyfrom(Blobstream, Blobstream.Size); {Free The Streams}
Filestream.Free; Blobstream.Free;
Mediaplayer1.Filename := Filename;
Mediaplayer1.Devicetype := Dtavivideo;
Mediaplayer1.Open;
Mediaplayer1.Play;
End;
// Evento Ondestroy Do Form
Procedure Tform1.Formdestroy(Sender: Tobject);
Begin
Mediaplayer1.Close;
Mediaplayer1.Filename := '';
If Filename <> '' Then
Deletefile(Filename);
End;
// Evento Onshow Do Form
Procedure Tform1.Formshow(Sender: Tobject);
Begin
Mediaplayer1 := Tmediaplayer.Create(Self);
With Mediaplayer1 Do
Begin
Parent := Self ;
Visible := False;
End;
Table1.Open;
End;
// Evento Onclose Do Form
Procedure Tform1.Formclose(Sender: Tobject; Var Action: Tcloseaction);
Begin
Table1.Close;
End;
End.

Cuidados ao usar o OnExit

É comum fazermos uso do evento OnExit quando queremos validar o conteúdo de um Edit. E essa pode ser uma boa prática quando necessitamos verificar o que foi digitado apenas quando o usuário terminar de fazer a entrada de dados, como, por exemplo, um Edit que vai receber o CPF ou CNPJ.

Ao colocarmos um código qualquer no evento OnExit ele sempre será executado quando o usuário sair do Edit, o que acontece quando ele pressiona a tecla TAB, clica com o mouse em um outro Edit ou pressiona um botão OK, por exemplo.

No entanto, existem algumas situações especiais em que o evento OnExit não é gerado. Quer um exemplo? Você está no Edit e, ao invés de clicar no botão OK, você pressiona as teclas ALT + O (considerando que o botão OK tem a tecla O como atalho). É como se você tivesse pressionado o botão OK, porém, sem perder o foco que está no Edit. Só mais um exemplo: Os botões do tipo SpeedButton não recebem foco, então, mesmo que clique com o mouse sobre um SpeedButton, o foco continuará no Edit e, conseqüentemente, o evento OnExit não será gerado.

E a solução?

A solução para esse pequeno inconveniente é simples. Basta você colocar o seguinte código no evento OnClick do botão.

procedure TForm1.Button1Click(Sender: TObject);

begin

ActiveControl := nil;

...

end;

Suponhamos que você possua 2 Edits em um formulário. Supondo também que você queira dar alguma informação ao usuário da aplicação logo depois que ele sair do Edit1 você faz:

procedure TForm1.Edit1Exit(Sender: TObject);

begin

MessageDlg('Mensagem...', mtInformation, [mbOk], 0);

end;

A princípio está tudo ok, ou melhor, parece estar tudo ok.

Se você altera o foco para o outro Edit através do pressionamento da tecla TAB, tudo bem. Mas experimente alterar o foco clicando com o mouse sobre o Edit2. Neste segundo caso a mensagem será exibida normalmente. Mas ao fechar o dialogo onde aparece a mensagem, o foco simplesmente se perde. Para setar o foco no Edit2 é necessário clicar novamente sobre ele.

Isso poderia não problema nenhum até que seu usuário experimente esta situação. Nada que ele digitar será acatado.

Mas existe uma maneira fácil de resolver o problema. Basta você cancelar o foco e forçar uma reentrada no componente Edit2. Como fazer isso? Veja o código:

procedure TForm1.Edit1Exit(Sender: TObject);

begin

MessageDlg('Mensagem...', mtInformation, [mbOk], 0);

// cancela o foco e força novamente a entrada

ActiveControl := nil;

PostMessage(Edit2.Handle, WM_SETFOCUS, 0, 0);

Edit2.SetFocus;

end;

Porém, você nunca terá certeza se o usuário clicou foi no Edit2. Então temos que criar uma rotina genérica que leva o foco para qualquer outro controle:

procedure TForm1.Edit1Exit(Sender: TObject);

var

Ctrl: TWinControl;

begin

MessageDlg('Mensagem...', mtInformation, [mbOk], 0);

// cancela o foco e força novamente a entrada

Ctrl := ActiveControl;

ActiveControl := nil;

PostMessage(TWinControl(Ctrl).Handle, WM_SETFOCUS, 0, 0);

TWinControl(Ctrl).SetFocus;

end;

Observe que antes de cancelar o foco com ActiveControl := nil, salvamos qual é o controle que detém o foco fazendo Ctrl := ActiveControl.

Depois enviamos uma mensagem ao controle que detinha o foco, forçando-o a receber o foco novamente.