tæller hvor mange gange

jeg er bekendt med det her fra swiss
det er lidt bøvlet da execute time er en konstant og ikke en variabel som træder ikraft når programmet bliver installeret.

http://www.swissdelphicenter.ch/en/showcode.php?id=297

der er en del måder at gøre det på, fx lave en fil som ligger et skjult sted. eller en key i registry som du bruger. Men det er ret nemt at finde begge ting. Du kan også lave så dit program retter i sin egen exe fil, det er lidt svære.

Men hvis nogen ønsker dit program cracket skal de self nok få det. Men ellers syntes jeg bare du skal skrive til registry, det vil de *fleste* jo ikke gå ind at lave om på.

Jeg har noget kode der kan gøre det med dato, så folk kun kan åbne den til og med en hvis dato.
Men ellers ville den bedste nok være at skrive til en placering i databasen, hvor den så checker om den har været kørt mere en et hvis antal gange.

ja det at skrive til databasen er nok bedst, da man så er uafhængig af hvornår programmet er installeret.

har du et eksempel der skriver/læser til registry?

jep 2 sek

går lige lidt længere tid, har en hulens bunke kode jeg skal have kigget igennem, jeg VED jeg har den, for jeg har selv lavet et program der brugte registreringsdatabasen

ok...giv dig tid så meget haster det ikke

denne har jeg lavet til dig (husk at tilføje Registry i uses):

procedure SetRegistryData(RootKey: HKEY; Key, Value: string;
  RegDataType: TRegDataType; Data: variant);
var
  Reg: TRegistry;
  s: string;
begin
  Reg := TRegistry.Create(KEY_WRITE);
  try
    Reg.RootKey := RootKey;
    if Reg.OpenKey(Key, True) then begin
      try
        if RegDataType = rdUnknown then
          RegDataType := Reg.GetDataType(Value);
        if RegDataType = rdString then
          Reg.WriteString(Value, Data)
        else if RegDataType = rdExpandString then
          Reg.WriteExpandString(Value, Data)
        else if RegDataType = rdInteger then
          Reg.WriteInteger(Value, Data)
        else if RegDataType = rdBinary then begin
          s := Data;
          Reg.WriteBinaryData(Value, PChar(s)^, Length(s));
        end else
          raise Exception.Create(SysErrorMessage(ERROR_CANTWRITE));
      except
        Reg.CloseKey;
        raise;
      end;
      Reg.CloseKey;
    end else
      raise Exception.Create(SysErrorMessage(GetLastError));
  finally
    Reg.Free;
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
var
a : string;
b : integer;
begin
  with TRegistry.Create do
  begin
    RootKey:=HKEY_LOCAL_MACHINE;
    if OpenKey('SOFTWARE\tester', False) then
    try
    a := ReadString('times');
    if a = '' then a := '0' else
    b := StrToInt(a);
    b := b+1;
    except
    MessageDlg('Can not go to handle', mtError, [mbOk], 0);
    end;
    CloseKey;
  end;
  if a >= '5' then begin
  Showmessage('Programmet er kørt mere end 5 gange, og lukker');
  Application.Terminate;
  end
  else begin

    SetRegistryData(HKEY_LOCAL_MACHINE,
    'Software\tester','times', rdString, b);
  end;
end;


Så der hvor der står if a>='5' der kan du selv skrive f.eks. 500.
og du kan også selv rette hvor i registreringsdatabasen den skal skrive.

det ser godt ud...

men er det muligt at sætte a = progressbar?
mod lidt flere point
step= 1
max = 500 f.eks

får en warning:

variabel 'b' might not have been initialized

prøver lige med en progressbar

det med at b ikke er blevet initialized ved jeg ikke helt hvad er.

det er fordi den kun bliver assignet inde i try-blokken - sæt den til 0 før try - og så forsvinder din warning

hmm det virker ikke
når jeg sætter a til 100 stopper programmet efter 3 forsøg, og i registry står der 2 under "times"

du sætter bare denne linie ind

  ProgressBar1.Position := StrToInt(a);

EFTER dette her (altså efter end;)

    except
    MessageDlg('Can not go to handle', mtError, [mbOk], 0);
    end;
    CloseKey;
  end;

