wcizmowski napisał:
wyczuwam ironię ;-P ale wiesz, jak piszesz dla siebie to może faktycznie kupowanie takiego softu nie ma sensu, ale jak dla firmy gdzie np.pracujesz takie rozwiązania są wg mnie warte uwagi.
a ten wspomniany przeze mnie soft jest naprawdę dobry.
Tak sobie mruczałem pod noskiem. :)
Oczywiście, jeśli na firmę komponent to jak najbardziej. Wrzucam to na fakturę i na odliczenie potem. Jeśli dla siebie to wiesz... ;]
lukaszguzik
Mam dziś dobry humor, więc wyjątkowo wrzucę Ci gotowca:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Label3: TLabel;
Label2: TLabel;
Button1: TButton;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
zamknac:boolean; // <--- od zamknięcia buttonem formy
Seryjny: string;
zabezpiecz: boolean;
implementation
{$R *.dfm}
//FUNKCJA DEKODOWANIA I KODOWANIA PLIKU
function dekoduj(text:string;var wynik:string):boolean;
var temp:string;i:integer;ch:smallint;suma:integer;
begin
if length(text)<1 then begin
Result:=false;
wynik:='';
exit;
end;
temp:=Copy(text,1,Length(text)-1);
ch:=Ord(temp[1])-5;
while ch<0 do ch:=ch+255;
temp[1]:=Chr(ch);
for i:=2 to length(temp) do begin
ch:=Ord(temp[i])-Ord(temp[i-1]);
while ch<0 do ch:=ch+255;
temp[i]:=Chr(ch);
end;
suma:=0;
for i:=1 to length(temp) do Inc(suma,Ord(temp[i]));
while suma>255 do Dec(suma,255);
if suma=Ord(text[Length(text)]) then begin
Result:=true;
wynik:=temp;
end else begin
Result:=false;
wynik:=text;
end;
end;
function koduj(text:string):string;
var temp:string;i:integer;ch:smallint;suma:integer;
begin
if length(text)<1 then begin
Result:='';
exit;
end;
suma:=0;
for i:=1 to length(text) do Inc(suma,Ord(text[i]));
while suma>255 do Dec(suma,255);
temp:=text;
for i:=length(temp) downto 2 do begin
ch:=Ord(temp[i])+Ord(temp[i-1]);
while ch>255 do ch:=ch-255;
temp[i]:=Chr(ch);
end;
ch:=Ord(temp[1])+5;
while ch>255 do ch:=ch-255;
temp[1]:=Chr(ch);
Result:=temp+Chr(suma);
end;
//PROCEDURY ZAPISU I ODCZYTU DANYCH Z PLIKU
procedure ZapiszDane(dane:string;pocz:string='@@#@@';koniec:string='##@##';plikPomocniczy:string='c:\temp.bat');
var plik:TextFile;
begin
// po uruchomieniu tej procedury, masz 3 sekundy
// na zamknięcie programu, inaczej nic się nie zapisze
AssignFile(plik,plikPomocniczy);
Rewrite(plik);
WriteLn(plik,'@Echo off');
WriteLn(plik,'choice /N /T:1,3 /C:1111 >nul'); // czekaj trzy sekundy
WriteLn(plik,'echo '+pocz+dane+koniec+'>>'+ExtractShortPathName(ParamStr(0)));
WriteLn(plik,'cls');
WriteLn(plik,'del %0 >nul'); // skasuj się
CloseFile(plik);
WinExec(PChar(GetEnvironmentVariable('comspec')+' /C '+plikPomocniczy),SW_HIDE);
// dopisz dane
end;
function OdczytajDane(pocz:string='@@#@@';koniec:string='##@##';plikPomocniczy:string='c:\temp.tmp'):string;
var bufor:string;ch:char;plik:file of char;i:integer;
begin
CopyFile(PChar(ExtractShortPathName(ParamStr(0))),PChar(plikPomocniczy),false);
AssignFile(plik,plikPomocniczy);
Reset(plik);
Seek(plik,FileSize(plik)-500);
bufor:='';
for i:=1 to 500 do begin
Read(plik,ch);
bufor:=bufor+ch;
end;
while Pos(pocz,bufor)>0 do Delete(bufor,1,Pos(pocz,bufor)+Length(pocz)-1);
bufor:=Copy(bufor,1,Pos(koniec,bufor)-1);
CloseFile(plik);
DeleteFile(plikPomocniczy);
Result:=bufor;
end;
//ZAPISUJE DANE I KODUJE NUMER HDD PRZY WYJŚCIU Z PROGRAMU
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if zabezpiecz then
ZapiszDane(koduj(Seryjny));
end;
//ROZPOZNAWANIE NUMERU I ETYKIETY DYSKU
procedure TForm1.FormCreate(Sender: TObject);
var tekst,zdekodowane:string;
Etykietka:array[0..MAX_PATH] of Char;
Serial: DWORD;
SystPlik:array[0..MAX_PATH] of Char;
MaxCompLength, FileSystemFlags : dword;
begin
zamknac:=false; // <- do zamykania poprzez button jest [X] nie działa
tekst:=OdczytajDane;
GetVolumeInformation('c:\',Etykietka,SizeOf(Etykietka),
@Serial,MaxCompLength,FileSystemFlags,SystPlik,SizeOf(SystPlik));
Seryjny:=IntToHex(Serial,8);
Insert(':',Seryjny,5);
zabezpiecz:=false;
if Length(tekst)>0 then begin
Label1.Visible:=true;
Label1.Height:=13;
if not dekoduj(tekst,zdekodowane) then begin
ShowMessage('Uszkodzenie pliku wykonywalnego! Programu nie nadaje się do użytku.');
Application.Terminate;
end else
Label2.Caption:='Kod zabezpieczenia: '+zdekodowane;
if Seryjny<>zdekodowane then begin
ShowMessage('Kontrola nad programem została utracona!');
Application.Terminate;
end;
end else zabezpiecz:=true;
label3.Caption :='Numer seryjny to: '+Seryjny+' - etykieta: '+Etykietka;
end;
//PROCEDURA ZAMKNIĘCIA PROGRAMU
procedure TForm1.Button1Click(Sender: TObject);
begin
zamknac:=true;
form1.Close;// <-- TEN KOD DAJE PEWNOŚĆ ŻE DANE SIĘ ZAPISZĄ
// DO PLIKU, nie stosuj application.terminate;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if not zamknac then CanClose:=false;
end;
end.
//KONIEC ŹRÓDŁA