Eu fiz isso, mas ainda não tive tempo de melhorá-la principalmente na
procedure Atualiza que quando testei não fungo no 98:
unit Menu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Buttons, ShellApi, ComCtrls;
type
TFRMPri = class(TForm)
Timer1: TTimer;
Panel4: TPanel;
ProgressBar1: TProgressBar;
BTBAtu: TBitBtn;
SPBAju: TSpeedButton;
Panel1: TPanel;
BTBCan: TBitBtn;
procedure Timer1Timer(Sender: TObject);
procedure BTBAtuClick(Sender: TObject);
procedure SPBAjuClick(Sender: TObject);
procedure BTBCanClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Atualiza;
private
{ Private declarations }
Atual,Nova:TDateTime; // REFERE-SE A DATA DO NOVO ARQUIVO E DO
ATUAL
ArqAtu,ArqNov,Destino:String; // REFERENTE AOS CAMINHOS DOS ARQUIVOS E
PASTAS
public
{ Public declarations }
end;
var
FRMPri: TFRMPri;
implementation
{$R *.DFM}
procedure TFRMPri.Atualiza;
Var Dados: TSHFileOpStruct;
begin
FillChar(Dados,SizeOf(Dados), 0);
with Dados do
begin
wFunc := FO_COPY;
pFrom := PChar(ArqNov);
pTo := PChar(Destino);
fFlags:= FOF_NOCONFIRMATION;
end;
SHFileOperation(Dados);
end;
procedure TFRMPri.Timer1Timer(Sender: TObject);
begin
if (FileExists(ArqAtu)) and (FileExists(ArqNov)) then
begin
Atual:=FileDateToDateTime(FileAge(ArqAtu));
Nova :=FileDateToDateTime(FileAge(ArqNov));
if Nova>Atual then
begin
Panel1.Caption:='Atualização encontrada!';
BTBAtu.Visible:=true;
BTBCan.Visible:=true;
SPBAju.Visible:=true;
end
else
begin
WinExec(PChar(ParamStr(2)),SW_NORMAL);
Application.Terminate;
end;
end
else
begin
MessageDlg('Arquivo não encontrado. Reconfigure os parâmetros no
atalho.'+#13#13+
' Parâmetros:'+#13+
' - Local e nome do arquivo atualizado.'+#13+
' - Local e nome do arquivo antigo.'+#13+
' - Destino da cópia do novo arquivo.'
,mtError,[mbok],0);
Application.Terminate;
end;
Timer1.Enabled:=false;
end;
procedure TFRMPri.BTBAtuClick(Sender: TObject);
Var I:Integer;
begin
ProgressBar1.Visible:=true;
for I:=0 to 100 do
begin
ProgressBar1.Position:=I;
Sleep(20);
end;
Atualiza;
WinExec(Pchar(ArqAtu),SW_NORMAL);
Application.Terminate;
end;
procedure TFRMPri.SPBAjuClick(Sender: TObject);
begin
MessageDlg('Detalhes da atualização:'+#13+'Atual:
'+DateTimeToStr(Atual)+#13+
'Nova: '+DateTimeToStr(Nova)
,mtInformation,[mbok],0);
end;
procedure TFRMPri.BTBCanClick(Sender: TObject);
begin
Application.Terminate;
end;
procedure TFRMPri.FormCreate(Sender: TObject);
begin
if ParamStr(1)<>'' then
begin
ArqNov :=ParamStr(1);
ArqAtu :=ParamStr(2);
Destino:=ParamStr(3);
Timer1.Enabled:=true;
end
else
begin
MessageDlg('Nenhum parâmetro configurado no atalho.'+#13#13+
' Parâmetros:'+#13+
' - Local e nome do arquivo atualizado.'+#13+
' - Local e nome do arquivo antigo.'+#13+
' - Destino da cópia do novo arquivo.'
,mtError,[mbok],0);
Application.Terminate;
end;
end;
end.
{
DESCRIÇÃO DOS PARÂMETROS:
PARAMETRO 1 - ARQUIVO COMPARADO PARA SER COPIADO
PARAMETRO 2 - ARQUIVO COMPARADO PARA SER SUBSTITUÍDO
PARAMETRO 3 - LOCAL PARA ONDE O ARQUIVO SERÁ COPIADO
}
é uma outro programa que verifica se há atualização e depois abre a sua
aplicação.
----- Original Message -----
From: "Catiúscia A. Barrilli da Cruz " <[EMAIL PROTECTED]>
To: "Delphi-Br" <delphi-br@yahoogrupos.com.br>
Sent: Wednesday, April 13, 2005 2:37 PM
Subject: [delphi-br] Atualizar executável automaticamente
Boa tarde !
Como faço para as estações, ao abrir o programa, chegar no servidor se o
executável que está lá é mais atual do que o está nas estações ?
grata
Cati
[As partes desta mensagem que não continham texto foram removidas]
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
Para ver as mensagens antigas, acesse:
http://br.groups.yahoo.com/group/delphi-br/messages
Para falar com o moderador, envie um e-mail para:
[EMAIL PROTECTED] ou [EMAIL PROTECTED]
Links do Yahoo! Grupos
--
<<<<< FAVOR REMOVER ESTA PARTE AO RESPONDER ESTA MENSAGEM >>>>>
Para ver as mensagens antigas, acesse:
http://br.groups.yahoo.com/group/delphi-br/messages
Para falar com o moderador, envie um e-mail para:
[EMAIL PROTECTED] ou [EMAIL PROTECTED]
Links do Yahoo! Grupos
<*> Para visitar o site do seu grupo na web, acesse:
http://br.groups.yahoo.com/group/delphi-br/
<*> Para sair deste grupo, envie um e-mail para:
[EMAIL PROTECTED]
<*> O uso que você faz do Yahoo! Grupos está sujeito aos:
http://br.yahoo.com/info/utos.html