så skal du bare tilføje en TProgressBar på din form og så sætte MAX til 500 eller hvad den nu skal være. Så burde det være i orden.

elbarto...

det kan jeg ikke lige se hvor

prøv det her - jeg har ikke testet det

procedure TForm1.FormCreate(Sender: TObject);
var
  a : integer;
begin
  with TRegistry.Create do
  begin
    RootKey:=HKEY_LOCAL_MACHINE;
    if OpenKey('SOFTWARE\tester', False) then
    begin
      a := 0;
      try
        a := ReadInteger('times');
      except
        MessageDlg('Can not go to handle', mtError, [mbOk], 0);
      end;
      CloseKey;
    end;
  end;
  if a >= 5 then
  begin
    Showmessage('Programmet er kørt mere end 5 gange, og lukker');
    Application.Terminate;
  end
  else begin
    SetRegistryData(HKEY_LOCAL_MACHINE,
    'Software\tester','times', rdString, a+1);
  end;
end;

hov - det virker selvfølgelig ikke - prøv det her

procedure TForm1.FormCreate(Sender: TObject);
var
  a : string;
  b : integer;
begin
  with TRegistry.Create do
  begin
    RootKey:=HKEY_LOCAL_MACHINE;
    if OpenKey('SOFTWARE\tester', False) then
    begin
      b := 0;
      try
        a := ReadString('times');
      except
        MessageDlg('Can not go to handle', mtError, [mbOk], 0);
      end;
      CloseKey;
      b := StrToInt(a);
    end;
  end;
  if b >= 5 then
  begin
    Showmessage('Programmet er kørt mere end 5 gange, og lukker');
    Application.Terminate;
  end
  else begin
    SetRegistryData(HKEY_LOCAL_MACHINE,
    'Software\tester','times', rdString, IntToStr(b+1));
  end;
end;

det er spøjst det med 100, det gør den også her. kigger lige på det.

Det er fordi i sammenligner strenge '2' er større end '100'!!!

erstat

if a >= '100' then begin

med

if StrToInt(a) >= 100 then begin

det er fordi a er en string, og så kan den ikke finde ud af om tallet er større.

elbarto...

nu tæller den ikke i registry
times står 0 selv efter flere kørsler

det var lige en bummert fejl jeg ikke lige havde opdaget.

how... stefmeier:

jeg får en econvert error på
if StrToInt(a) >= 100

har du husket at skrive

var
a : string; //-> altså så der ikke stå a : integer;

?

ja det har jeg styr på *SS*

mystisk for på min der virker det.

her er HELE min kode:

//----------------------------------

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Registry, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    ProgressBar1: TProgressBar;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure SetRegistryData(RootKey: HKEY; Key, Value: string;
  RegDataType: TRegDataType; Data: variant);
var
  Reg: TRegistry;
  s: string;
begin
  Reg := TRegistry.Create(KEY_WRITE);
  try
    Reg.RootKey := RootKey;
    if Reg.OpenKey(Key, True) then begin
      try
        if RegDataType = rdUnknown then
          RegDataType := Reg.GetDataType(Value);
        if RegDataType = rdString then
          Reg.WriteString(Value, Data)
        else if RegDataType = rdExpandString then
          Reg.WriteExpandString(Value, Data)
        else if RegDataType = rdInteger then
          Reg.WriteInteger(Value, Data)
        else if RegDataType = rdBinary then begin
          s := Data;
          Reg.WriteBinaryData(Value, PChar(s)^, Length(s));
        end else
          raise Exception.Create(SysErrorMessage(ERROR_CANTWRITE));
      except
        Reg.CloseKey;
        raise;
      end;
      Reg.CloseKey;
    end else
      raise Exception.Create(SysErrorMessage(GetLastError));
  finally
    Reg.Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
a : string;
b : integer;
begin
  with TRegistry.Create do
  begin
    RootKey:=HKEY_LOCAL_MACHINE;
    if OpenKey('SOFTWARE\tester', False) then
    try
    a := ReadString('times');
    if a = '' then a := '0' else
    b := StrToInt(a);
    b := b+1;
    except
    MessageDlg('Can not go to handle', mtError, [mbOk], 0);
    end;
    CloseKey;
  end;
  ProgressBar1.Position := StrToInt(a);
  if StrToInt(a) >= 100 then begin
  Showmessage('Programmet er kørt mere end 5 gange, og lukker');
  Application.Terminate;
  end
  else begin

    SetRegistryData(HKEY_LOCAL_MACHINE,
    'Software\tester','times', rdString, b);
  end;
