Shareware

← →
Mr.Credo © (2004-04-24 10:05) [0]

Как написать прогу на Delphi чтобы она аботала дней 30 (что-то типа shareware). Заранее спасибо.

← →
Locker (2004-04-24 10:32) [1]

Для начала надо купить хороший комп и корректно установить ОС. Тогда, может, 30 дней и проработает.
Потом, в программе нужно корректно выделять и удалять ресурсы, а то никакой памяти не хватит.

P.S. Да! Не забудьте про хороший UPS!

P.P.S. И, прежде чем задавать подобные вопросы, думать самому. По крайней мере, посмотреть, как работают другие подобные программы, или поискать в инете, а не лезть в форум с вопросами, ответы на которые могут потянуть на хороший научный труд.

← →
Vit@ly © (2004-04-24 11:14) [2]

Если расчитывать, на то что здесь можно получить ответ на такой вопрос, то это, естественно, уже не будет шароварами, а будет открытой прогой. Мне кажется необходимо слегка подумать куда "спрятать" период функционирования программы. Скорее всего наиболее предпочтительным местом является реестр. Хотя разумеется имеются и другие варианты.

← →
SergP © (2004-04-24 11:24) [3]

> Скорее всего наиболее предпочтительным местом является реестр.
>

Ну реестр можно и почистить.

Лучше уж использовать все места что придут в голову одновременно.
надежней будет.

← →
SPeller © (2004-04-24 11:32) [4]

> Как написать прогу на Delphi чтобы она аботала дней 30

Руками.

← →
Anatoly Podgoretsky © (2004-04-24 13:13) [5]

Не рук недостаточно, нужен еще редактор, компилятор, отладчик и машина с должной ОС.

← →
SPeller © (2004-04-24 13:14) [6]

Это уже окружение. Можно и на листе бумаги написать.

← →
Rouse_ © (2004-04-24 14:12) [7]

> Mr.Credo © (24.04.04 10:05)
Ты так не переживай, обычно раз в 30 дней люди операционку переустанавливают ;)

← →
Polevi © (2004-04-24 14:15) [8]

> [6] SPeller © (24.04.04 13:14)
надо чтоб работала

← →
ИМХО © (2004-04-24 14:20) [9]

Этих людей называют мазохистами.

← →
Anatoly Podgoretsky © (2004-04-24 14:38) [10]

SPeller © (24.04.04 13:14) [6]
От этого она не будет работать, правда и проблемы с триалом тоже не будет, написал и в ящик стола.

← →
AndreyL (2004-04-24 16:46) [11]

Da otveti konechno u vas nuzhnije!

← →
Soft © (2004-04-24 19:25) [12]

unit registerFormUnit;

interface

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

type
TRegisterForm = class(TForm)
NextButton: TButton;
Label1: TLabel;
UserName: TEdit;
SerialNumber: TEdit;
Label2: TLabel;
Regbutton: TButton;
BuyButton: TButton;
Label3: TLabel;
procedure NextButtonClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure RegbuttonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

type TRegRegistration=record
UserName:string;
Regnumber:string;
RegDate:TdateTime;
end;

var
RegisterForm: TRegisterForm;
var RegRegistration:TRegRegistration;

const
RegRootKey=HKEY_CURRENT_USER;
RegKey="SOFTWARE\GART\CS";

function WordToHex(num:word):string;
function DecToHex(num:byte):string;
function CheckDate(DateReg:TDateTime):boolean;
function CheckUserRegNumber(User,Regnumber:string):boolean;
function GetRegDataFromRegitry:TRegRegistration;
Procedure WriteRegUser(User,Regnumber:string);

implementation

{$R *.dfm}

function WordToHex(num:word):string;
var High,Low:byte;
var HexStr:string;
begin
High:=Byte(num div $100);
Low:=Byte(num-High*$100);
HexStr:="";
HexStr:=HexStr+DecToHex(High);
HexStr:=HexStr+DecToHex(Low);
WordToHex:=HexStr;
end;

function DecToHex(num:byte):string;
var High,Low:byte;
var HexStr:string;
begin
HexStr:="";
High:=num div $10;
Low:=num-High*$10;
//текстовое отображение
case (High) of
0:HexStr:=HexStr+"0";
1:HexStr:=HexStr+"1";
2:HexStr:=HexStr+"2";
3:HexStr:=HexStr+"3";
4:HexStr:=HexStr+"4";
5:HexStr:=HexStr+"5";
6:HexStr:=HexStr+"6";
7:HexStr:=HexStr+"7";
8:HexStr:=HexStr+"8";
9:HexStr:=HexStr+"9";
$0A:HexStr:=HexStr+"A";
$0B:HexStr:=HexStr+"B";
$0C:HexStr:=HexStr+"C";
$0D:HexStr:=HexStr+"D";
$0E:HexStr:=HexStr+"E";
$0F:HexStr:=HexStr+"F";
end;

case (Low) of
0:HexStr:=HexStr+"0";
1:HexStr:=HexStr+"1";
2:HexStr:=HexStr+"2";
3:HexStr:=HexStr+"3";
4:HexStr:=HexStr+"4";
5:HexStr:=HexStr+"5";
6:HexStr:=HexStr+"6";
7:HexStr:=HexStr+"7";
8:HexStr:=HexStr+"8";
9:HexStr:=HexStr+"9";
$0A:HexStr:=HexStr+"A";
$0B:HexStr:=HexStr+"B";
$0C:HexStr:=HexStr+"C";
$0D:HexStr:=HexStr+"D";
$0E:HexStr:=HexStr+"E";
$0F:HexStr:=HexStr+"F";
end;

DecToHex:=HexStr;
end;

