Red Bean Tutorial

untuk Studi NetBean bahasa MERCURY : HG --
http://hgbook.red-bean.com/hgbookch5.html

Netware Novell List

unit main;

interface
//NDS modules
{uses
Windows, Messages, SysUtils, Graphics, Controls, Forms, Dialogs,
Outline, StdCtrls, nwlist, nwbase, nwlib, nwnds, Registry,
Menus, ExtCtrls, Classes, ComCtrls, Buttons; }

uses
Windows, Messages, SysUtils, Graphics, Controls, Forms, Dialogs,
StdCtrls, nwlist, nwbase, nwlib, Registry, FileCtrl,
Menus, ExtCtrls, Classes, ComCtrls, Buttons, nwnds, ShellAPI, SRGrad;

type
TForm1 = class(TForm)
NWBase1: TNWBase;
LBoxUserNames: TListBox;
StatusBar1: TStatusBar;
LblTitle: TLabel;
LBoxFullNames: TListBox;
LBoxUniqueUsers: TListBox;
ChBoxFilter: TCheckBox;
LblDate: TLabel;
Bevel1: TBevel;
NWUser: TNWListBox;
LBoxLoggedIn: TListBox;
PMenuUsers: TPopupMenu;
ItemSendMessage: TMenuItem;
ItemCancel: TMenuItem;
ItemPhone: TMenuItem;
BButtSendMessage: TBitBtn;
BButtUpdate: TBitBtn;
BitBtn1: TBitBtn;
MemoJunk: TMemo;
ChBoxAutoUpdate: TCheckBox;
TimerUpdate: TTimer;
BButtExit: TBitBtn;
BButtSearch: TBitBtn;
SRGradient1: TSRGradient;
LBoxFriendsHere: TListBox;
PmenuFriends: TPopupMenu;
AddRemove1: TMenuItem;
LblFriends: TLabel;
ImgSend: TImage;
procedure Startup(Sender: TObject);
procedure ReadJunkFile(Sender: TObject);
procedure ButtExitClick(Sender: TObject);
procedure ButtSendMessageClick(Sender: TObject);
procedure ChBoxFilterClick(Sender: TObject);
procedure CheckRegistry(Sender: TObject);
procedure ReadFromReg(Sender: TObject);
procedure SaveToReg(Sender: TObject);
procedure ButtFriendClick(Sender: TObject);
procedure CheckLoggedIn(Sender: TObject);
procedure ItemCancelClick(Sender: TObject);
procedure MenuFriendMessageClick(Sender: TObject);
procedure ItemPhoneClick(Sender: TObject);
procedure BButtSendMessageClick(Sender: TObject);
procedure BButtUpdateClick(Sender: TObject);
procedure KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure TimerUpdateTimer(Sender: TObject);
procedure ChBoxAutoUpdateClick(Sender: TObject);
procedure BButtExitClick(Sender: TObject);
procedure BButtSearchClick(Sender: TObject);
procedure CheckParams(Sender: TObject);
procedure WriteHTML(Sender: TObject);
procedure AddRemove1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Filter: Boolean; {True if printers are filtered out.}
DefServer: string; //Default file server
JunkFile: string; {Name of file holding items to be cleared from userlist}
Notify: Boolean; {True if program is to watch for Friends logging in.}
RegKeyExist: Boolean; {True of Registry Keys exist}
DKey:AnsiString;
FilePathStr: string;
Friend: array[1..7] of string;
JunkData: array[1..120] of string; //Junk User objects e.g printers erroneously picked up
HTML : Boolean; //True if HTML file is to be written
HTMLFile: String; //Name of HTML file to write
function SurName(InputString: String): PChar; //returns text after last comma
function PhoneExt(InputString: String): PChar; //returns text after last 'x' (phone ext)


implementation

uses SendMessage, friends, notify_unit,prefs,userSearch, splash;

{$R *.DFM}

{-----------------------------------------------}
procedure TForm1.Startup(Sender: TObject);
var
j: integer;
begin
HTML := False; //Initialise Boolean variable
// Identify the default Novell server.
DefServer := NWBase1.DefaultServer;

StatusBar1.SimpleText := 'Resolving usernames to full names ...';
StatusBar1.Update;
if SplashV.Visible then SplashV.LblLoading.Caption := 'Starting up ...';
if SplashV.Visible then SplashV.LblLoading.Update;

