Array of record BlockRead/Write

Forum > General

(1/1)

jolix:
Hi,

The working code below, is to have a list of users to login with follows attributes:
- Name, Password, Type, Language, and a Index to the next record.

For now, Index to the next user is not needed.

Until now i have:
1. If file exists program reads the file and fill all users.
2. If not, create a file with a default user.
Later, the default user must be created also, if no one user with administration rights exists in the file.
Of course later data will be scrambled.
Also no error file have been implemented yet. Any idea?

Since this code is as i learned many years ago with turbo pascal, any else suggest a more smart way to do this?

Also i have a doubt.
As i create the default user with 'admin','1234' for which i have reserved a fixed string length, see the file contents below:
0561646D696E00000000000431323334000000000000010000000100000001000000

Can i allocate those strings just with the needed length, but without having to do all the manual work with pointers?

Also, one of the bored things is the work i have ahead to write the code to handle users.
Eventually an object with inherited properties and methods from an existent class ?

Any else to give me ideas about it?

--- Code: ---interface

uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls;

type
TfrmPass = class(TForm)
Memo1: TMemo;
procedure CreateDefaultUser;
procedure LoadRegisteredUsers;
procedure ShowUsers( argc: integer );

private

public
Constructor Create(TheOwner: TComponent); override;
procedure FormKill(Sender: TObject);
end;

type
user = record
UserName : string[10];
UserPass : string[10];
Usertype : integer; // 1: Admin, 2: Normal user
UserLang : integer; // 0: Default, 1..6: European Langs
NextUser : integer; // x: Points to next user record if exists
// If no more, points to it self
end;

const
usersfname = 'users.dat';
var
frmPass : TfrmPass;
fusers : file;
users : array[1..20] of user;
RBlock,
WBlock : integer;

implementation

Constructor TfrmPass.Create(TheOwner: TComponent);
var
x: integer;
s: string;
begin
inherited Create(TheOwner);
OnDestroy := @FormKill;

Memo1.Clear;
if FileExists(usersfname) = True then begin
Memo1.Append('Registered Users:');
LoadRegisteredUsers;
end
else begin
Memo1.Append('Default User Created:');
CreateDefaultUser;
end;

end;

procedure TfrmPass.FormKill(Sender : TObject);
begin
end;

{==============================================================================}
{ CreateDefaultUser: }
{------------------------------------------------------------------------------}
{ File contents: }
{ 0561646D696E00000000000431323334000000000000010000000100000001000000 }
{------------------------------------------------------------------------------}
procedure TfrmPass.CreateDefaultUser;
var
x: integer;
begin
AssignFile(fusers, usersfname);
ReWrite(fusers, 1);
with users[1] do begin
UserName := 'admin';
UserPass := '1234';
UserType := 1;
UserLang := 1;
NextUser := 1;
end;

BlockWrite(fusers, users[1].UserName, Sizeof(users[1].UserName));
BlockWrite(fusers, users[1].UserPass, Sizeof(users[1].UserPass));
BlockWrite(fusers, users[1].UserType, Sizeof(users[1].UserType));
BlockWrite(fusers, users[1].UserLang, Sizeof(users[1].UserLang));
BlockWrite(fusers, users[1].NextUser, Sizeof(users[1].NextUser));

CloseFile(fusers);
Memo1.Append(users[1].UserName);
Memo1.Append(IntToStr(SizeOf(users[1])));
ShowUsers( 1 );;
end;

{==============================================================================}
{ LoadRegisteredUsers: }
{------------------------------------------------------------------------------}
{ }
{------------------------------------------------------------------------------}
procedure TfrmPass.LoadRegisteredUsers;
var
s: string;
x: integer;
begin
AssignFile(fusers, usersfname);
Reset(fusers);
x := 1;
repeat
BlockRead(fusers, users[x].UserName, Sizeof(users[x].UserName), RBlock);
BlockRead(fusers, users[x].UserPass, Sizeof(users[x].UserPass), RBlock);
BlockRead(fusers, users[x].UserType, Sizeof(users[x].UserType), RBlock);
BlockRead(fusers, users[x].UserLang, Sizeof(users[x].UserLang), RBlock);
BlockRead(fusers, users[x].NextUser, Sizeof(users[x].NextUser), RBlock);

ShowUsers(x);
inc(x);
until eof(fusers);
CloseFile(fusers);
end;

{==============================================================================}
{ Show Users: Debug purposes }
{------------------------------------------------------------------------------}
procedure TfrmPass.ShowUsers( argc: integer );
var
s: string;
x: integer;
begin
Memo1.Append(IntToStr(SizeOf(users[argc].UserName))+' '+users[argc].UserName);
Memo1.Append(IntToStr(SizeOf(users[argc].UserPass))+' '+users[argc].UserPass);
Memo1.Append(IntToStr(SizeOf(users[argc].UserType))+' '+IntToStr(users[argc].UserType));
Memo1.Append(IntToStr(SizeOf(users[argc].UserLang))+' '+IntToStr(users[argc].UserLang));
Memo1.Append(IntToStr(SizeOf(users[argc].NextUser))+' '+IntToStr(users[argc].NextUser));
end;

initialization
{$I upass.lrs}

end.

--- End code ---

Thanks,
Jo

theo:
I would probably make a TUser Class. Then a TUsers Class which is holding all TUser in a TList.
For reading and writing, probably TFileStream is easier and you don't need fixed length strings
Example:

--- Code: ---Procedure TForm1.Button1Click(Sender:TObject);
Const FileName = '/home/theo/fstestuser.txt';
Var fs: TFileStream;
  i: integer;
  UserCount, Size: integer;
Begin
  UserCount := 20;
  //Write
  fs := TFileStream.Create(FileName,fmCreate);
  For i:=0 To UserCount-1 Do
   Begin
   fs.WriteAnsiString('User_'+inttostr(i));
   fs.WriteAnsiString('Pass_'+inttostr(i));
   fs.WriteByte(3);
   End;
  fs.Free;

  UserCount := 0;
  //Read
  fs := TFileStream.Create(FileName,fmOpenRead);
  Size := fs.Size;
  Repeat
   Memo1.Lines.Add(fs.ReadAnsiString+' '+fs.ReadAnsiString+' '+inttostr(fs.ReadByte));
   Inc(UserCount);
  Until fs.Position>=Size;
  fs.free;
  Memo1.Lines.Add(Inttostr(UserCount));
End;

--- End code ---

But there are other ways. XML for example.

jolix:
Thanks Theo,

I will search for how to use a class as you suggest.
Thanks for the example, picture is better than a thousand words:)

Regards,
Jo

Navigation

[0] Message Index