function CheckDate(DateReg:TDateTime):boolean;
begin
if (now>DateReg) or ((DateReg-now)>40) then
CheckDate:=false
else CheckDate:=True;
end;

function CheckUserRegNumber(User,Regnumber:string):boolean;
var UsrReg:String;
var i:integer;
begin
UsrReg:="";
CheckUserRegNumber:=True;

//Проверка на длинну
if (Length(User)<8) then CheckUserRegNumber:=false;
//Создание ключа
For i:=1 to Length(User) do
UsrReg:=UsrReg+DecToHex(Byte(User[i]) xor Byte($50*Length(User)));
//проверка ключа
if Length(UsrReg)=Length(Regnumber) then
begin
for i:=1 to Length(UsrReg) do
if UsrReg[i]<>Regnumber[i] then
CheckUserRegNumber:=false;
end;
//
if Length(UsrReg)<>Length(Regnumber) then
CheckUserRegNumber:=false;
end;

Procedure WriteRegUser(User,Regnumber:string);
var Registry:TRegistry;
begin
Registry:=TRegistry.Create;
Registry.RootKey:=RegRootKey;
//открытие основного ключа
Registry.OpenKey(RegKey,True);

Registry.WriteString("UserName",User);
Registry.WriteString("RegNumber",Regnumber);

//очищаем реестр
Registry.Free;
end;

function GetRegDataFromRegitry:TRegRegistration;
var DataReg:TRegRegistration;
var Registry:TRegistry;
begin
Registry:=TRegistry.Create;
Registry.RootKey:=RegRootKey;
//открытие основного ключа
Registry.OpenKey(RegKey,True);

if Registry.ValueExists("RegDate")=false then
Registry.WriteDate("RegDate",now+30);

if Registry.ValueExists("UserName")=true then
DataReg.UserName:=Registry.ReadString("UserName")
else
DataReg.UserName:="";

if Registry.ValueExists("RegNumber")=true then
DataReg.Regnumber:=Registry.ReadString("RegNumber")
else
DataReg.Regnumber:="";

if Registry.ValueExists("RegDate")=true then
DataReg.RegDate:=Registry.ReadDateTime("RegDate")
else
DataReg.RegDate:=now;

//очищаем реестр
Registry.Free;
GetRegDataFromRegitry:=DataReg;
end;

function CreateRegisterForm:boolean;
begin
CreateRegisterForm:=True;
RegRegistration:=GetRegDataFromRegitry;

if (CheckUserRegNumber(RegRegistration.UserName,RegRegistration.Regnumber)=False) then
begin
Application.CreateForm(TRegisterForm, RegisterForm);
RegisterForm.ShowModal;
end;
Application.ProcessMessages;

RegRegistration:=GetRegDataFromRegitry;
if (CheckUserRegNumber(RegRegistration.UserName,RegRegistration.Regnumber)=False) then
if (CheckDate(RegRegistration.RegDate)=False) then
halt;

if (CheckUserRegNumber(RegRegistration.UserName,RegRegistration.Regnumber)=False) then
if (CheckDate(RegRegistration.RegDate)=False) then
CreateRegisterForm:=false;

end;

procedure TRegisterForm.NextButtonClick(Sender: TObject);
begin
Self.Close;
end;

procedure TRegisterForm.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action:=caFree;
end;

procedure TRegisterForm.RegbuttonClick(Sender: TObject);
begin
if (CheckUserRegNumber(UserName.Text,SerialNumber.Text)=true) then
begin
WriteRegUser(UserName.Text,SerialNumber.Text);
Self.Close;
end
else
Application.MessageBox("Неправильный регистрационный номер.","Регистрация");
end;

procedure TRegisterForm.FormCreate(Sender: TObject);
begin
if ((RegRegistration.RegDate-now)>0) then
label3.Caption:="Осталось: "+Format("%d",[Trunc(RegRegistration.RegDate-now)])+" дней"
else
begin
label3.Caption:="Время бесплатного использования вышло";
NextButton.Enabled:=False;
end;
end;

initialization
begin
if (CreateRegisterForm=false) then halt;
RegRegistration:=GetRegDataFromRegitry;
if (CheckUserRegNumber(RegRegistration.UserName,RegRegistration.Regnumber)=False) then
if (CheckDate(RegRegistration.RegDate)=False) then
halt;
end;

end.

Давно писал, так что очень неэффективно реализовано, но работает...

case (High) of 0:HexStr:=HexStr+"0"; 1:HexStr:=HexStr+"1"; 2:HexStr:=HexStr+"2"; 3:HexStr:=HexStr+"3"; 4:HexStr:=HexStr+"4"; 5:HexStr:=HexStr+"5"; 6:HexStr:=HexStr+"6"; 7:HexStr:=HexStr+"7"; 8:HexStr:=HexStr+"8"; 9:HexStr:=HexStr+"9"; $0A:HexStr:=HexStr+"A"; $0B:HexStr:=HexStr+"B"; $0C:HexStr:=HexStr+"C"; $0D:HexStr:=HexStr+"D"; $0E:HexStr:=HexStr+"E"; $0F:HexStr:=HexStr+"F"; end;

М-да....

if high>9 then HexStr:=HexStr+chr(high+55) else HexStr:=HexStr+chr(high+48);

>>SergP © (24.04.04 22:34) [14]

В данном случае скорость особой роли не играет, так что данный костылек вполне рабочий:)

А так для этого есть функция

function IntToHex(Value: Integer; Digits: Integer): string; overload;

Returns the hex representation of an integer.

Техника защиты методом неявного самоконтроля. Заодно подумаешь, как это возможно реализовать на Дельфи.

http://www.wasm.ru/article.php?article=n2k_shld

ИМХО, достаточно ориганальный способ. Покрайней мере, есть на чем задуматься....

Shareware Найти похожие ветки