home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World Komputer 1998 April A
/
Pcwk4a98.iso
/
PROGRAM
/
DELPHI16
/
Ypasswrd
/
YRPASSWD.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-11-28
|
12KB
|
263 lines
unit YRPasswd;
{------------------------------------------------------------------------------}
{ Copyright : ⌐ Copyright 1995 by Y. Rochat }
{ Creation Date : 25/10/1995 }
{ Last Update : 28/11/1995 }
{ Version Number : 1.60 }
{ Programation Language : DELPHI 1.01 }
{------------------------------------------------------------------------------}
{ PASSWORD.DLL V. 1.60 : A Windows DLL that let you manage user's name and }
{ password in order to protect your programs. This }
{ DLL, which is FREEWARE ( ⌐ Copyright 1995 by Yves }
{ Rochat ), implements one function : }
{ }
{ MotDePasse(var UserN : String ; var PriorityL : Integer ; }
{ IniFileName,SectionName : String) : WordBool ; }
{ }
{ IniFileName : The name of the .INI file which keeps the list of users names }
{ and their associated encrypted passwords. If you don't add a }
{ path to this name, we suppose that it is in the same directory}
{ as the file PASSWORD.DLL }
{ SectionName : The name (without brakets) of the section in IniFileName which}
{ contains the information about users and passwords }
{ }
{ If you succeed to login in the program, UserN and PriorityL will contain }
{ respectively the name of the user who logs in and it's associated priority }
{ level. Priority is a number which can varies between 1 (lowest priority) to }
{ 9 (highest priority). }
{ }
{ Author : Yves ROCHAT }
{ Email : rochat@dma.epfl.ch }
{ Address : Ch. de la ClergΦre 36 }
{ CH-1009 PULLY (Vaud) }
{ SWITZERLAND }
{------------------------------------------------------------------------------}
{ TYRPasswd Version 1.6 : A Freeware component that let you use PASSWORD.DLL }
{ You MUST install it in your component palette before}
{ using it. It will be on the palette named 'YRPasswd'}
{ }
{ HOW TO USE IT : 1) Put a TYRPasswd (by ex. MyPswd) in you Delphi form }
{ 2) Do the following in the procedure FormCreate : }
{ }
{ procedure TForm1.FormCreate(Sender: TObject); }
{ begin }
{ If not Mypswd.GetPassword then }
{ Begin }
{ If not Mypswd.ExistDll }
{ then MessageDlg('File PASSWORD.DLL is missing' + #13#10 + #13#10 + }
{ 'You are not authorized to use this program !', }
{ mtInformation,[mbOk], 0) }
{ else MessageDlg('BAD PASSWORD....', mtInformation,[mbOk], 0); }
{ Application.Terminate ; }
{ End else }
{ MessageDlg('GOOD PASSWORD....', mtInformation,[mbOk], 0); }
{ end; }
{ }
{ procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); }
{ begin }
{ if MessageDlg('Close application ?', mtConfirmation, }
{ [mbYes, mbNo], 0) = mrYes then }
{ begin }
{ Action := caFree ; }
{ Mypswd.FreeDllPassword ; <---- TO FREE MEMORY ALLOCATED FOR PASSWORD.DLL }
{ end }
{ else }
{ Action := caNone; }
{ end; }
{ }
{ Properties of the component }
{ --------------------------- }
{ }
{ ExistDll : True if PASSWORD.DLL exists, false otherwise }
{ LoadedDll : True if PASSWORD.DLL is loaded, false otherwise }
{ OkLogin : Set it to True to test the Login Dialog at design time }
{ Set it to False to unload PASSWORD.DLL from memory }
{ ALWAYS SET IT TO FALSE BEFORE CLOSING A PROJECT WHICH }
{ CONTAINS A TYRPASSWD COMPONENT }
{ UserName : Name of the user who logs in }
{ UserLevel : Priority level of the user who logs in }
{ IniName : Name of the .INI file which contains users information }
{ SectionName : Name of the Section in the file IniName }
{ }
{------------------------------------------------------------------------------}
{ IMPORTANT }
{ }
{ You can use this code as is and you are FREE to copy/distribute it provided }
{ that this notice is not modified and included in the distrubution pack. }
{ I'll be more than happy to hear from you for your comments about a real-life }
{ use of this code. Please send your comments to " rochat@dma.epfl.ch " with }
{ subject field starting with the words 'TYRPASSWD'. }
{------------------------------------------------------------------------------}
{:DISCLAIMER: }
{------------ }
{ THIS SOURCE CODE IS DELIVERED AS IS. THERE IS NO REASON TO THINK THAT IT }
{ SHOULD NOT WORK AS CLAIMED. BUT JUST IN CASE, LET ME DISCLAIM THAT YVES }
{ ROCHAT CAN NOT BE HELD LIABLE IF YOU LOOSE TIME OR MONEY USING THIS CODE. }
{------------------------------------------------------------------------------}
interface
uses
WinTypes, Messages, Classes, Graphics, Controls, Forms{, SysUtils} ;
const
DLLNAME = 'PASSWORD.DLL' ;
var
Login: function(var UserN : String ; var PriorityL : Integer ;
IniFileName,SectionName : String) : WordBool ;
type
TYRPasswd = class(TComponent)
private
{ Private field declarations }
FExistDll : Boolean ;
FLoadedDll : Boolean ;
FOkLogin : Boolean ;
FUserName : String ;
FUserLevel : Integer ;
FIniName : String ;
FSectionName : String ;
FHandleDll : Word ;
function SetExistDll(AValue : Boolean) : Boolean ;
function SetLoadedDll(AValue : Boolean) : Boolean ;
function SetOkLogin(AValue : Boolean) : Boolean ;
function SetUserName(AStr : String) : String ;
function SetUserLevel(AInt : Integer) : Integer ;
protected
{ Protected method declarations }
public
{ Public interface declarations }
constructor Create(AOwner: TComponent); override;
function GetPassword : Boolean;
procedure FreeDllPassword ;
published
{ Published design declarations }
property ExistDll : Boolean read FExistDll write SetExistDll default False ;
property LoadedDll : Boolean read FLoadedDll write SetLoadedDll default False ;
property OkLogin : Boolean read FOkLogin write SetOkLogin default False ;
property UserName : String read FUserName write SetUserName ;
property UserLevel : Integer read FUserLevel write SetUserLevel ;
property IniName : String read FIniName write FIniName ;
property SectionName : String read FSectionName write FSectionName ;
end;
procedure Register;
implementation
{$IFDEF WINDOWS}
uses
WinProcs, Dialogs, SysUtils ;
const
SEM_NoOpenFileErrorBox = $8000;
{$ELSE}
uses
WinAPI, Dialogs, SysUtils ;
{$ENDIF}
procedure Register;
begin
RegisterComponents('YRPasswd', [TYRPasswd]);
end {Register} ;
constructor TYRPasswd.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FExistDll := False ;
FLoadedDll := False ;
FOkLogin := False ;
FUserName := 'Unknown' ;
FUserLevel := 0 ;
FIniName := 'password.ini' ;
FSectionName := 'Users' ;
FHandleDll := 0 ;
SetExistDll(True) ;
end {Create} ;
procedure TYRPasswd.FreeDllPassword ;
begin
If FHandleDLL >= 32 { Password loaded } then
Begin
FreeLibrary(FHandleDLL) ;
FHandleDll := 0 ;
FLoadedDll := False ;
FUserName := 'Unknown' ;
FUserLevel := 0 ;
End ;
end ;
function TYRPasswd.SetExistDll(AValue : Boolean) : Boolean ;
begin
FExistDll := FileExists(DLLNAME) ;
end ;
function TYRPasswd.SetLoadedDll(AValue : Boolean) : Boolean ;
begin
{ Nothing to do }
end ;
function TYRPasswd.SetOkLogin(AValue : Boolean) : Boolean ;
begin
If AValue
then GetPassword
else Begin
FreeDllPassword ;
FOkLogin := False ;
End ;
end ;
function TYRPasswd.SetUserName(AStr : String) : String ;
begin
{ Nothing to do }
end ;
function TYRPasswd.SetUserLevel(AInt : Integer) : Integer ;
begin
{ Nothing to do }
end ;
function TYRPasswd.GetPassword : Boolean;
begin
Result := False ;
FOkLogin := False ;
If FHandleDll = 0 then
Begin
{$IFDEF WINDOWS}
SetErrorMode(SEM_NoOpenFileErrorBox);
{$ENDIF}
FHandleDll := LoadLibrary(DLLNAME);
Case FHandleDll of
2 : Begin
MessageDlg('File ' + DLLNAME + ' was not found', mtInformation,[mbOk], 0);
FHandleDll := 0 ;
End ;
3 : Begin
MessageDlg('Path to ' + DLLNAME + ' was not found', mtInformation,[mbOk], 0);
FHandleDll := 0 ;
End ;
8 : Begin
MessageDlg('Insufficient memory to start the application !', mtInformation,[mbOk], 0);
FHandleDll := 0 ;
End ;
else
If FHandleDll >= 32 then { Succes }
Begin
FLoadedDll := True;
@Login := GetProcAddress(FHandleDll,'MOTDEPASSE');
End else
Begin
MessageDlg(' Error when loading ' + DLLNAME + ' !', mtInformation,[mbOk], 0);
FHandleDll := 0 ;
End ;
End ;
SetExistDll(True) ;
End ;
If FLoadedDll and Login(FUserName,FUserLevel,FIniName,FSectionName) then
Begin
Result := True ;
FOkLogin := True ;
End ;
end {GetPassword} ;
end.