CONTROLE DE ACESSOS
Código
> CRIE UMA PROCEDURE CHAMADA {ACESSOS}
procedure acessos;
> CLICK CTRL + SHIFT + C
> DECLARE AS VARIAVEIS
var
f, g: TextFile;
linha : string;
i, k : integer;
> DENTRO DO BLOCO PONHA
if not FileExists('C:teste_01.ini') then
begin
AssignFile(g,'C:teste_01.ini');
Rewrite(g);
Writeln(g,0);
Write(g,10);
CloseFile(g);
Memo1.Clear; // limpa o memo
AssignFile(f,'C:teste_01.ini'); // guarda o arquivo na variavel f
Reset(f); //abre o arquivo para leitura;
while not eof(f) do
begin
Readln(f,linha); //lê do arquivo e desce uma linha. O conteúdo lido é transferido para a variável linha
Memo1.lines.add(linha); // adciona arquivo ao memo
end;
i := StrToInt(Memo1.Lines.Strings[0]) + 1; // variavel i recebe contagem + 1
k := (StrToInt(Memo1.Lines.Strings[1]) - StrToInt(Memo1.Lines.Strings[0]));
Closefile(f);
Rewrite(f); //abre o arquivo para escrita
Writeln(f,inttostr(i)); // escreve a variavel i no arquivo
Writeln(f,Memo1.Lines.Strings[1]); //reescreve
Closefile(f); //fecha o handle de arquivo
if (StrToInt(Memo1.Lines.Strings[0]) > StrToInt(Memo1.Lines.Strings[1])) then // condição
begin
ShowMessage('O programa expirou entre em contato conosco, (085) 3457 7000');
Application.Terminate;
end
else
begin
MessageDlg('Você acessou o programa '+ (Memo1.Lines.Strings[0]) +' vez(es),'+#13+ 'você ainda tem direito a '+ IntToStr(k) +' acesso(s). ', mtInformation, [mbOK], 0);
end;
end
else
begin
Memo1.Clear; // limpa o memo
AssignFile(f,'C:teste_01.ini'); // guarda o arquivo na variavel f
Reset(f); //abre o arquivo para leitura;
while not eof(f) do
begin
Readln(f,linha); //lê do arquivo e desce uma linha. O conteúdo lido é transferido para a variável linha
Memo1.lines.add(linha); // adciona arquivo ao memo
end;
i := StrToInt(Memo1.Lines.Strings[0]) + 1; // variavel i recebe contagem + 1
k := (StrToInt(Memo1.Lines.Strings[1]) - StrToInt(Memo1.Lines.Strings[0]));
Closefile(f);
Rewrite(f); //abre o arquivo para escrita
Writeln(f,inttostr(i)); // escreve a variavel i no arquivo
Writeln(f,Memo1.Lines.Strings[1]); //reescreve
Closefile(f); //fecha o handle de arquivo
if (StrToInt(Memo1.Lines.Strings[0]) > StrToInt(Memo1.Lines.Strings[1])) then // condição
begin
ShowMessage('O programa expirou entre em contato conosco, (xxx) xxxx xxxx');
Application.Terminate;
end
else
begin
MessageDlg('Você acessou o programa '+ (Memo1.Lines.Strings[0]) +' vez(es),'+#13+ 'você ainda tem direito a '+ IntToStr(k) +' acesso(s). ', mtInformation, [mbOK], 0);
end;
end;
NO EVENTO ONCREATE DO FORM CHAME A PROCEDURE
acessos;
>>>>>> SEGUE ABAIXO TODO O CODIGO :
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
procedure acessos;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.acessos;
var
f, g: TextFile;
linha : string;
i, k : integer;
begin
if not FileExists('C:teste_01.ini') then
begin
AssignFile(g,'C:teste_01.ini');
Rewrite(g);
Writeln(g,0);
Write(g,10);
CloseFile(g);
Memo1.Clear; // limpa o memo
AssignFile(f,'C:teste_01.ini'); // guarda o arquivo na variavel f
Reset(f); //abre o arquivo para leitura;
while not eof(f) do
begin
Readln(f,linha); //lê do arquivo e desce uma linha. O conteúdo lido é transferido para a variável linha
Memo1.lines.add(linha); // adciona arquivo ao memo
end;
i := StrToInt(Memo1.Lines.Strings[0]) + 1; // variavel i recebe contagem + 1
k := (StrToInt(Memo1.Lines.Strings[1]) - StrToInt(Memo1.Lines.Strings[0]));
Closefile(f);
Rewrite(f); //abre o arquivo para escrita
Writeln(f,inttostr(i)); // escreve a variavel i no arquivo
Writeln(f,Memo1.Lines.Strings[1]); //reescreve
Closefile(f); //fecha o handle de arquivo
if (StrToInt(Memo1.Lines.Strings[0]) > StrToInt(Memo1.Lines.Strings[1])) then // condição
begin
ShowMessage('O programa expirou entre em contato conosco, (085) 3457 7000');
Application.Terminate;
end
else
begin
MessageDlg('Você acessou o programa '+ (Memo1.Lines.Strings[0]) +' vez(es),'+#13+ 'você ainda tem direito a '+ IntToStr(k) +' acesso(s). ', mtInformation, [mbOK], 0);
end;
end
else
begin
Memo1.Clear; // limpa o memo
AssignFile(f,'C:teste_01.ini'); // guarda o arquivo na variavel f
Reset(f); //abre o arquivo para leitura;
while not eof(f) do
begin
Readln(f,linha); //lê do arquivo e desce uma linha. O conteúdo lido é transferido para a variável linha
Memo1.lines.add(linha); // adciona arquivo ao memo
end;
i := StrToInt(Memo1.Lines.Strings[0]) + 1; // variavel i recebe contagem + 1
k := (StrToInt(Memo1.Lines.Strings[1]) - StrToInt(Memo1.Lines.Strings[0]));
Closefile(f);
Rewrite(f); //abre o arquivo para escrita
Writeln(f,inttostr(i)); // escreve a variavel i no arquivo
Writeln(f,Memo1.Lines.Strings[1]); //reescreve
Closefile(f); //fecha o handle de arquivo
if (StrToInt(Memo1.Lines.Strings[0]) > StrToInt(Memo1.Lines.Strings[1])) then // condição
begin
ShowMessage('O programa expirou entre em contato conosco, (xxx) xxxx xxxx');
Application.Terminate;
end
else
begin
MessageDlg('Você acessou o programa '+ (Memo1.Lines.Strings[0]) +' vez(es),'+#13+ 'você ainda tem direito a '+ IntToStr(k) +' acesso(s). ', mtInformation, [mbOK], 0);
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
acessos;
end;
end.
ESPERO QUE GOSTEM É MINHA PRIMEIRA DICA
Atenciosamente : Jucelio Moura
Publicidade
Vote na dica
Quantidade de votos: 0 votos
Aceitação: 0%
Detalhes da dica
Adicionada dia: 21/06/10
Por: Francisco Jucelio Moura Sousa
Visualizada: 7987 vezes
Publicidade
Enquete
O que achou do novo site?
Planeta Delphi - www.planetadelphi.com.br - Todos os direitos reservados | Copyright 2001-2009