Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Shimarik / Shimarik / Приложения.doc
Скачиваний:
19
Добавлен:
16.04.2013
Размер:
637 Кб
Скачать

50

Приложения. Приложение 1.

Программа “Эксперт” состоит из пятидесяти четырех модулей. Ниже я приведу листинг основных модулей.

//Модуль экранной заставки

unit pictU;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ExtCtrls;

type

TfmPicture = class(TForm)

Image1: TImage;

Timer1: TTimer;

procedure Timer1Timer(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

fmPicture: TfmPicture;

implementation

uses Expert;

{$R *.DFM}

procedure TfmPicture.Timer1Timer(Sender: TObject);

begin

//Отключение таймера. Заставка исчезает и появляется основная форма

Timer1.Enabled:=false;

fmMain.Show;

end;

end.

//Модуль Запрос пароля

unit pass;

Interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TfmPass = class(TForm)

Label1: TLabel;

ComboBox1: TComboBox;

Label2: TLabel;

Edit1: TEdit;

Button1: TButton;

Button2: TButton;

procedure Button2Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

//процедуры шифрования и расшифрования пароля

function Encrypt(const InString:string; StartKey,MultKey,AddKey:Integer): string;

function Decrypt(const InString:string; StartKey,MultKey,AddKey:Integer): string;

end;

var

fmPass: TfmPass;

Implementation

uses Expert, DatesU, pworkU, directU;

{$R *.DFM}

{$R-}

{$Q-}

{*******************************************************

* Standard Encryption algorithm - Copied from Borland *

*******************************************************}

function TfmPass.Encrypt(const InString:string; StartKey,MultKey,AddKey:Integer): string;

var

I : Byte;

begin

Result := '';

for I := 1 to Length(InString) do

begin

Result := Result + CHAR(Byte(InString[I]) xor (StartKey shr 8));

StartKey := (Byte(Result[I]) + StartKey) * MultKey + AddKey;

end;

end;

{*******************************************************

* Standard Decryption algorithm - Copied from Borland *

*******************************************************}

function TfmPass.Decrypt(const InString:string; StartKey,MultKey,AddKey:Integer): string;

var

I : Byte;

begin

Result := '';

for I := 1 to Length(InString) do

begin

Result := Result + CHAR(Byte(InString[I]) xor (StartKey shr 8));

StartKey := (Byte(InString[I]) + StartKey) * MultKey + AddKey;

end;

end;

{$R+}

{$Q+}

procedure TfmPass.Button2Click(Sender: TObject);

begin

fmMain.NeedPass:=3;

Close;

end;

procedure TfmPass.Button1Click(Sender: TObject);

var i:integer;

begin

i:=0;

if ((ComboBox1.Text='Директор') and (Edit1.Text=Decrypt(fmMain.Param1, 14,13,12))) then

begin

i:=1;

fmMain.NeedPass:=1;

close;

end;

if ((ComboBox1.Text='Сотрудник') and (Edit1.Text=Decrypt(fmMain.Param2, 14,13,12))) then

begin

i:=1;

fmMain.NeedPass:=1;

fmDates.DBEdit2.Enabled:=false;

fmPWork.DBEdit6.Enabled:= false;

fmDirect.RichEdit1.Enabled:= false;

fmDirect.btnAddDate.Enabled:= false;

close;

end;

if i<>1 then ShowMessage('Проверьте правильность введенных данных');

end;

end.

//Модуль главной формы

unit Expert;