// // NWBase1.DefaultServer := 'DefServer';
// // NWBase1.NDSContextName := 'SOM.STAFF.HW';
// // NWBase1.ServerName := 'DefServer';
StatusBar1.SimpleText := ' ';
//Form1.Caption := Form1.Caption + ' - '+ ndsGetContextName;
//Form1.Update;

FilePathStr := ExtractFilePath(application.exename); {W95 ends with '\', NT4 does not}
{Check if last character is a '\' and remove if it is}
if copy(FilePathStr, length(FilePathStr),1) = '\' then
FilePathStr := copy(FilePathStr, 1, length(FilePathStr)-1);

CastOn(0); //Receive broadcast messages
Filter := False; //Initialise to say no filtering. Registry stores true value.
Notify := False; //Initialise to false, get real value from Registry.
for j:= 1 to 7 do Friend[j] := ''; //Initialise to no friends.
CheckRegistry(Sender); //Check keys are present else create
ReadFromReg(Sender); //
if SplashV.Visible then SplashV.LblLoading.Caption := 'Reading junk filter ...';
if SplashV.Visible then SplashV.LblLoading.Update;
ReadJunkFile(Sender); //Names of junk user objects e.g printers
if SplashV.Visible then SplashV.LblLoading.Caption := 'Resolving usernames ...';
if SplashV.Visible then SplashV.LblLoading.Update;
BButtUpdateClick(Sender);
if SplashV.Visible then SplashV.LblLoading.Caption := 'Displaying active users ...';
if SplashV.Visible then SplashV.LblLoading.Update;

ChBoxAutoUpdateClick(Sender); //Checks if auto-update is enabled
CheckParams(Sender); //Read command-line parameters, sets global booealn HTML variable

{Close splash screen}
if SplashV.Visible then SplashV.hide;
(* Free any resources that it used*)
if SplashV.Visible then SplashV.free;

end;
{------------------------------------------------}
procedure TForm1.CheckRegistry(Sender: TObject);
{Creates Registry keys if not present}
Var
Reg: TRegistry;

begin
try
Reg:=TRegistry.Create;
Reg.RootKey:=HKey_Current_User; // Section to look for within the registry
DKey := '\Software\DuncanSoft\userlist'; //Sets the root for the registry.

RegKeyExist := False; //Assign global variable saying no Registry key
if Reg.OpenKey(DKey,False) then //Check if key exists
begin
RegKeyExist := True;
Reg.CloseKey;
end;

if not Reg.OpenKey(DKey,True) then //Create Key
begin //Error handling
StatusBar1.SimpleText := 'Error creating Registry Key.';
exit;
end
finally
Reg.Free;
end;

end;

{------------------------------------------------}
procedure TForm1.ReadFromReg(Sender: TObject);
{Reads settings from Registry}
Var
Reg: TRegistry;
j: integer;

begin
StatusBar1.SimpleText := 'Reading preferences from Registry ...';
try
Reg:=TRegistry.Create;
Reg.RootKey:=HKey_Current_User;

if not Reg.OpenKey(DKEY,False) then //DKEY is '\Software\DuncanSoft\DuncBackup'
ShowMessage('Error in Opening Registry Key' +DKEY)
else
begin
if Reg.ReadString('filter_checked') = '1' then ChBoxFilter.Checked := True
else ChBoxFilter.Checked := False;
{However, on first run no such key will exist yet we wish to have the filter ON
by default, so perform an additional test:}
if not Reg.ValueExists('filter_checked') then ChBoxFilter.Checked := True;

if Reg.ReadString('update_checked') = '1' then ChBoxAutoUpdate.Checked := True
else ChBoxAutoUpdate.Checked := False;

FrmFriends.LBoxFriends.Clear; {Form called on Startup event, don't re-add same friends}
for j := 1 to 7 do
begin
Friend[j] := Reg.ReadString('Friend'+IntToStr(j)) ;
if length(Friend[j]) >0 then FrmFriends.LBoxFriends.Items.Add(Friend[j]); //Populate list of friends
end;
end;
finally
Reg.Free;
end;
end;
{------------------------------------------------}
procedure TForm1.SaveToReg(Sender: TObject);
{Saves Settings to Registry, called on program exit.}
Var
Reg: TRegistry;
j: integer;

begin
StatusBar1.SimpleText := 'Saving preferences to Registry ...';
try
Reg:=TRegistry.Create;
Reg.RootKey:=HKey_Current_User;

if not Reg.OpenKey(DKEY,False) then //DKEY is '\Software\DuncanSoft\Vncadmin'
ShowMessage('Error in Opening Registry Key' +DKEY)
else
begin
if Filter then Reg.WriteString('filter_checked','1') {Yes, filter out printers}
else Reg.WriteString('filter_checked','0'); {No, don't filter printers, etc. }

if ChBoxAutoUpdate.Checked then Reg.WriteString('update_checked','1')
else Reg.WriteString('update_checked','0');

//Save Friends
for j := 1 to 7 do
begin
Reg.WriteString('Friend'+IntToStr(j),Friend[j]) ;
end;
end;
finally
Reg.Free;
StatusBar1.SimpleText := ' ';
end;
end;
{------------------------------------------------}
procedure TForm1.ButtExitClick(Sender: TObject);
begin
//WriteJunkFile(Sender);
SaveToReg(Sender);
LBoxFullNames.Clear;
LBoxFullNames.Free;
NWUser.Clear;
NWUser.Free;
LBoxUniqueUsers.Clear;
LBoxUniqueUsers.Free;
LBoxUserNames.Clear;
LBoxUserNames.Free;
FrmFriends.LBoxFriends.Clear;
FrmFriends.LBoxFriends.Free;
FrmFriends.LBoxFullNames.Clear;
FrmFriends.LBoxFullNames.Free;
FrmFriends.LBoxTemp.Clear;
FrmFriends.LBoxTemp.Free;
MemoJunk.Clear;
MemoJunk.Free;

{Call close functions according to the NWLIB help file:}
//ndsClose;
//ndsFreeContext(ndsGetContextHandle);
Close;
Application.Terminate;
end;

{------------------------------------------------------}
procedure TForm1.ButtSendMessageClick(Sender: TObject);
var
RecipientFullName : string;
RecipientUserName: string;
i: integer;

begin
if LBoxFullNames.ItemIndex = -1 then
begin
ShowMessage('Please select recipient, or double-click on recipient name.');
exit;
end;
{Now, to identify the username assigned to the FullName we must cycle through
all the usernames in LBoxUniqueUsers, looking up the associated FullName and
seeing if it matches that selected}

{Get the fullname of the recipient:}
RecipientFullName := LBoxFullNames.Items[LBoxFullNames.ItemIndex];

FrmMessage.LblRecipient.Caption := '';
FrmMessage.EditMessage.Clear;
FrmMessage.ChBoxSend.Checked := False; // Flag that nothing has been sent.
FrmMessage.LblRecipient.Caption := 'To: ' + RecipientFullName;
FrmMessage.LblRecipient.Update;
FrmMessage.ShowModal; // Gets the message text, but processing is done here:

{Exit if message wasn't sent}
if not FrmMessage.ChBoxSend.Checked then exit;

{Cycle through all usernames in LBoxUniqueUsers,until a match is made:}
for i:= 0 to (LBoxUniqueUsers.Items.Count -1) do
if FullName(0,LBoxUniqueUsers.Items[i])= RecipientFullName then
begin
RecipientUserName := LBoxUniqueUsers.Items[i];
end;

if not sendLineMessage(0,RecipientUserName,'From: '+FullName(GetPrimaryServerID,WhoAmI(GetPrimaryServerID))+ ' - ' +FrmMessage.EditMessage.Text) then
begin
StatusBar1.SimpleText := 'Unknown error. Message not sent.';
ShowMessage('Unknown error. Message not sent.') ;
exit;
end;

StatusBar1.SimpleText := 'Message sent to ' + RecipientFullName +' ('+ RecipientUserName +').';

end;

{-----------------------------------------------}
procedure TForm1.ChBoxFilterClick(Sender: TObject);
var
j: integer;
junkLine: string;
{Removes known printers, etc. from LBoxFullNames}

begin

if not ChBoxFilter.Checked then
begin
Filter := False;
BButtUpdateClick(Sender);
LblTitle.Caption := IntToStr(LBoxFullNames.Items.Count) +' people are logged into ' +DefServer;
LblTitle.Update;
exit;
end;

{Look at each item of MemoJunk and remove from LBoxFullNames if present}
for j:= 0 to (MemoJunk.Lines.Count -1) do
begin
JunkLine := trim(MemoJunk.Lines[j]);
// if (JunkLine = 'somweb') then ShowMessage('somweb in junk');
with LBoxFullNames.Items do
begin
if IndexOf(JunkLine) > -1 then Delete(IndexOf(JunkLine));
end;
end;


Filter := True; //Global Boolean to say filtering is required.
StatusBar1.SimpleText := 'Filtering ...';

StatusBar1.SimpleText := '';
LblTitle.Caption := IntToStr(LBoxFullNames.Items.Count) +' people are logged into '+DefServer;
LblTitle.Update;
end;
{-----------------------------------------------}
procedure TForm1.ButtFriendClick(Sender: TObject);
{Called when user wishes to see when a friend logs in.}
var
j: integer;
begin
FrmFriends.ShowModal;

if not FrmFriends.ChBoxCancel.Checked then
begin
for j:=1 to 7 do {Update current friends}
begin
if j <= FrmFriends.LBoxFriends.Items.Count then Friend[j] := FrmFriends.LBoxFriends.Items[j-1] else Friend[j] := ''; //e.g if only two friends, friends 3,4 & 5 are ''. end; SaveToReg(sender); //Save friends to Registry. CheckLoggedIn(Sender); // See if any friends are logged in // WatchForFriends(Sender); {Watch for Friends} end; end; {----------------------------------------------} procedure TForm1.CheckLoggedIn(Sender: TObject); {See if any friends are logged in at present} var i,j: integer; begin LBoxFriendsHere.Clear; LBoxFriendsHere.Visible := False; for j:= 1 to 7 do //cycle through friends for i:= 1 to (LBoxFullNames.Items.Count-1) do //cycle through users begin if LBoxFullNames.Items[i] = Friend[j] then begin LBoxFriendsHere.Visible := True; LBoxFriendsHere.Items.Add(Friend[j]); end; end; LBoxFriendsHere.Update; end; {--------------------} procedure TForm1.ItemCancelClick(Sender: TObject); {Does nothing, CANCEL event of PMenuUsers cancel click.} begin exit; end; {----------------------------------------------------------} procedure TForm1.MenuFriendMessageClick(Sender: TObject); {Action for Popup menu of LBoxFriendHere to send line message to friend} var RecipientFullName : string; RecipientUserName: string; i: integer; begin if LBoxFriendsHere.ItemIndex = -1 then begin ShowMessage('Please select recipient, or double-click on recipient name.'); exit; end; {Now, to identify the username assigned to the FullName we must cycle through all the usernames in LBoxUniqueUsers, looking up the associated FullName and seeing if it matches that selected} {Get the fullname of the recipient:} RecipientFullName := LBoxFriendsHere.Items[LBoxFriendsHere.ItemIndex]; FrmMessage.LblRecipient.Caption := ''; FrmMessage.EditMessage.Clear; FrmMessage.ChBoxSend.Checked := False; // Flag that nothing has been sent. FrmMessage.LblRecipient.Caption := 'To: ' + RecipientFullName; FrmMessage.LblRecipient.Update; FrmMessage.ShowModal; // Gets the message text, but processing is done here: {Exit if message wasn't sent} if not FrmMessage.ChBoxSend.Checked then exit; {Cycle through all usernames in LBoxUniqueUsers,until a match is made:} for i:= 0 to (LBoxUniqueUsers.Items.Count -1) do if FullName(GetPrimaryServerID,LBoxUniqueUsers.Items[i])= RecipientFullName then begin RecipientUserName := LBoxUniqueUsers.Items[i]; end; if not sendLineMessage(GetPrimaryServerID,RecipientUserName,'From: '+FullName(GetPrimaryServerID,WhoAmI(GetPrimaryServerID))+ ' - ' +FrmMessage.EditMessage.Text) then begin StatusBar1.SimpleText := 'Unknown error. Message not sent.'; ShowMessage('Unknown error. Message not sent.') ; exit; end; StatusBar1.SimpleText := 'Message sent to ' + RecipientFullName +' ('+ RecipientUserName +').'; end; {-----------------------------------} procedure TForm1.ItemPhoneClick(Sender: TObject); {Attempts to get phone number of user from NDS} var ctemp: string; UserToLookup: string; // Username of phone number to lookup. FullNameOfPerson: String; // ... and correspnding fullname i: integer; begin { if LBoxFullNames.ItemIndex = -1 then begin ShowMessage('Please select someone.'); exit; end; } HttpToMemoForm.EditSearchName.Clear; HttpToMemoForm.LblInformUser.Visible := False; HttpToMemoForm.ActiveControl := HttpToMemoForm.EditSearchName; {Fill Search box with surname of current user} if LBoxFullNames.ItemIndex > -1 then
HttpToMemoForm.EditSearchName.Text := string(Surname(LBoxFullNames.Items[LBoxFullNames.ItemIndex]));
HttpToMemoForm.ShowModal;

end;
{-------------------------------------}
procedure TForm1.BButtSendMessageClick(Sender: TObject);
var
RecipientFullName : string;
RecipientUserName: string;
SenderName: string; //name of sender
i: integer;

begin
ImgSend.Visible := True;
ImgSend.Update;
Form1.BButtSendMessage.Enabled := False;
if LBoxFullNames.ItemIndex = -1 then
begin
ShowMessage('Please select recipient, or double-click on recipient name.');
ImgSend.Visible := False;
Form1.BButtSendMessage.Enabled := True;
ImgSend.Update;
exit;
end;
{Now, to identify the username assigned to the FullName we must cycle through
all the usernames in LBoxUniqueUsers, looking up the associated FullName and
seeing if it matches that selected}

{Get the fullname of the recipient:}
RecipientFullName := LBoxFullNames.Items[LBoxFullNames.ItemIndex];
RecipientUserName := LBoxUniqueUsers.Items[LBoxFullNames.ItemIndex];
{Cycle through all usernames in LBoxUniqueUsers,until a match is made:}
for i:= 0 to (LBoxUniqueUsers.Items.Count -1) do
if FullName(GetPrimaryServerID,LBoxUniqueUsers.Items[i])= RecipientFullName then
begin
RecipientUserName := LBoxUniqueUsers.Items[i];
end;

FrmMessage.LblRecipient.Caption := '';
FrmMessage.EditMessage.Clear;
FrmMessage.ChBoxSend.Checked := False; // Flag that nothing has been sent.
FrmMessage.LblRecipient.Caption := 'To: ' + RecipientFullName +' (' +RecipientUserName+')';
FrmMessage.LblRecipient.Update;
FrmMessage.ShowModal; // Gets the message text, but processing is done here:

{Exit if message wasn't sent}
if not FrmMessage.ChBoxSend.Checked then exit;
SenderName := WhoAmI(GetPrimaryServerID); //Will be in form acctw1.som.staff, must trim.
{Shorten full NDS qualified name to context name only:}
if pos('.',SenderName) >1 then SenderName := copy(SenderName,1,pos('.',SenderName)-1);
{Finally, resolve to fullname:}
SenderName := FullName(GetPrimaryServerID,SenderName);
if not sendLineMessage(GetPrimaryServerID,RecipientUserName,'From: '+SenderName+ ' - ' +FrmMessage.EditMessage.Text) then
begin
StatusBar1.SimpleText := 'Unknown error. Message not sent.';
ShowMessage('Unknown error. Message not sent.') ;
ImgSend.Visible := False;
ImgSend.Update;
Form1.BButtSendMessage.Enabled := True;

exit;
end;

StatusBar1.SimpleText := 'Message sent to ' + RecipientFullName +' ('+ RecipientUserName +').';
ImgSend.Visible := False;
ImgSend.Update;
Form1.BButtSendMessage.Enabled := True;

end;
{-------------------------------------------}
procedure TForm1.BButtUpdateClick(Sender: TObject);
{Updates list of users logged in}
var
i,j: integer ; //Simple loop counter
LastNameCopied: string; //Last username copied to List Bix
CurrentUserName: string; //Current username in NWUserList box.
ThisUser: String; //Actually name of person using program aka WhoAmI

begin
// // ndsSetContext('som.staff.hw');

// / Added May 2002
ReadJunkFile(Sender);
LBoxUserNames.Clear; //Empty list.
LBoxUniqueUsers.Clear;
LBoxFullNames.Clear;

{Must now copy duplicate usernames from NWListBox to normal list box
but do a check on each copy that the next item copied doesn't have the same
name. Requires NWlistbox to be sorted:}

StatusBar1.SimpleText := 'Building list of usernames ...';
LastNameCopied := 'xxxx'; //Initialise with dummy string
LBoxLoggedIn.Clear;
LBoxUserNames.Clear;
{Populate LoggedIn box with all logged in users:}
LBoxLoggedIn.items.addStrings(getUserList(0,false)) ;

{Weed out duplicate usernames:}
for i:= 0 to (LBoxLoggedIn.Items.Count -1) do
begin
CurrentUserName := LBoxLoggedIn.Items[i]; //may be distinguished form e.g. acctw1.som.staff.hw but need 'acctw1'
{Look for '.' in username and trim to just contextual name i.e acctw1.som.staff becomes 'acctw1'}
if pos('.',CurrentUserName) >1 then CurrentUserName := copy(CurrentUserName,1,pos('.',CurrentUserName)-1);
if CurrentUserName <> LastNameCopied then
begin
LBoxUserNames.Items.Add(CurrentUserName); // Add to list box.
LastNameCopied := CurrentUserName; //Update this variable.
end;
end;

{Now resolve usernames to real names. Also need to populate another listbox of
usernames so that we have unique LBox of Fullnames and usernames:}
StatusBar1.SimpleText := 'Resolving usernames to full names ...';
LBoxFullNames.Clear;

for i:=0 to (LBoxUserNames.Items.Count -1) do
begin
LBoxUserNames.ItemIndex := i; // move through the list box.
CurrentUserName := LBoxUserNames.Items[LBoxUserNames.ItemIndex];

{Populate list boxes}
LBoxFullNames.Items.Add(FullName(GetPrimaryServerID,CurrentUserName));
LBoxUniqueUsers.Items.Add(CurrentUserName); //Also add username to separate list box.
end;
LBoxFullnames.Sorted := True;
LBoxFullNames.Update;


StatusBar1.SimpleText := ' ';
LBoxFullNames.ItemIndex := -1; //Ensure no username is selected (to avoid SendMessage mistakes)

if ChBoxFilter.Checked then ChBoxFilterClick(Sender);
LblTitle.Caption := IntToStr(LBoxFullNames.Items.Count) +' people are logged into ' + DefServer;
LblTitle.Update;

ThisUser:= WhoAmI(GetPrimaryServerID); //returns name of form acctw1.som.staff.hw
if pos('.',ThisUser) >1 then ThisUser := copy(ThisUser,1,pos('.',ThisUser)-1); //returns 'acctw1'
ThisUser := FullName(GetPrimaryServerID,ThisUser); //resolves to FullName
StatusBar1.SimpleText:= 'Current User: '+ ThisUser ;
LblDate.Caption := FormatDateTime(' dddd, mmmm d, yyyy', Date);


{Update displayed list of friends logged in.}
CheckLoggedIn(Sender);

{Check if an HTML output file is required, initially just by seeing if command-line
parameters are specified, the subroutine does the rest and better checking}
if HTML then WriteHTML(Sender);

end;
{-----------------------------------------}
function Surname(InputString: String): PChar;
{Returns pointer to part of string after the last ' ' (space) character in string}
{ Use as follows:
S := string(NamePart('long string, 2nd var, third var'));
LblCurrentFile.Caption := S;
}
var
P: PChar;
begin
P := StrRScan(PChar(InputString), ' ');
if P = nil then P := Pchar(InputString);
P := P+1; //Pointer locates the 'space' character, but we want the 1st character of surname.
Result := P;
end;
{-----------------------------------------}
function PhoneExt(InputString: String): PChar;
{Returns pointer to part of string after the last 'x' character in string}
{ Use as follows:
S := PhoneExt(NamePart('long string, 2nd var, third var'));
LblCurrentFile.Caption := S;
}
var
P: PChar;
begin
P := StrRScan(PChar(InputString), 'x');
if P = nil then P := Pchar(InputString);
P := P+1; //Pointer locates the 'space' character, but we want the 1st character of surname.
Result := P;
end;

{------------------------------------------------}
procedure TForm1.ReadJunkFile(Sender: TObject);
{Reads INI file to find initial settings}

begin
try
JunkFile := FilePathStr+ '\junkusers.txt';
if not FileExists(JunkFile) then
begin
ShowMessage('Error: junk user file ' + JunkFile +' cannot be found');
end;

MemoJunk.Clear;
MemoJunk.Lines.LoadFromFile(JunkFile);

finally

end;
end;

{-----------------------------------------------------------------------}
procedure TForm1.KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
{Checks for Return key press in LBoxFullNames - onKeyUp event}
begin
If Key = VK_RETURN then
BButtSendMessageClick(LBoxFullNames);
end;

{---------------------------------------------------}
procedure TForm1.TimerUpdateTimer(Sender: TObject);
{Simply runs the BButtUpdate event every x-seconds}
begin
BButtUpdateClick(Sender);
end;
{---------------------------------------------------}

procedure TForm1.ChBoxAutoUpdateClick(Sender: TObject);
{Updates userlist on 5 minute basis.
If a command line parameter was given, will write users to an HTML file too !}
begin
if ChBoxAutoUpdate.Checked then
begin
BButtUpdateClick(Sender);
// if HTML then WriteHTML(Sender); // Save list of users as HTML file.
TimerUpdate.Enabled := True;
end
else
TimerUpdate.Enabled := False; //Stop autoupdate of userlist.
end;
{------------------------------------------------------}
procedure TForm1.BButtExitClick(Sender: TObject);
begin
//WriteJunkFile(Sender);
SaveToReg(Sender);
LBoxFullNames.Clear;
LBoxFullNames.Free;
NWUser.Clear;
NWUser.Free;
LBoxUniqueUsers.Clear;
LBoxUniqueUsers.Free;
LBoxUserNames.Clear;
LBoxUserNames.Free;

FrmFriends.LBoxFriends.Clear;
FrmFriends.LBoxFriends.Free;
FrmFriends.LBoxFullNames.Clear;
FrmFriends.LBoxFullNames.Free;
FrmFriends.LBoxTemp.Clear;
FrmFriends.LBoxTemp.Free;
MemoJunk.Clear;
MemoJunk.Free;


{Call close functions according to the NWLIB help file:}
//ndsClose;
//ndsFreeContext(ndsGetContextHandle);
Close;
Application.Terminate;
end;

{---------------------------------------}

procedure TForm1.BButtSearchClick(Sender: TObject);
{Simply loads default browser with a URL}
var
hURL: string; //URL to open
begin
hURL := 'http://www.sml.hw.ac.uk/computing/search.html';
try
ShellExecute(Application.Handle,'open',PChar(hURL), nil, nil, SW_NORMAL);
except
ShowMessage('An error occured trying to launch the web browser');
end;
end;
{-----------------------------------------------}
procedure TForm1.CheckParams(Sender: TObject);
{Checks command-line parameters and if they're okay, writes userlist to specified file.
Valid command-line parameters are
winusers -h
}

begin
try
// ShowMessage('Params are ' +ParamStr(1) +', '+ParamStr(2));
if ParamCount <> 2 then exit; //Basic test
if lowercase(ParamStr(1)) <> '-h' then exit; //Only looking for this parameter

//Now assign HTML file for list of users logged in:
HTMLFile := ParamStr(2);
//Now test that the folder of this file exists
if not DirectoryExists(ExtractFilePath(HTMLFile)) then exit;
//Finally, assign Global Boolean variable to true
HTML := True;
exit;

except

end;

end;
{-----------------------------------------------}
procedure TForm1.WriteHTML(Sender: TObject);
{Writes HTML file of logged in people}
var
F : TextFile; {handle of above file}
i: integer; //Simple counter
htmlhead,htmlclose : string; //HTML formatting strings

begin
try
{Open HTML file}
AssignFile(F, HTMLFile); {Assign a file handle}
Rewrite(F); {Open text file for writing only}
htmlhead := '';
htmlhead := htmlhead +'';
htmlhead := htmlhead +'

' +LblTitle.Caption + '
';
htmlhead := htmlhead +'' + LblDate.Caption + ' ';
htmlhead := htmlhead +'Time of snapshot: ' +TimeToStr(Time) +'

';
htmlhead := htmlhead +'

' ; htmlhead := htmlhead +''; Writeln(F,htmlhead);//Write Header for i:= 0 to (LBoxFullNames.Items.Count -1) do Writeln(F, ' '+LBoxFullNames.Items[i]); Writeln(F,'

');
Writeln(F,'Snapshot updated every 5 minutes.
');
Writeln(F,'See also School staff contact information.

');

htmlclose := '';
Writeln(F,htmlclose);
except

end;
CloseFile(F);
end;
{-----------------}

procedure TForm1.AddRemove1Click(Sender: TObject);
begin
ButtFriendClick(Sender);
end;
{---------------------------------------------}


end.