Delphi Sempre
Blog dedicado a pequenas dicas para programadores em Delphi.
segunda-feira, 2 de novembro de 2020
segunda-feira, 5 de outubro de 2020
segunda-feira, 30 de março de 2020
Timeout - aplicativo fechar depois de um tempo ocioso
Aqui está um código de exemplo que permitirá que você feche um aplicativo se o usuário estiver dormindo enquanto estiver trabalhando / se ele ficar afk por muito tempo.
Isso pode ser útil para programas como o MIRC, onde eles usam esse valor de tempo limite. Alguns jogos online funcionam assim também para impedir que o usuário use o servidor de banda, também me vem à mente o aplicativo de proteção de tela ou o programa de resfriamento da CPU.
- Primeiro, declare uma constante global chamada MaxTimeOutDelay. Afete-o a algum valor inteiro que representará o número máximo de segundos em que seu programa tem permissão para registrar a inatividade do usuário antes de executar uma ação.
- Segundo, declare uma variável chamada TimeElapsed como número inteiro. Isso acompanhará o tempo decorrido desde a última atividade do usuário gravada.
- Terceiro, coloque um cronômetro no formulário.
No evento FormCreate, defina TimeElapsed como 0.
Agora declare um procedimento simples que redefinirá o TimeElapsed.
Deve parecer com:
procedure TForm1.ResetTimeElapsed;
begin
TimeElapsed := 0;
end;
Two event can resume in a sufficient manner the gloabl user activity.
1 - OnKeyDown Event
2 - OnMouseMove
When the user do something the TimeElapsed is reset so for the two event the code will look like this.
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
ResetTimeElapsed;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
ResetTimeElapsed;
end;
Here the last bit of code. On timer event the TimeElapsed is incremented. In short, the Timer Transfer a value to the TimeElapsed variable every second (If you default value for timer wasn't changed).
Than it's just a simple check to see if the TimeElapsed have reached the MaxTimeOutValue.
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Inc(TimeElapsed);
if TimeElapsed = MaxTimeOutValue then begin
Timer1.Enabled := False;
Close;
end;
end;
Este programa fecha o aplicativo. Mas, na verdade, é muito mais útil associar o TimeOut a uma
rotina mais útil. Por exemplo, você pode fazer o computador dormir quando o usuário não fez
nada por 15 minutos, fazê-lo funcionar na bandeja do sistema para economizar energia / uso de PCU.
Declare a procedure thus:
procedure TForm1.HandleAppMessage(var Msg: TMsg; var Handled: Boolean);
begin
Case msg.Message of
WM_KEYFIRST..WM_KEYLAST, WM_MOUSEFIRST..WM_MOUSELAST: ResetTimeElapsed;
end;
Inherited;
end;
and in FormCreate set
Application.OnMessage := HandleAppMessage;
segunda-feira, 4 de fevereiro de 2019
Uso da cláusula HAVING
Quando usamos a clausula GROUP BY temos por vezes a tendencia em usar o HAVING para especificar uma condicao simples como especificado abaixo:
SELECT
META_GB.COD_PROJINT,
META_GB.COD_METPADRAO,
METAPADRAO.DES_METPADRAO,
METAPADRAO.COD_UNIDMED,
UNIDMED.SIG_UNIDMED
FROM
META_GB,
METAPADRAO,
UNIDMED
WHERE
( META_GB.COD_METPADRAO = METAPADRAO.COD_METPADRAO ) and
(METAPADRAO.COD_UNIDMED = UNIDMED.COD_UNIDMED)
GROUP BY
META_GB.COD_PROJINT,
META_GB.COD_METPADRAO,
METAPADRAO.DES_METPADRAO,
METAPADRAO.COD_UNIDMED,
UNIDMED.SIG_UNIDMED
HAVING ( META_GB.COD_PROJINT = :Param1 )
ao inves de usar a clausula having para condicionar coloque esta condicao na clausula WHERE como especificado abaixo
SELECT
META_GB.COD_PROJINT,
META_GB.COD_METPADRAO,
METAPADRAO.DES_METPADRAO,
METAPADRAO.COD_UNIDMED,
UNIDMED.SIG_UNIDMED
FROM
META_GB,
METAPADRAO,
UNIDMED
WHERE
( META_GB.COD_METPADRAO = METAPADRAO.COD_METPADRAO ) and
(METAPADRAO.COD_UNIDMED = UNIDMED.COD_UNIDMED) and
( META_GB.COD_PROJINT = :Param1 )
GROUP BY
META_GB.COD_PROJINT,
META_GB.COD_METPADRAO,
METAPADRAO.DES_METPADRAO,
METAPADRAO.COD_UNIDMED,
UNIDMED.SIG_UNIDMED
obs: caso a condicionante seja de grupo esta tem que ficar obrigatoriamente na clausula HAVING
Sql relacionada com a primeira letra
query1.active := false;
query1.sql.clear;
query1.sql.add('select * from estrucpr where upper(portugues)like "LETRA%" ');
query1.active:= true;
PRIMEIRA LETRA "LETRA%"
ULTIMA LETRA "%LETRA"
QUE CONTENHA A LETRA "%LETRA%"
query1.sql.clear;
query1.sql.add('select * from estrucpr where upper(portugues)like "LETRA%" ');
query1.active:= true;
PRIMEIRA LETRA "LETRA%"
ULTIMA LETRA "%LETRA"
QUE CONTENHA A LETRA "%LETRA%"
Sql pesquisando utilizando um edit
query1.active := false;
query1.sql.clear;
query1.sql.add('select * from teste where nome = "' + edit1.Text + '"');
query1.active:= true;
query1.sql.clear;
query1.sql.add('select * from teste where nome = "' + edit1.Text + '"');
query1.active:= true;
Selecionando registros de uma tabela que não existam em outra tabela
(SELECT * FROM ,
WHERE . = .
AND . = 'AP'
MINUS
(SELECT * FROM @remoto1, @remoto1
WHERE @remoto1. = @remoto1.
AND @remoto1. = 'AP'
obs: todos os campos retornados no SELECT secundário deverá conter os mesmos campos do SELECT primário
Procura com mais de um Banco de Dados
edit1.text:= dbcombobox1.Text;
QueryPrinc.active := false;
QueryPrinc.sql.clear;
QueryPrinc.sql.add('select * from estrucpr where portugues = "' + edit1.Text + '"');
QueryPrinc.active:= true;
if DBcodEl.text=DBcodEl.text then
edit2.Text:= DBcodEl.Text;
QuerySin.active := false;
QuerySin.sql.clear;
QuerySin.sql.add(' select * from sinonimo where sin_est_id = "' + edit2.text + ' "');
QuerySin.active:= true;
if DBcodEl.text=DBcodEl.text then
edit3.Text:= DBcodEl.Text;
QueryPropFis.active := false;
QueryPropFis.sql.clear;
QueryPropFis.sql.add('select * from FIQU_PRO where fiqu_id = "' + edit3.Text + '"');
QueryPropFis.active:= true;
QueryPrinc.active := false;
QueryPrinc.sql.clear;
QueryPrinc.sql.add('select * from estrucpr where portugues = "' + edit1.Text + '"');
QueryPrinc.active:= true;
if DBcodEl.text=DBcodEl.text then
edit2.Text:= DBcodEl.Text;
QuerySin.active := false;
QuerySin.sql.clear;
QuerySin.sql.add(' select * from sinonimo where sin_est_id = "' + edit2.text + ' "');
QuerySin.active:= true;
if DBcodEl.text=DBcodEl.text then
edit3.Text:= DBcodEl.Text;
QueryPropFis.active := false;
QueryPropFis.sql.clear;
QueryPropFis.sql.add('select * from FIQU_PRO where fiqu_id = "' + edit3.Text + '"');
QueryPropFis.active:= true;
Otimizações no SQL
As dicas abaixo foram testadas essencialmente com Oracle
1) Todas as vezes que for utilizar um SQL que possua condições de OR, é mais aconselhável e mais rápido utilizar IN, como no exemplo:
AO INVÉS DE
Select * from projint where sit_projint = ‘AI’ or sit_projint = ‘EL’
COLOQUE
Select * from projint where sit_projint IN (‘AI’,‘EL’);
2) Quando existem duas ou mais condições AND juntas, especifique primeiro sempre a que possui o maior limite de ocorrências
AO INVÉS DE
select count(*) from pessoa where sit_pessoa = 11 AND cod_munic > 1100155
COLOQUE
select count(*) from pessoa where cod_munic > 1100155 AND sit_pessoa = 11
3) Quando existem duas ou mais condições OR juntas, especifique primeiro sempre a que possui o maior limite de ocorrências
AO INVÉS DE
select count(*) from pessoa where cod_munic > 1100155 OR sit_pessoa = 11
COLOQUE
select count(*) from pessoa where sit_pessoa = 11 OR cod_munic > 1100155
4) Tenha cuidado com o sinal de <>
AO INVÉS DE
select count(*) from pessoawhere cod_munic < > 1100155
COLOQUE
select count(*) from pessoawhere cod_munic < 1100155 OR cod_munic > 1100155
Extraindo o ano, mês ou dia de uma data via SQL
Select * from nome_tabela where extract(year from campo_data) = 2019
Você pode extrair o mês (MONTH) ou o dia (DAY).
Você pode extrair o mês (MONTH) ou o dia (DAY).
Excluindo registros de uma tabela
Desejo excluir registro de uma tabela que dependem da existência de outros de outra(s) tabela(s), como fazer?
DELETE FROM
WHERE (, ,)
IN
(SELECT , ,
FROM a, b
WHERE a. = b.
AND b. = 'AP' )
Criando tabelas via SQL
Inclua na seção uses: dbTables
- Coloque um TButton no form;
- Escreve no OnClick do Button como abaixo:
procedure TForm1.Button1Click(Sender: TObject);
var
Q: TQuery;
begin
Q := TQuery.Create(Application);
try
Q.DatabaseName := 'SF';
with Q.SQL do begin
Add('Create Table Funcionarios');
Add('( Codigo AutoInc,');
Add(' Nome Char(30),');
Add(' Salario Money,');
Add(' Depto SmallInt,');
Add(' Primary Key (Codigo) )');
end;
Q.ExecSQL;
finally
Q.Free;
end;
end;
- Coloque um TButton no form;
- Escreve no OnClick do Button como abaixo:
procedure TForm1.Button1Click(Sender: TObject);
var
Q: TQuery;
begin
Q := TQuery.Create(Application);
try
Q.DatabaseName := 'SF';
with Q.SQL do begin
Add('Create Table Funcionarios');
Add('( Codigo AutoInc,');
Add(' Nome Char(30),');
Add(' Salario Money,');
Add(' Depto SmallInt,');
Add(' Primary Key (Codigo) )');
end;
Q.ExecSQL;
finally
Q.Free;
end;
end;
Consultar por mês de um campo data
Problema:
Tenho um cadastro de clientes com Codigo, Nome, DataNasc, etc.
Preciso fazer uma consulta onde apareceão apenas os clientes que fazem aniversário em determinado mês. Como fazer?
Solução:
Use uma Query como abaixo:
- Coloque no form os seguintes componentes:
* TQuery
* TDataSource
* TDBGrid
* TEdit
* TButton
- Altere as propriedades dos componentes como abaixo:
* Query1.DatabaseName = (alias)
* DataSource1.DataSet = Query1
* DBGrid1.DataSource = DataSource1
- Coloque o código abaixo no evento OnClick de Button1:
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('select * from dCli');
Query1.SQL.Add('where extract(month from DataNasc) = :Mes');
Query1.ParamByName('Mes').AsInteger := StrToInt(Edit1.Text);
Query1.Open;
- Execute. Digite um número de 1 a 12 no Edit e clique no botão.
Tenho um cadastro de clientes com Codigo, Nome, DataNasc, etc.
Preciso fazer uma consulta onde apareceão apenas os clientes que fazem aniversário em determinado mês. Como fazer?
Solução:
Use uma Query como abaixo:
- Coloque no form os seguintes componentes:
* TQuery
* TDataSource
* TDBGrid
* TEdit
* TButton
- Altere as propriedades dos componentes como abaixo:
* Query1.DatabaseName = (alias)
* DataSource1.DataSet = Query1
* DBGrid1.DataSource = DataSource1
- Coloque o código abaixo no evento OnClick de Button1:
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Add('select * from dCli');
Query1.SQL.Add('where extract(month from DataNasc) = :Mes');
Query1.ParamByName('Mes').AsInteger := StrToInt(Edit1.Text);
Query1.Open;
- Execute. Digite um número de 1 a 12 no Edit e clique no botão.
Consultando entre datas utilizando SQL
If DateTimePicker2.Date < DateTimePicker1.Date Then
begin
ShowMessage('Intervalo de datas inválido, a data inicial é maior que a data final!');
DateTimePicker2.Date := DateTimePicker1.Date;
end
Else
begin
Inicio := DateToStr(DateTimePicker1.Date);
Final := DateToStr(DateTimePicker2.Date);
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Text := 'SELECT Nome,Empresa,FoneRes,FoneCom,Mala FROM Contatos WHERE Data >=:pInicial and Data<=:pFinal ORDER BY Nome';
Query1.ParamByName('pInicial').AsDateTime := StrToDate(Inicio);
Query1.ParamByName('pFinal').AsDateTime := StrToDate(Final);
Query1.Prepare;
Query1.Open;
DBGrid3D1.SetFocus
end;
Label3.Caption := 'Total de contatos: ' + IntToStr(Query1.RecordCount)
begin
ShowMessage('Intervalo de datas inválido, a data inicial é maior que a data final!');
DateTimePicker2.Date := DateTimePicker1.Date;
end
Else
begin
Inicio := DateToStr(DateTimePicker1.Date);
Final := DateToStr(DateTimePicker2.Date);
Query1.Close;
Query1.SQL.Clear;
Query1.SQL.Text := 'SELECT Nome,Empresa,FoneRes,FoneCom,Mala FROM Contatos WHERE Data >=:pInicial and Data<=:pFinal ORDER BY Nome';
Query1.ParamByName('pInicial').AsDateTime := StrToDate(Inicio);
Query1.ParamByName('pFinal').AsDateTime := StrToDate(Final);
Query1.Prepare;
Query1.Open;
DBGrid3D1.SetFocus
end;
Label3.Caption := 'Total de contatos: ' + IntToStr(Query1.RecordCount)
Consulta SQL que usa a data do sistema
Problema:
Preciso fazer uma consulta com SQL que me retorne todos os registros em que o valor de um campo do tipo data seja igual ou anterior à dada do sistema. Como fazer?
Solução:
Query.Close;
Query.SQL.Text := 'select * from Tabela where CampoData <= :Hoje';
Query.ParamByName('Hoje').AsDate := Date;
Query.Open;
Observações
Este exemplo foi testado com tabelas Paradox, mas deve funcionar na maioria dos bancos de dados com pouca ou nenhuma alteração
Como usar a cláusula UNION em um Query
O uso do componente TQuery gera muitas vantagens e economiza muitas linhas de programação. Mas muitas vezes nos deparamos com situações que parecem não ser resolvidas com sentenças SQL. Vejamos um exemplo:
Você possui 2 tabelas (VendasExternas e VendasInternas) e deseja fazer um resumo de todas as vendas de um vendedor chamado Marcos. Se você usar a sentença
SELECT Nome, Valor FROM VendasExternas, VendasInternas
WHERE Nome = 'Marcos'
você vai obter como resultado uma query com 4 campos (Nome, Valor, Nome_1 e Valor_1) e um resultado bem confuso para ser manipulado.
Para resolver o problema, você poderá usar a sentença
SELECT Nome, Valor FROM VendasExternas
WHERE Nome = 'Marcos'
UNION ALL
SELECT Nome, Valor FROM VendasInternas
WHERE Nome = 'Marcos'
A sentença acima pede para que sejam identificados as vendas de Marcos na tabela VendasExternas, as vendas de Marcos na tabela VendasInternas e que o resultado da primeira seja unido com o resultado da segunda produzindo uma query com apenas 2 colunas.
Bloco PL/SQL para inserção de dados
Pergunta
Criar um bloco pl/sql que insira um novo dep na tabela s_dept
- use a sequencia s_dept_id para o campo id da tabela
- solicite ao usuario o nome do dep
- insira valores nulos p/ o campo region_id
Resposta
-> no banco de dados...
create or replace
procedure insere_departamento (v_nome char) is
v_id number;
begin
SELECT sequenciaID.NEXTVAL INTO v_id FROM DUAL;
insert into tabela (id,dep,region_id)
values (v_id,v_nome,null);
end insere_departamento;
-> no delphi...
- coloque o objeto TStoredProc dentro do formulario que ira disparar esta procedure;
- no evento que voce quiser que dispare coloque o seguinte codigo:
var
v_nome : String[50];
begin
{caso vc queira informar o nome do departamento atraves de uma caixa de dialogo}
V_nome := inputbox('Informe o nome do departamento.','Depto:','');
{caso vc queira buscar o nome atraves de um TEdit já preenchido}
end;
Alterando parcialmente o conteúdo da prop.SQL de uma Query
Vamos supor que você tenha uma instrução SQL em uma Query como a seguinte:
SELECT IDCliente, cli_Nome, cli_DataNasc, cli_Sexo
FROM Cliente
WHERE ( IDCliente < 1000 )
AND ( cli_Sexo = 'M' ) (*)
ORDER BY cli_Nome
Para alterar somente a quarta(*) linha do SQL você pode fazer assim:
with qryCliente do
begin
if Active then Close;
SQL[3] := 'AND ( cli_UF = 'ES') OR ( cli_UF = 'RJ' )'; // ou SQL[3] := ' ';
Open;
end;
segunda-feira, 23 de abril de 2018
quinta-feira, 24 de agosto de 2017
Retorna a hora da criação de um diretório
function DirectoryTime(aDir: String): String;
var
srFile: TSearchRec;
begin
if FindFirst('C:WINDOWS',faDirectory,srFile)=0 then
begin
result := TimeToStr(FileDateToDateTime(srFile.Time));
end;
end;
Programar meu aplicativo para abrir arquivos a partir do Windows Explorer
Inclua na seção uses: Registry
Problema:
Criei um editor de textos no Delphi. Agora gostaria que o Windows Explorer usasse este editor para abrir arquivos com a extensão .dpg e .dan. Como fazer?
Solução:
Para fazer isto será necessária a criação de algumas chaves no Registro do Windows. O exemplo abaixo cria todas as chaves necessárias.
- Coloque um TButton e no evento OnClick dele coloque o código abaixo:
procedure TForm1.Button1Click(Sender: TObject);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CLASSES_ROOT;
Reg.LazyWrite := false;
{ Define o nome interno (ArquivoDaniel) e uma legenda que aparecerá no Windows Explorer (Arquivo do Daniel) }
Reg.OpenKey('ArquivoDaniel', true);
Reg.WriteString('', 'Arquivo do Daniel');
Reg.CloseKey;
{ Define o comando a ser executado quando abrir um arquivo pelo Windows Explorer (NomeDoExe %1). O símbolo %1 indica que o arquivo a ser aberto será passado como primeiro parâmetro para o aplicativo - ParamStr(1). }
Reg.OpenKey('ArquivoDaniel\shell\open\command', true);
Reg.WriteString('', ParamStr(0) + ' %1'); { NomeDoExe %1 }
Reg.CloseKey;
{ Define o ícone a ser usado no Windows Explorer:
0 - primeiro ícone do EXE
1 - segundo ícone do EXE, etc }
Reg.OpenKey('ArquivoDaniel\DefaultIcon', true);
Reg.WriteString('', ParamStr(0) + ',0'); { 0 = primeiro ícone }
Reg.CloseKey;
{ Define as extensões de arquivos que serão abertos pelo meu aplicativo }
{ *.dpg }
Reg.OpenKey('.dpg', true);
Reg.WriteString('', 'ArquivoDaniel');
Reg.CloseKey;
{ *.dan }
Reg.OpenKey('.dan', true);
Reg.WriteString('', 'ArquivoDaniel');
Reg.CloseKey;
finally
Reg.Free;
end;
end;
- Coloque um TMemo;
- No evento OnShow do Form coloque o código abaixo:
procedure TForm1.FormShow(Sender: TObject);
begin
{ Se o primeiro parâmetro for um nome de arquivo existente... }
if FileExists(ParamStr(1)) then
{ Carrega o conteúdo do arquivo no memo }
Memo1.Lines.LoadFromFile(ParamStr(1));
end;
*** Para testar ***
- Execute este programa;
- Clique no botão para criar as chaves no Registro do Windows;
- Feche o programa;
- Crie alguns arquivos com as extensões .dpg e .dan;
- Vá ao Windows Explorer e procure pelos arquivos criados;
- Experimente dar um duplo-clique sobre qualquer dos arquivos com uma das extensões acima.
Observações
Existem outros recursos que poderão ser configurados. Porém, para começar, este já é um bom exemplo.
sábado, 19 de agosto de 2017
Mostrando a lista de último acesso dos arquivos aberto ultimamente
unit Uultimoacesso;
{object Form1: TForm1
Left = 230
Top = 186
Width = 435
Height = 167
Caption = 'Ultimo Acesso'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Arial'
Font.Style = []
PixelsPerInch = 96
TextHeight = 18
object Label1: TLabel
Left = 6
Top = 11
Width = 53
Height = 18
Caption = 'Arquivo'
end
object Label2: TLabel
Left = 6
Top = 58
Width = 101
Height = 18
Caption = 'Último Acesso'
end
object EdArquivo: TEdit
Left = 6
Top = 28
Width = 281
Height = 26
TabOrder = 0
end
object BtSeleciona: TButton
Left = 226
Top = 82
Width = 87
Height = 31
Caption = 'Seleciona'
TabOrder = 1
OnClick = BtSelecionaClick
end
object EdUltimoAcesso: TEdit
Left = 6
Top = 82
Width = 204
Height = 26
TabOrder = 2
end
object ODSelecionaArquivo: TOpenDialog
Left = 352
Top = 8
end
end
}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
EdArquivo: TEdit;
BtSeleciona: TButton;
Label1: TLabel;
Label2: TLabel;
EdUltimoAcesso: TEdit;
ODSelecionaArquivo: TOpenDialog;
procedure BtSelecionaClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.BtSelecionaClick(Sender: TObject);
var
FileHandle : THandle;
LocalFileTime : TFileTime;
DosFileTime : DWORD;
LastAccessdTime : TDateTime;
FindData : TWin32FindData;
NomeArquivo : array[0..255] of char;
begin
if OdSelecionaArquivo.Execute then
begin
EdArquivo.Text := OdSelecionaArquivo.FileName;
StrPCopy(NomeArquivo,OdSelecionaArquivo.FileName);
FileHandle := FindFirstFile(NomeArquivo, FindData);
if FileHandle = INVALID_HANDLE_VALUE then
begin
Windows.FindClose(Handle);
if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
begin
FileTimetoLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
FileTimeToDosDateTime(LocalFileTime, LongRec(DosFileTime).Hi, LongRec(DosFileTime).Lo);
LastAccessdTime := FileDateToDateTime(DosFileTime);
EdUltimoAcesso.Text := DateTimeToStr(LastAccessdTime);
end;
end;
end;
end;
end.
{object Form1: TForm1
Left = 230
Top = 186
Width = 435
Height = 167
Caption = 'Ultimo Acesso'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Arial'
Font.Style = []
PixelsPerInch = 96
TextHeight = 18
object Label1: TLabel
Left = 6
Top = 11
Width = 53
Height = 18
Caption = 'Arquivo'
end
object Label2: TLabel
Left = 6
Top = 58
Width = 101
Height = 18
Caption = 'Último Acesso'
end
object EdArquivo: TEdit
Left = 6
Top = 28
Width = 281
Height = 26
TabOrder = 0
end
object BtSeleciona: TButton
Left = 226
Top = 82
Width = 87
Height = 31
Caption = 'Seleciona'
TabOrder = 1
OnClick = BtSelecionaClick
end
object EdUltimoAcesso: TEdit
Left = 6
Top = 82
Width = 204
Height = 26
TabOrder = 2
end
object ODSelecionaArquivo: TOpenDialog
Left = 352
Top = 8
end
end
}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
EdArquivo: TEdit;
BtSeleciona: TButton;
Label1: TLabel;
Label2: TLabel;
EdUltimoAcesso: TEdit;
ODSelecionaArquivo: TOpenDialog;
procedure BtSelecionaClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.BtSelecionaClick(Sender: TObject);
var
FileHandle : THandle;
LocalFileTime : TFileTime;
DosFileTime : DWORD;
LastAccessdTime : TDateTime;
FindData : TWin32FindData;
NomeArquivo : array[0..255] of char;
begin
if OdSelecionaArquivo.Execute then
begin
EdArquivo.Text := OdSelecionaArquivo.FileName;
StrPCopy(NomeArquivo,OdSelecionaArquivo.FileName);
FileHandle := FindFirstFile(NomeArquivo, FindData);
if FileHandle = INVALID_HANDLE_VALUE then
begin
Windows.FindClose(Handle);
if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
begin
FileTimetoLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
FileTimeToDosDateTime(LocalFileTime, LongRec(DosFileTime).Hi, LongRec(DosFileTime).Lo);
LastAccessdTime := FileDateToDateTime(DosFileTime);
EdUltimoAcesso.Text := DateTimeToStr(LastAccessdTime);
end;
end;
end;
end;
end.
Listar Arquivos de Um Diretório
Uma dica sobre como listar qualquer tipo de arquivos de um diretório. o toque especial dessa procedure e que ela pode entrar em todos os diretórios que estão dentro do diretório inicial, para procurar arquivos do tipo especificado.
parametros da procedure:
diretorio inicial - diretório que a procedure começa a sua busca ex: c:\windows\ ou ainda c:\ mascara - mascara de arquivo ex: *.txt ou ainda *.* listtotaldir - quando true, ela fornece o caminho completo recursive - quando true, ativa a busca do arquivo dentro de outros diretórios, que estao dentro do diretório inicial
obs.:O form que ira chamar esta função deve possuir uma variavel global declarada da sequinte forma
listtemp2:Tstrings;
ele deve ser criada com o comando
listtemp2 := TstringList.Create;
depois de chamada a procedure o resultado final estara nesta variavel
procedure ListarArquivos(diretorioInicial, mascara: string; listtotaldir: boolean = false; recursive: boolean = true);
var
i: integer;
listatemp: TStrings;
procedure ListarDiretorios(Folder: string; lista: Tstrings);
var
Rec: TSearchRec;
i: integer;
temps: string;
begin
lista.Clear;
if SysUtils.FindFirst(Folder + '*', faDirectory, Rec) = 0 then
try
repeat
lista.Add(rec.Name);
until SysUtils.FindNext(Rec) <> 0;
finally
if lista.count <> 0 then
begin
// deleta o diretorio ..
lista.Delete(1);
// deleta o diretorio .
lista.Delete(0);
i := 0;
//deleta os arquivos isto e fica apenas os diretorios
if lista.count <> 0 then
begin
repeat
temps := lista.Strings[i];
temps := extractfileext(temps);
if temps <> '' then
lista.Delete(i)
else
inc(i);
until i >= lista.Count;
end;
end;
end;
end;
procedure ListarAtahos(Folder, mask: string; Lista: Tstrings);
var
Rec: TSearchRec;
begin
lista.Clear;
if SysUtils.FindFirst(Folder + mask, faAnyFile, Rec) = 0 then
try
repeat
lista.Add(rec.Name);
until SysUtils.FindNext(Rec) <> 0;
finally
SysUtils.FindClose(Rec);
end;
end;
procedure AddLIstInOther(ListSource, ListDestino: TStrings);
var
f: integer;
begin
for f := 0 to ListSource.Count - 1 do
begin
ListDestino.Add(ListSource.Strings[f]);
end;
end;
begin
listatemp := TStringList.Create;
ListarAtahos(diretorioInicial, mascara, listatemp);
if listtotaldir = true then
begin
for i := 0 to listatemp.Count - 1 do
begin
listatemp.Strings[i] := diretorioInicial + listatemp.Strings[i];
end;
end;
AddLIstInOther(listatemp, listtemp2);
if recursive = true then
begin
ListarDiretorios(diretorioInicial, listatemp);
for i := 0 to listatemp.Count - 1 do
begin
ListarArquivos(diretorioInicial + listatemp.Strings[i] + '\', mascara, listtotaldir, recursive);
end;
end;
listatemp.Free;
end;
exemplo:
coloca-se um listbox, e um button no form.
depois declara-se a variavel global no form
ex:
var
Form1: TForm;
listtemp2: TStrings;
e no evento onclick do button a seguinte procedure
listtemp2 := TStringList.Create;
ListarArquivos('c:\windows\', '*.exe', true, true);
listbox1.items := listtemp2;
listtemp2.free;
Assinar:
Postagens (Atom)