end;

end.

//-------------------------------------------------

Det virker fint på min nu.

har lige prøvet det i et tomt project og jeg får stadig fejl

EConvertError with message " is not a valid integer value"

prøv at gå ind i regedit og slet 'times' og så kør programmet igen

ellers prøv at paste din kode ind så kigger jeg lige på den.

koden er den samme som den foroven jeg lavede et copy/paste

times har jeg også slettet.

okay det er rigtig spøjst.

Jeg prøvede nemlig at sætte den ind i et nyt dokument og der virkede den.

Prøv at gå helt tilbage til starten hvor det virkede -> inden progressbar'en kom med.

jo det har jeg også prøvet, her er ingen fejl med econvert,

når jeg sætter a til 100 stopper programmet efter 3 forsøg, og i registry står der 2 under "times"
nogle gange kom den op til 5 og i 6 forsøg stoppede programmet som det skulle.

efterfølgende forsøg stopper programmet efter 3 forsøg.

okay nu er du helt tilbage til starten uden progressbar osv.

så skriver du

if StrToInt(a) >= 100 then begin

istedet for

if a >= '100' then begin

så får jeg jo en econverterror når jeg skriver

if StrToInt(a) >= 100

for lige at få styr på alle de indlæg så har jeg brugt dit første eksempel med den ændring som du skriver 20:29:24 hvor jeg så får en EConvertError "is not a valid integer"

spøjst...

hvordan ser din 'times' ud inde i regedit?

fo hvis jeg retter min værdi til f.eks. et bogstav så skriver den EConvertError "'d' is not a valid integer"

prøv evt. at slette hele 'times' i regedit så den slet ikke er der, og så køre programmet.

eller prøv at lave en ny sti sådan at den bliver gemt et andet sted i regedit.

tror at problemet er her
b := StrToInt(a);
    b := b+1;

b skal jo tælle hvormange programmet startes med +1 , hvis man indsætter et vilkårligt tal bliver det tal lagt i "times" og når b ikke bliver initilized 
vil b ikke virke...

blot en tanke

forstår simpelhen ikke hvorfor det ikke virker

har prøvet at slette times et utal gange og kørt programmet -- har prøvet at skifte sti hjælper heller ikke noget, hvis jeg bruger "if StrToInt(a) >= 100" når den ikke at skrive til registry for fejlmeldingen EConvertError

oven over

b := StrToInt(a);
b := b+1;

har du så denne linie?:

if a = '' then a := '0' else

for jeg prøvede lige at slette den linie, og så fik jeg den fejlmeddelelse som du har, den med EConvertError "not a valid integer value".

ellers prøv at downloade mit program:

http://emul0c.users.whitehat.dk/program.zip

ok nu fes den ind fejlen er at du har lavet det i d7 og jeg bruger d5

i proceduren bruger du (Data: variant) og uses 'Variants' den eksisterer ikke i d5

variants er en const som jeg prøver at gøre variabel... vil jeg tro

det kan det muligvis være, men jeg ved ik.

det er bare mystisk, for det virker jo normalt, så burde det ikke ændre sig af at du skriver StrToInt(a) istedet for det andet.

du har Dansk XP ik? for det kan være det der er galt, jeg prøvede nemlig lige mit program oppe på min skole (hvor de har dansk XP), og der skrev den det med "" is not a valid integer value.

yep jeg har xp pro

ups dk *GG*

du har en linie hvor der står:

if a = '' then a := '0' else

prøv at slette "else" så der bare står

if a = '' then a := '0';

Jeg har testet og det virker for mig hvis jeg ændre denne linie:

if OpenKey('SOFTWARE\tester', False) then

til:

if OpenKey('SOFTWARE\tester', True) then

yep det virker nu
takker for det

det var så lidt.

:D

Skulle det være en anden gang ;)