AppleTalk Shell
Volume Number: | | 5
|
Issue Number: | | 12
|
Column Tag: | | Pascal Procedures
|
Related Info: AppleTalk Mgr Event Manager
AACK gives AppleTalk Shell
By Ajay Nath, Oakland Gardens, NY
Note: Source code files accompanying article are located on MacTech CD-ROM or source code disks.
[Ajay Nath has two B.A.s, one in Chemistry and one in Mathematics. He is currently a second year medical student and is using Macs to develop Color Vision tests.]
AACK OR ATApp?
Example AppleTalk programs have appeared before in MacTutor but none recently except in one of the HyperCard columns. The introduction of MultiFinder, a new interface to the AppleTalk routines and new features added to AppleTalk itself, have changed the way applications should use AppleTalk. In this article I present a program called AACK, the AppleTalk Application Construction Kit, which was written in LightSpeed Pascal 2.0, which demonstrates how to use the new AppleTalk interface and how to use the background features of MultiFinder. The resources of the program were created by ResEdit and stored in a file called aack.rsrc, a rez description of the resources is found in the file resources.r. The code of the program is in 4 files/units as follows:
FILE/UNIT CONTENTS
globals.p global declarations
lowlevelATprocs.p low level procs
hooks.p code specific to the application
main.p generic application code
The code is designed to be easily modifiable. By simply changing code in the file hooks.p the nature of the applications produced can be changed. For example, in the file main.p, the code that handles menu selections look like:
{1}
IF HookedMenuChoice(theMenu, theItem) = FALSE THEN BEGIN
CASE theMenu OF
APPLEMENUID:
DoAppleMenu(theItem);
FILEMENUID:
DoFileMenu(theItem);
SPECIALMENUID:
DoSpecialMenu(theItem);
OTHERWISE
END;
END;
where the function HookedMenuChoice is declared in the file/unit hooks.p. It returns false if it DIDNT handle the menu choice, it allows the programmer to hook or handle menu choices before the applications generic code does and to override the generic codes response. For example, the generic code of AACK simply puts up a windows, some menus, and allows the user to see others of his type on the network and to confirm their presence. There is a menu titled Special which has items labeled LookUp, Confirm and Send. The generic code handles the first two items (this can be overridden) but does nothing but beep when Send is chosen. By changing the code in the hooks.p file, you can create an application that does something else with AppleTalk, perhaps sending strings through the net as was shown in a previous MacTutor article. There is obviously a code/speed overhead introduced by using this method, but its far more easy to get something to work and to later go back and optimize than to start each application from scratch. (Maybe I should have called it ATApp: The Expandable Macintosh AppleTalk Application?)
Bypassing Generic (Brand?) Code OR OverRidem CowBoy!
Most of the generic code is trivial stuff to MacTutor readers and I have left out some things such as handling DAs which is left to the reader as an exercise. The code does use LSPs ability to have compiler variables. I declare a compiler option called TALK_DEBUG and set it to TRUE when I want the compiler to include certain debugging code in the app. Basically, the generic code does a SetUp routine and lets the code from the Hooks unit do any SetUp - i.e. - the generic routine SetUpGlobals does its SetUps and then calls the procedure SetUpHooksGlobals, which lets the Hooks code do its SetUps. Similarly the generic code lets the Hooks code do any Window and AppleTalk SetUps after it has done its own such SetUps. The generic code also checks to see if the Hooks code has decided to take over the duties of taking care of the applications window by examining a global Boolean variable called UserWindowProcsChanged which the Hooks code can set to true in its SetUp code. For example when activating the UserWindow the generic code does the following:
{2}
IF UserWindowProcsChanged THEN
HooksActivateUserWindowProc {Let hook code do its magic}
ELSE
LActivate(T, NameListHdl);
One consequence of this is that even if the Hooks code wants to override only one of the procedures that controls the windows activation, deactivation, updating, or disposal, it must override them ALL. You only have to copy and paste the generic code from the file main.p into the file hooks.p to mimic the generic codes handling of the other procedures though. For example, you might write an app using AACK which receives/sends messages and overrides the way the generic code draws the windows contents to draw any received messages at the bottom of the window, but it wouldnt need to override any other of the generic codes window handling routines. You could just copy the other generic code routines from the file main.p and pasted them into the right places in the file hooks.p.
Generic AppleTalk Code OR AppleTalk is cheap
The AppleTalk generic code does the following:
1) calls MPPOpen and then SysEnvirons which returns to us among other information, the type of machine were running on and the version of AppleTalk available. We exit if were not running on at least a 512KE, and if we are, set a boolean variable called NewCallsExist to true if the AppleTalk driver version supports the new AppleTalk calls
2) opens an ATP socket
3) calls WaitNextEvent a few times to make sure our dialog that lets the user select a name comes up in front and lets the user register on the network with a name (1->31 chars)
4) depending on the setting of a compiler variable called TALK_DEBUG tries to call PSetSelfSend, a new AppleTalk call which lets you send AppleTalk packets to your own node. This is useful if your network consists of one machine as mine does, unfortunately this feature is implemented only on machines with the drivers with version numbers >= 48, (actually its listed as 48 in IM V but 45 in the MPW Assembler Equates, which is it Apple?)
5) then the generic code lets the Hooks unit do any AppleTalk SetUps, (such as post asynchronous GetRequests if it was going to receive requests)
If all of the above goes well then the generic code sets up its Menus, lets the Hooks unit do any of its menu setups, then the generic code sets up its window and lets the Hooks unit modify that window or set up any of its own and were off into our event loop!
MultiFinder and AppleTalk OR ASYNC or swim!
The generic codes event loop calls WaitNextEvent (you already know how to check for the presence of WNE so I dont do this) and calls a procedure called AppleTalkCallChecks before it handles any events. This procedure is going to check for any ASYNC calls that may have finished and handle them. For example, the generic code calls PLookUpName ASYNChronously, this allows the user to start a LookUp to see if any other users of the same type are on the network, and work on other things while the LookUp is begin done. This IS after all is what MultiFinder is for! The tricky part of making ASYNC calls is knowing when theyve finished and taking care of them when they do finish. I solve this problem by using Completion Routines and special data structures. I got the idea from Tech Note #180 - MultiFinder Miscellanea, in which it is suggested that applications making ASYNC calls store their A5 somewhere RELATIVE to the parameter block which they use to make the ASYNC calls, so that when their Completion Routines are executed they can load the applications A5 and set a global variable to indicate that an ASYNC call has finished. I use a similar approach. I define the following structure in the file globals.p:
{3}
NameLookUpRec = RECORD
PbInUse: Boolean;
CallDone: LongInt;
xMPPPb: MPPParamBlock;
END;
When a call is made using a record of this type the field PbInUse is set to TRUE and CallDone is set to zero. The Completion Routine that is executed when the call finishes sets the CallDone field to -1.
The routine AppleTalkCallChecks (called once through each event loop) just checks the CallDone field of the record and if it is non-zero we know that an ASYNC call has just completed. The advantages of this method are as follows:
1) the Completion Routine used is VERY simple, as it must be since Completion Routines cannot make any calls that affect memory, all it does is set the CallDone field to a non-zero value. The completion routine is declared in LSP in the following way in the file lowlevelATprocs.p:
{4}
PROCEDURE InlineRoutine;
INLINE
$213C, $FFFF, $FFFF; { MOVEA.L #-1,-(A0) set CallDone field}
PROCEDURE XCompletionRoutine;
{When routine is called A0 = ptr to ParamBlock}
BEGIN
InlineRoutine;
END;
2) we dont have to worry about whether our A5 is valid when our Completion Routine runs
The drawbacks of using this method are that we must check our ASYNC calls EVERY time through our event loop and that the parameter blocks we use to make them MUST be global variables so that we can check them.
Using the PREFERRED interface OR Learning to AppleTalk all over again
Wed like to use the (new) preferred AppleTalk interface because its more robust, and if were running with the right versions of the AppleTalk drivers we can use the new AppleTalk calls. Information about the new AppleTalk calls is in IM V (and I suppose, in Inside AppleTalk which is available from APDA which I dont have). There are two different types of parameter blocks defined in the new interface, the ATPParamBlock and the MPPParamBlock, and you just fill in the fields necessary for the call you want to make and then pass a ptr to the ParamBlock to the function youre calling - i.e. -
{5}
err = PCallName (@ParamBlock, true or false for ASYNC);
The catch is that when filling out the fields in parameter blocks for OLD AppleTalk routines that you call with the NEW interface, you use the information from Calling the AppleTalk Manager routines from Assembly Language from IM II. Look at the pages in IM V which describe the new types, it shows which fields have to be filled with which values to make a call. Some field names have changed though, so be careful, make sure youve filled them out right - then check them again!
New (and Improved?) AppleTalk Calls OR Dont LookUp before you leave
A few new AppleTalk calls are quite useful to us, for example, the generic code of AACK does ASYNC LookUps, but what happens if the user quits BEFORE the LookUp completes? If the application just quit, then sooner or later that ASYNC call would complete and the Completion Routine (which is no longer around) would be called and BOOOOM! If we dont have access to the new calls then we just have to wait till the ASYNC call completes which we can do by:
while CallDone = 0 do
;
, which just waits till a particular call is done before proceeding. There is however a new call, PKillNBP, which allows us to kill pending calls, (but if it fails we will have to wait the call out). Note that IM V in some places incorrectly lists which ParamBlock, ATP or MPP to use, this call requires an MPPParamBlock. The generic code also uses the call PSetSelfSend to allow the user to receive/send packets to his own node, a feature of the new AppleTalk drivers which is useful to programmers, but we must be careful to restore the state of this flag - i.e. - if it wasnt enabled when we started, then we should disable it when we leave.
The future OR Everybody AppleTalks but nobody DOES anything with it
Should the PConfirmName calls be made ASYNC? Ill leave it to you as an exercise. Ive already written an application (modifying ONLY the file hooks.p) which uses the AACK shell to receive/send strings (Str255s actually). If anyone is interested in seeing it, let Dave Smith at MacTutor know and Ill write it up, its code will be shorter than this article but it may take longer to explain.
Using PSetSelfSend on a Mac Plus OR AppleTalking to yourself on a Plus
Ive found a way to get the new AppleTalk drivers running on my Mac Plus and I can test my AppleTalk code on my network of one using PSetSelfSend to enable me to send packets to myself. Those of you who are thinking, Thats easy, just copy the DRVR resources out of the latest System File and paste them into the System File you use on your Mac Plus!, are thinking along the wrong lines. The new drivers are in the Mac II ROM and perhaps the SE ROM (I dont have one to test). Im not sure its a good idea to use the new drivers on a Mac Plus, but I havent had any problems with my system (yet). Apple must have some reason not to make the new drivers available for the Mac Plus so I wont pass this information along unless anyone out there is interested and Apple says its OK (youve figured out how to do it though, right?).
Id like to thank K.S. without whose love and support this article would not be possible.
Listing: globals.p
unit Globals;
interface
uses
AppleTalk;
type
{AppleTalk Types}
NameLookUpRec = record
PbInUse: Boolean;
CallDone: LongInt;
xMPPPb: MPPParamBlock;
end;
{String Types}
Str32Hdl = ^Str32Ptr;
Str32Ptr = ^Str32;
const
F = false;
T = true;
{Constants used ONLY when debugging}
{$IFC TALK_DEBUG }
SENDSELF = 1;
{$ENDC}
{AppleTalk Constants}
ANYZONE = *;
ANYOJB = =;
ASYNC = T;
DOVERIFY = 1;
LOOKUPBUFFERSIZE = 1023;
MAXNAMELENGTH = 31;
MAXTOLOOKUP = 100;
SYNC = F;
XNCVERSION = 48;
{Dialog Constants}
rABOUTDLOGID = 128;
rUSERNAMEDLOGID = 129;
rUSERNAMEITEM = 4;
{Event Constants}
MFEVENT = app4Evt;
RESUMEMASK = 1;
SUSPENDRESUMEMSG = 1;
{Menu Constants}
APPLEMENUID = 128;
ABOUTITEM = 1;
FILEMENUID = 129;
QUITITEM = 1;
EDITMENUID = 130;
SPECIALMENUID = 131;
LOOKUPITEM = 1;
CONFIRMITEM = 2;
SENDITEM = 3;
{String Resource Constants}
rAPPUSERNAMESTRID = 128;
rCHOOSERUSERSTRID = -16096;
var
DoneFlag: Boolean;
DragRect: Rect;
Evt: EventRecord;
{Globals used ONLY when debugging}
{$IFC TALK_DEBUG }
DebugOnRect: Rect;
OldSelfFlag: Byte;
SelfSendOn: Boolean;
SelfSendOnRect: Rect;
{$ENDC}
{AppleTalk Globals}
ConfirmString: Str255;
ConfirmStringPos: Point;
ConfirmStringRect: Rect;
LookUpBuffer: array[0..LOOKUPBUFFERSIZE] of Integer;
LookUpNamePb: NameLookUpRec;
LookUpNTT: EntityName;
LookUpString: Str255;
LookUpStringPos: Point;
LookUpStringRect: Rect;
NBPsNTE: NamesTableEntry;
NewCallsExist: Boolean;
UserNTT: EntityName;
UserSkt: Byte;
{List Globals}
ListFrameRect, ListViewRect: Rect;
MaxRows, NameListLength: Integer;
NameListHdl: ListHandle;
{Event Globals}
SleepTime: LongInt;
{Menu Globals}
AppleMenu, FileMenu, EditMenu, SpecialMenu: MenuHandle;
{Window Globals}
TextHeight: Integer;
UserWindowFontInfo: FontInfo;
UserWindowProcsChanged: Boolean;
UserWindowRect: Rect;
UserWindow, WhichWindow: WindowPtr;
UserWRec: WindowRecord;
implementation
end.
Listing: lowlevelatprocs.p
unit LowLevelATProcs;
interface
uses
AppleTalk, Globals;
procedure XCompletionRoutine;
function NTTExists (ntt2Confirm: EntityName; var theAddress: AddrBlock):
OSErr;
procedure DrawConfirmString;
procedure DrawLookUpString;
implementation
procedure InlineRoutine;
inline
$213C, $FFFF, $FFFF; { MOVEA.L #-1,-(A0) set CallDone field}
procedure XCompletionRoutine;
{When routine is called A0 = ptr to ParamBlock}
begin
InlineRoutine;
end;
function NTTExists (ntt2Confirm: EntityName; var theAddress: AddrBlock):
OSErr;
{This function test whether or not an NTT exists at a certain address
and}
{ returns its new address if it moved}
var
err: OSErr;
localMPPPb: MPPParamBlock;
begin
with localMPPPb do
begin
ioCompletion := nil;
{$IFC TALK_DEBUG }
interval := 6;
count := 2;
{$ELSC}
interval := 10;
count := 10;
{$ENDC}
entityPtr := @ntt2Confirm; {NTT to confirm}
confirmAddr := theAddress; {address to confirm}
err := PConfirmName(@localMPPPb, SYNC);
NTTExists := err;
if err = nbpConfDiff then
{If the NTT moved then return its new address}
theAddress.aSocket := newSocket;
end;
end;
procedure DrawConfirmString;
{This proc draws the result of the last ConfirmName call}
{It assumes that the current port is the user window}
begin
with ConfirmStringPos do
begin
EraseRect(ConfirmStringRect);
MoveTo(h, v);
DrawString(Confirm Status = );
DrawString(ConfirmString);
end;
end;
procedure DrawLookUpString;
{This proc draws the result of the last LookUpName call}
{It assumes that the current port is the user window}
begin
with LookUpStringPos do
begin
EraseRect(LookUpStringRect);
MoveTo(h, v);
DrawString(LookUp Status = );
DrawString(LookUpString);
end;
end;
end.
Listing: hooks.p
unit Hooks;
interface
uses
AppleTalk, Globals, LowLevelATProcs;
const
USERTYPE = NATH;
procedure SetUpHooksGlobals;
procedure SetUpHooksMenus;
function HookedMenuChoice (menu, item: Integer): Boolean;
procedure HooksActivateUserWindowProc;
procedure HooksCloseUserWindowProc;
procedure HooksDeactivateUserWindowProc;
procedure HooksUpdateUserWindowProc;
procedure HooksUserWindowDoContentHit;
procedure ActivateHooksWindow (theWIndow: WindowPtr);
procedure CloseHooksWindows;
procedure DeactivateHooksWindow (theWIndow: WindowPtr);
procedure DoHooksWindowContentHit;
function SetUpHooksWindows: Boolean;
procedure UpdateHooksWindow (theWIndow: WindowPtr);
procedure HooksAppleTalkCallChecks;
function HooksAppleTalkGlobalsSetUp: Boolean;
procedure HooksCloseUpAppleTalk;
function HooksRegistered: Boolean;
implementation
procedure SetUpHooksGlobals;
{This proc allows the hook code to init its globals}
begin
end;
procedure SetUpHooksMenus;
{This proc allows the hook code to init its menus}
begin
end;
function HookedMenuChoice (menu, item: Integer): Boolean;
{This proc allows the hook code to override menu choices which the generic
code}
{would normally handle, it returns T if it overrode a menu choice}
begin
{Assume were not handling the menu choice}
HookedMenuChoice := F;
end;
procedure HooksActivateUserWindowProc;
{This proc is used to override the generic codes activation of the UserWindow}
begin
end;
procedure HooksCloseUserWindowProc;
{This proc is used to override the generic codes closing of the UserWindow}
begin
end;
procedure HooksDeactivateUserWindowProc;
{This proc is used to override the generic codes deactivation of the
UserWindow}
begin
end;
procedure HooksUpdateUserWindowProc;
{This proc is used to override the generic codes updating of the UserWindow}
begin
end;
procedure HooksUserWindowDoContentHit;
{This proc is used to override the generic codes handling of mouse hits}
{in the UserWindow}
begin
end;
procedure ActivateHooksWindow (theWIndow: WindowPtr);
{This proc is used to activate any windows the hook code created}
begin
end;
procedure CloseHooksWindows;
{proc is used to close any windows the hook code created}
begin
end;
procedure DeactivateHooksWindow (theWIndow: WindowPtr);
{proc is used to deactivate any windows hook code created}
begin
end;
procedure DoHooksWindowContentHit;
{This proc is used to handle mouse hits in any windows the hook code
created}
begin
end;
function SetUpHooksWindows: Boolean;
{proc is used to setup windows hook code wants to create}
{and it allows the hook code to set the UserWindowProcsChanged global}
{it returns T if it succeeds}
begin
{Assume error}
SetUpHooksWindows := F;
{Set to false to show that we dont change any of the UserWindow procs}
UserWindowProcsChanged := F;
{Return T since we succeeded}
SetUpHooksWindows := T;
end;
procedure UpdateHooksWindow (theWIndow: WindowPtr);
{proc is used to update any windows the hook code created}
begin
end;
procedure HooksAppleTalkCallChecks;
{proc is used to check any ASYNC AppleTalk calls hook code made}
begin
end;
function HooksAppleTalkGlobalsSetUp: Boolean;
{This proc does any AppleTalk setups hook needs to make, it}
{returns T if it succeeds}
begin
{Assume error}
HooksAppleTalkGlobalsSetUp := F;
{Return T since we succeeded}
HooksAppleTalkGlobalsSetUp := T;
end;
procedure HooksCloseUpAppleTalk;
{proc does any AppleTalk closeups the hook needs to make}
begin
end;
function HooksRegistered: Boolean;
{This allows the hook code to do any AppleTalk calls its needs to make}
{after the User had registered. It returns T if it succeed}
begin
{Assume error}
HooksRegistered := F;
{Return T since we succeeded}
HooksRegistered := T;
end;
end.
Listing: main.p
program AACK;
uses
AppleTalk, Globals, LowLevelATProcs, Hooks;
procedure Crash;
{This proc is called if we crash}
begin
ExitToShell;
end;
procedure SetUpToolbox;
{This proc inits the Mac toolbox}
begin
MaxApplZone;
MoreMasters;
MoreMasters;
MoreMasters;
MoreMasters;
InitGraf(@thePort);
InitFonts;
InitWindows;
FlushEvents(everyEvent, 0);
InitMenus;
TEInit;
InitDialogs(@Crash);
InitCursor;
end;
procedure SetUpGlobals;
{This proc does any app global inits}
begin
DoneFlag := F;
DragRect := screenBits.bounds;
with DragRect do
begin
top := top + 20;{NOTE! we really should use the mbarheight}
left := left + 4;
bottom := bottom - 4;
right := right - 4;
end;
{Assume the new calls dont exist}
NewCallsExist := F;
SleepTime := 10;
{$IFC TALK_DEBUG }
with DebugOnRect do
begin
top := 0;
left := 0;
bottom := 4;
right := 4;
end;
with SelfSendOnRect do
begin
top := 5;
left := 0;
bottom := 9;
right := 4;
end;
{$ENDC}
{Allow setup of any globals from the Hooks unit}
SetUpHooksGlobals;
end;
procedure SetUpMenus;
{This proc sets upthe generic codes menus}
begin
AppleMenu := GetMenu(APPLEMENUID);
AddResMenu(AppleMenu, DRVR);
InsertMenu(AppleMenu, 0);
FileMenu := GetMenu(FILEMENUID);
InsertMenu(FileMenu, 0);
EditMenu := GetMenu(EDITMENUID);
InsertMenu(EditMenu, 0);
SpecialMenu := GetMenu(SPECIALMENUID);
InsertMenu(SpecialMenu, 0);
{Allow setup of any menus from the Hooks unit}
SetUpHooksMenus;
DrawMenuBar;
end;
procedure CloseWindows;
{This proc closes the apps windows}
begin
{Allow closing of any windows from the Hooks unit}
CloseHooksWindows;
if UserWindowProcsChanged then
HooksCloseUserWindowProc {Let the hook code do it magic}
else
begin
LDispose(NameListHdl);
CloseWindow(UserWindow);
end;
end;
function GotWindows: Boolean;
{This code sets up the apps windows, it returns T}
{if it succeeds}
var
theCell: Cell;
dBounds: Rect;
begin
{Assume we fail}
GotWindows := F;
UserWindowRect := DragRect;
with UserWindowRect do
begin
top := top + 20;
left := left + 4;
bottom := top + 200;
right := left + 225;
end;
{Get the UserWindow}
UserWindow := NewWindow(@UserWRec, UserWindowRect, UserNTT.objStr, F,
noGrowDocProc, WindowPtr(-1), T, 0);
if UserWIndow <> nil then
begin
SetPort(UserWindow);
ClipRect(UserWindow^.portRect);
TextFont(monaco);
TextSize(9);
GetFontInfo(UserWindowFontInfo);
with UserWindowFontInfo do
TextHeight := ascent + descent + leading;
{Set the # of rows to display in our list}
MaxRows := 10;
{Set the current list length to 0}
NameListLength := 0;
with dBounds do
begin
top := 0;
left := 0;
bottom := NameListLength; {no rows for now}
right := 1; {one column}
end;
theCell.h := 0;
theCell.v := 0;
{Set up the lists view rect}
with ListViewRect do
begin
top := 10;
left := 10;
bottom := (TextHeight * MaxRows) + ListViewRect.top;
right := (32 * CharWidth(w)) + 8;
end;
{Try to get a ListHandle}
NameListHdl := LNew(ListViewRect, dBounds, theCell, 0, UserWindow, T,
F, F, T);
if NameListHdl = nil then
{We failed to get a ListHandle so close UserWindow and exit}
CloseWindow(UserWindow)
else
begin
{We got the ListHandle, allow only one selection at a time from it}
NameListHdl^^.selFlags := LOnlyOne;
{Set up a rect to put a frame around our list}
ListFrameRect := ListViewRect;
with ListFrameRect do
begin
top := top - 1;
left := left - 1;
bottom := bottom + 1;
right := right + 16;
{Set up the pos to draw the LookUpName results at}
with LookUpStringPos do
begin
h := left;
v := bottom + TextHeight;
end;
{Set up the pos to draw the ConfirmName results at}
with ConfirmStringPos do
begin
h := left;
v := LookUpStringPos.v + TextHeight;
end;
end;
{Set up the rect to erase the old LookUpName result}
with LookUpStringRect do
begin
top := ListFrameRect.bottom + 1;
left := UserWindow^.portRect.left;
bottom := LookUpStringPos.v + UserWindowFontInfo.descent;
right := UserWindow^.portRect.right;
end;
{Set up the rect to erase the old ConfirmName result}
with ConfirmStringRect do
begin
top := LookUpStringRect.bottom + 1;
left := UserWindow^.portRect.left;
bottom := ConfirmStringPos.v + UserWindowFontInfo.descent;
right := UserWindow^.portRect.right;
end;
{Set to false, assume no hook code override}
UserWindowProcsChanged := F;
{Allow setup of any windows from the Hooks unit}
if SetUpHooksWindows = T then
begin
ShowWindow(UserWindow);
{We succeeded! Return T}
GotWindows := T;
end
else
begin
{SetUpHooksWindows failed}
LDispose(NameListHdl);
CloseWindow(UserWindow);
end;
end;
end;
end;
procedure DoDrag;
{This code drags windows around}
begin
DragWindow(WhichWindow, Evt.where, DragRect);
end;
procedure ActivateUserWindow;
{This code activates the apps windows}
begin
if UserWindowProcsChanged then
HooksActivateUserWindowProc {Let hook code do its magic}
else
LActivate(T, NameListHdl);
end;
procedure DeactivateUserWindow;
{This code deactivates the apps windows}
begin
if UserWindowProcsChanged then
HooksDeactivateUserWindowProc {Let the hook code do its magic}
else
LActivate(F, NameListHdl);
end;
procedure UpdateNameList;
{This code updates the list of names in the NameListHandle}
var
theAddress: AddrBlock;
theCell: Cell;
theNTT: EntityName;
theNum: Integer;
err: OSErr;
thePtr: Ptr;
begin
with LookUpNamePb do
begin
if NameListLength <> 0 then
LDelRow(NameListLength, 0, NameListHdl); {Delete any rows present}
NameListLength := xMPPPb.numGotten; {Get the new # of rows needed}
if NameListLength <> 0 then
begin
theNum := LAddRow(NameListLength, 0, NameListHdl); {Add the # of new
rows}
theCell.h := 0;
for theNum := 1 to NameListLength do
begin
err := NBPExtract(@LookUpBuffer, NameListLength, theNum, theNTT, theAddress);
{extract a name}
if err = noErr then
begin
theCell.v := theNum - 1; {Cells are numbered starting from zero so bump
row # back}
thePtr := Ptr(ORD4(@theNTT.objStr) + 1); {Pt to the data}
LSetCell(thePtr, length(theNTT.objStr), theCell, NameListHdl); {Set
the cells data}
end;
end;
{Select the first row}
theCell.h := 0;
theCell.v := 0;
LSetSelect(T, theCell, NameListHdl);
end;
end;
end;
procedure UpdateUserWindow;
{This code updates the UserWindow}
var
theRgn: RgnHandle;
begin
if UserWindowProcsChanged then
HooksUpdateUserWindowProc {Let hook code do its magic}
else
begin
{$IFC TALK_DEBUG }
ForeColor(redColor);
FillRect(DebugOnRect, black);
if SelfSendOn then
begin
ForeColor(cyanColor);
FillRect(SelfSendOnRect, black);
end
else
begin
ForeColor(cyanColor);
FrameRect(SelfSendOnRect);
end;
ForeColor(blackColor);
{$ENDC}
FrameRect(ListFrameRect); {Put a frame around list}
theRgn := UserWindow^.visRgn;
LUpdate(theRgn, NameListHdl); {Update the list}
DrawLookUpString; {Draw in last LookUpName result}
DrawConfirmString; {Draw in last ConfirmName result}
end;
end;
procedure DoActivate;
{This code activates any app windows}
var
theWindow: WindowPtr;
begin
theWindow := WindowPtr(Evt.message);
SetPort(theWindow);
if BAnd(activeFlag, Evt.modifiers) <> 0 then
begin
if theWindow = UserWindow then
ActivateUserWindow
else
ActivateHooksWindow(theWindow); {Let the hook code activate its windows}
end
else
begin
if theWindow = UserWindow then
DeactivateUserWindow
else
DeactivateHooksWindow(theWindow); {Let the hook code deactivate its
windows}
end;
end;
procedure DoUpdate;
{This proc does updates of app windows}
var
oldPort: GrafPtr;
theWindow: WindowPtr;
begin
GetPort(oldPort);
theWindow := WindowPtr(Evt.message);
SetPort(theWindow);
BeginUpdate(theWindow);
if theWindow = UserWindow then
UpdateUserWindow
else
UpdateHooksWindow(theWindow); {Let the hook code update any of its windows}
EndUpdate(theWindow);
SetPort(oldPort);
end;
procedure DoMFEvent;
{code handles MultiFinder events such as deac/activation of}
{windows upon suspend/resume events}
var
theWindow: WindowPtr;
begin
theWindow := FrontWindow;
case BSR(Evt.message, 24) of {high byte of message}
SUSPENDRESUMEMSG:
begin
if BAnd(Evt.message, RESUMEMASK) <> 0 then
begin
SleepTime := 10;
SetPort(theWindow);
if theWindow = UserWindow then
ActivateUserWindow
else
ActivateHooksWindow(theWindow); {Let the hook code activate its windows}
end
else
begin
SleepTime := 60;
SetPort(theWindow);
if theWindow = UserWindow then
DeactivateUserWindow
else
DeactivateHooksWindow(theWindow); {Let the hook code deactivate its
windows}
end;
end;
otherwise
end;
end;
function UserRegistered: Boolean;
{This proc lets User register on the network, it return T}
{T if it succeeds}
label
100;
var
localATPPb: ATPParamBlock;
theDialog: DialogPtr;
theDRec: DialogRecord;
oldPort: GrafPtr;
item: Handle;
itemHit: Integer;
localMPPPb: MPPParamBlock;
err: OSErr;
itemRect: Rect;
theStr32Hdl: Str32Hdl;
theString: Str255;
begin
{Assume we fail}
UserRegistered := F;
{Get the string entered in the Chooser}
theStr32Hdl := Str32Hdl(GetResource(STR , rCHOOSERUSERSTRID));
{If there is no default user name from the chooser, then set theString
to the}
{null string}
if theStr32Hdl = nil then
theString := ;
GetPort(oldPort);
theDialog := GetNewDialog(rUSERNAMEDLOGID, @theDRec, WindowPtr(-1));
SetPort(theDialog);
ShowWindow(theDialog);
100:
if theStr32Hdl <> nil then
begin
HLock(Handle(theStr32Hdl));
theString := theStr32Hdl^^; {theString = the chooser string}
HUnlock(Handle(theStr32Hdl));
end;
{Show theString in the dialog and select it}
GetDItem(theDialog, rUSERNAMEITEM, itemHit, item, itemRect);
SetIText(item, theString);
SelIText(theDialog, rUSERNAMEITEM, 0, 32767);
{Loop until OK or Cancel is hit}
repeat
ModalDialog(nil, itemHit)
until ((itemHit = ok) or (itemHit = cancel));
if itemHit = ok then
begin
GetDItem(theDialog, rUSERNAMEITEM, itemHit, item, itemRect);
GetIText(item, theString);
itemHit := length(theString);
if (itemHit > 0) and (itemHit <= MAXNAMELENGTH) then
begin
{theString must be > 0 but < 32}
{First try to open a socket}
with localATPPb do
begin
ioCompletion := nil;
atpSocket := 0;
with addrBlock do
begin
aNet := 0;
aNode := 0;
aSocket := 0;
end;
end;
err := POpenATPSkt(@localATPPb, SYNC);
if err = noErr then
begin
UserSkt := localATPPb.atpSocket; {Save the socket #}
{Try to register the user on the network}
NBPSetEntity(@UserNTT, theString, USERTYPE, ANYZONE);
NBPSetNTE(@NBPsNTE, UserNTT.objStr, USERTYPE, ANYZONE, UserSkt); {Set
up the nte that NBP wants}
with localMPPPb do
begin
ioCompletion := nil;
interval := 3;
count := 3;
entityPtr := @NBPsNTE;
verifyFlag := DOVERIFY; {Make sure we register with a unique name}
end;
err := PRegisterName(@localMPPPb, SYNC);
if err = noErr then
begin
{We registered successfully!}
UserRegistered := HooksRegistered; {Let the hook code do its magic}
{$IFC TALK_DEBUG }
{Enable self sending if the new calls exist}
if NewCallsExist then
begin
localMPPPb.newSelfFlag := SENDSELF;
err := PSetSelfSend(@localMPPPb, SYNC);
if err = noErr then
begin
OldSelfFlag := localMPPPb.oldSelfFlag; {Save the old self flag state}
SelfSendOn := T; {Mark our selfsend flag as on}
end
else
SelfSendOn := F; {We failed, mark our selfsend flag as off}
end
else
SelfSendOn := F; {Mark our selfsend flag as off}
{$ENDC}
end
else
begin
{PRegisterName failed}
{Close the UserSkt}
localATPPb.atpSocket := UserSkt;
err := PCloseATPSkt(@localATPPb, SYNC);
end;
end;
end
else
{User didnt enter a valid string}
goto 100;
end;
{Close the dialog and return the result}
CloseDialog(theDialog);
SetPort(oldPort);
end;
function AppleTalkOK: Boolean;
{This proc makes sure were running on at least a 512KE}
{, it returns T if so and checks to see if the new calls exist}
var
err: OSErr;
theWorld: SysEnvRec;
begin
{Assume we failed}
AppleTalkOK := F;
err := MPPOpen; {Open AppleTalk}
if err = noErr then
begin
err := SysEnvirons(1, theWorld);
if err = noErr then
begin
with theWorld do
begin
if machineType >= env512KE then
begin
{Weve got at least a 512KE}
if atDrvrVersNum >= XNCVERSION then
{Weve got the new calls}
NewCallsExist := T;
AppleTalkOK := UserRegistered; {Let the user try to register}
end;
end;
end;
end;
end;
procedure AppleTalkCallChecks;
{This proc checks to see if any of ASYNC calls have finished}
var
oldPort: GrafPtr;
begin
with LookUpNamePb do
begin
if CallDone <> 0 then
begin
PbInUse := F;
CallDone := 0;
GetPort(oldPort);
SetPort(UserWindow);
UpdateNameList;
LookUpString := done;
DrawLookUpString;
SetPort(oldPort);
end;
end;
{Allow any AppleTalk call checks in the Hooks unit}
HooksAppleTalkCallChecks;
end;
procedure CloseUpAppleTalk;
{This proc closes up the apps AppleTalk socket lets hook}
{code cleanup anything it did with AppleTalk}
var
localATPPb: ATPParamBlock;
localMPPPb: MPPParamBlock;
err: OSErr;
begin
{A LookUp call may not have finished, if new calls exist}
{then KillNBP it, if not then we must wait till it finishes.}
with LookUpNamePb do
begin
if PbInUse then
begin
{There is a LookUpName in progress}
if NewCallsExist then
begin
{Weve got the new calls so we can kill it}
with localMPPPb do
begin
ioCompletion := nil;
nKillQEl := @LookUpNamePb.xMPPPb;
end;
err := PKillNBP(@localMPPPb, SYNC);
if err <> noErr then
begin
{We failed to KillNBP the LookUp so well just loop till the LookUp
is done}
{NOTE that we test the CallDone field since its changed by the completion
routine, NOT}
{the PbInUse field}
while LookUpNamePb.CallDone = 0 do
;
end;
end
else
{The new calls dont exist so well just loop till the LookUp is done}
{NOTE that we test the CallDone field since its changed by the completion
routine, NOT}
{the PbInUse field}
while LookUpNamePb.CallDone = 0 do
;
end;
end;
{Allow Hooks unit to closeup any AppleTalk calls it made}
HooksCloseUpAppleTalk;
{Close the UserSkt}
localATPPb.atpSocket := UserSkt;
err := PCloseATPSkt(@localATPPb, SYNC);
if err <> noErr then
SysBeep(1);
{Remove the users name from the network}
localMPPPb.entityPtr := @UserNTT;
err := PRemoveName(@localMPPPb, SYNC);
if err <> noErr then
SysBeep(1);
{$IFC TALK_DEBUG }
{Restore the SelfSendFlag to its former state}
if NewCallsExist then
begin
if SelfSendOn then
begin
if OldSelfFlag = 0 then
begin
{Turn it off if it wasnt on before}
localMPPPb.newSelfFlag := OldSelfFlag;
err := PSetSelfSend(@localMPPPb, SYNC);
end;
end;
end;
{$ENDC}
end;
function AppleTalkGlobalsSetUp: Boolean;
{This proc inits any app AppleTalk globals}
begin
{Assume error}
AppleTalkGlobalsSetUp := F;
with LookUpNamePb do
begin
PbInUse := F;
CallDone := 0;
end;
ConfirmString := never done;
LookUpString := never done;
{Allow setup of AppleTalk globals from the Hooks unit}
if HooksAppleTalkGlobalsSetUp then
AppleTalkGlobalsSetUp := T;
end;
procedure DoWNEs;
{Do a few WNEs to make sure our dialog comes up in front}
var
theResult: Boolean;
begin
theResult := WaitNextEvent(everyEvent, Evt, 0, nil);
theResult := WaitNextEvent(everyEvent, Evt, 0, nil);
theResult := WaitNextEvent(everyEvent, Evt, 0, nil);
theResult := WaitNextEvent(everyEvent, Evt, 0, nil);
theResult := WaitNextEvent(everyEvent, Evt, 0, nil);
end;
procedure DoAbout;
{This proc shows our About box}
var
theDialog: DialogPtr;
theDRec: DialogRecord;
oldPort: GrafPtr;
itemhit: Integer;
begin
GetPort(oldPort);
theDialog := GetNewDialog(rABOUTDLOGID, @theDRec, WindowPtr(-1));
SetPort(theDialog);
ShowWindow(theDialog);
repeat
ModalDialog(nil, itemHit)
until (itemHit = ok);
CloseDialog(theDialog);
SetPort(oldPort);
end;
procedure DoAppleMenu (item: Integer);
{This proc handles the Apple Menu}
begin
case item of
ABOUTITEM:
DoAbout;
otherwise
end;
end;
procedure DoFileMenu (item: Integer);
{This proc handles the File Menu}
begin
case item of
QUITITEM:
DoneFlag := T;
otherwise
end;
end;
procedure DoLookUp;
{This proc does an ASYNC LookUpName}
var
oldPort: GrafPtr;
err: OSErr;
begin
with LookUpNamePb do
begin
if PbInUse = F then
begin
{If were not already doing one}
NBPSetEntity(@LookUpNTT, ANYOJB, USERTYPE, ANYZONE); {Setup who to look
for}
CallDone := 0;
with xMPPPb do
begin
ioCompletion := @XCompletionRoutine;
{$IFC TALK_DEBUG }
interval := 2;
count := 3;
{$ELSC}
interval := 6;
count := 5;
{$ENDC}
entityPtr := @LookUpNTT;
retBuffPtr := @LookUpBuffer;
retBuffSize := sizeof(LookUpBuffer);
maxToGet := MAXTOLOOKUP;
end;
err := PLookUpName(@xMPPPb, ASYNC);
{Show the LookUps progress}
GetPort(oldPort);
SetPort(UserWindow);
if err = noErr then
begin
PbInUse := T;
LookUpString := in progress;
end
else
LookUpString := error;
DrawLookUpString;
SetPort(oldPort);
end;
end;
end;
procedure DoConfirm;
{This proc does a SYNC ConfirmName}
var
theAddress: AddrBlock;
nameIsSelected: Boolean;
theCell: Cell;
extractedNTT, ntt2Confirm: EntityName;
oldPort: GrafPtr;
err: OSErr;
begin
if LookUpNamePb.PbInUse then
begin
{Dont try to ConfirmName while a LookUp is in progress}
GetPort(oldPort);
SetPort(UserWindow);
ConfirmString := LookUp in progress;
DrawConfirmString;
SetPort(oldPort);
end
else
begin
theCell.h := 0;
theCell.v := 0;
nameIsSelected := LGetSelect(T, theCell, NameListHdl); {Get the selected
list item}
if nameIsSelected then
begin
{Only do a Confirm if an item in the list is selected}
theCell.v := theCell.v + 1;
err := NBPExtract(@LookUpBuffer, NameListLength, theCell.v, extractedNTT,
theAddress); {Get the address}
if err = noErr then
begin
NBPSetEntity(@ntt2Confirm, extractedNTT.objStr, extractedNTT.typeStr,
extractedNTT.zoneStr);
err := NTTExists(ntt2Confirm, theAddress); {Check if the NTT exists}
{Show the result of the ConfirmName}
GetPort(oldPort);
SetPort(UserWindow);
if err = noErr then
ConfirmString := confirmed
else
begin
case err of
nbpNoConfirm:
ConfirmString := cant confirm ;
nbpConfDiff:
ConfirmString := moved;
otherwise
ConfirmString := error;
end;
end;
DrawConfirmString;
SetPort(oldPort);
end;
end;
end;
end;
procedure DoSendRequest;
{This is the generic codes response to choosing Send}
begin
SysBeep(1);
end;
procedure DoSpecialMenu (item: Integer);
{This proc handles the Special Menu}
begin
case item of
LOOKUPITEM:
DoLookUp;
CONFIRMITEM:
DoConfirm;
SENDITEM:
DoSendRequest;
otherwise
end;
end;
procedure DoMenu (menuChoice: LongInt);
{This proc handles menu selections}
var
theItem, theMenu: Integer;
begin
theItem := LoWord(menuChoice);
theMenu := HiWord(menuChoice);
if HookedMenuChoice(theMenu, theItem) = F then
begin
{Hook code didnt handle menu choice so generic code must}
case theMenu of
APPLEMENUID:
DoAppleMenu(theItem);
FILEMENUID:
DoFileMenu(theItem);
SPECIALMENUID:
DoSpecialMenu(theItem);
otherwise
end;
end;
HiliteMenu(0);
end;
procedure DoKDown;
{This code handles keydowns}
type
Trick = packed record
case Boolean of
TRUE: (
long: Longint
);
FALSE: (
chr3, chr2, chr1, chr0: Char
)
end;
var
charCode: Char;
trickVar: Trick;
begin
trickVar.long := Evt.message;
charCode := trickVar.chr0;
{IF BitAnd(Evt.modifiers, CmdKey) = CmdKey THEN}
if BAnd(CmdKey, Evt.modifiers) <> 0 then
DoMenu(MenuKey(charCode));
end;
procedure DoContentHit;
{This code handles hits in the apps windows}
var
clickResult: Boolean;
localPt: Point;
begin
if WhichWindow <> FrontWindow then
SelectWindow(WhichWindow)
else
begin
localPt := Evt.where;
SetPort(WhichWindow);
if WhichWindow = UserWindow then
begin
if UserWindowProcsChanged then
HooksUserWindowDoContentHit {Let the hook code do its magic}
else
begin
GlobalToLocal(localPt);
if PtinRect(localPt, ListFrameRect) then
clickResult := LClick(localPt, Evt.modifiers, NameListHdl);
end;
end
else
{A hook window was hit, let it handle it}
DoHooksWindowContentHit;
end;
end;
procedure DoMDown;
{This code handles mouse down events}
var
theResult: Integer;
begin
theResult := FindWindow(Evt.where, WhichWindow);
case theResult of
inDrag:
DoDrag;
inMenuBar:
DoMenu(MenuSelect(Evt.where));
inContent:
DoContentHit;
otherwise
end;
end;
procedure MainLoop;
{This is the apps event loop}
var
theResult: Boolean;
begin
while DoneFlag = F do
begin
theResult := WaitNextEvent(everyEvent, Evt, SleepTime, nil);
AppleTalkCallChecks; {Check to see if any ASYNC calls completed}
if theResult then
begin
{Handle any event}
case Evt.what of
keyDown:
DoKDown;
mouseDown:
DoMDown;
activateEvt:
DoActivate;
updateEvt:
DoUpdate;
MFEVENT:
DoMFEvent;
otherwise
end;
end;
end;
end;
{$I-}
{We do our own inits}
begin
SetUpToolbox;
SetUpGlobals;
DoWNEs;
if AppleTalkOK then
begin
SetUpMenus;
if GotWindows then
begin
if AppleTalkGlobalsSetUp then
begin
MainLoop;
CloseWindows;
end;
end;
CloseUpAppleTalk;
end;
ExitToShell;
end.
Listing: resources.r
resource SIZE (-1) {
dontSaveScreen,
acceptSuspendResumeEvents,
disableOptionSwitch,
canBackground,
multiFinderAware,
81920,
81920
};
resource DITL (128, purgeable, preload) {
{ /* array DITLarray: 3 elements */
/* [1] */
{130, 134, 150, 213},
Button {
enabled,
Continue
},
/* [2] */
{8, 63, 26, 298},
StaticText {
disabled,
AACK - Version 1.1 - by Ajay Nath
},
/* [3] */
{56, 80, 74, 266},
StaticText {
enabled,
Copyright © 1989 Ajay Nath
}
}
};
resource DITL (129, purgeable, preload) {
{ /* array DITLarray: 4 elements */
/* [1] */
{89, 23, 109, 83},
Button {
enabled,
OK
},
/* [2] */
{90, 250, 110, 310},
Button {
enabled,
Cancel
},
/* [3] */
{6, 10, 41, 319},
StaticText {
disabled,
Enter a name (31 characters or less) to
use on the network
},
/* [4] */
{52, 16, 72, 317},
EditText {
enabled,
}
}
};
resource DLOG (128, purgeable, preload) {
{36, 146, 204, 490},
dBoxProc,
invisible,
noGoAway,
0x0,
128,
};
resource DLOG (129, purgeable, preload) {
{36, 150, 160, 482},
dBoxProc,
invisible,
noGoAway,
0x0,
129,
};
resource MENU (128, preload) {
128,
textMenuProc,
0x7FFFFFFD,
enabled,
apple,
{ /* array: 2 elements */
/* [1] */
About AACK , noIcon, , , plain,
/* [2] */
-, noIcon, , , plain
}
};
resource MENU (129, preload) {
129,
textMenuProc,
allEnabled,
enabled,
File,
{ /* array: 1 elements */
/* [1] */
Quit, noIcon, Q, , plain
}
};
resource MENU (130, preload) {
130,
textMenuProc,
0x7FFFFFFD,
enabled,
Edit,
{ /* array: 6 elements */
/* [1] */
Undo, noIcon, Z, , plain,
/* [2] */
-, noIcon, , , plain,
/* [3] */
Cut, noIcon, X, , plain,
/* [4] */
Copy, noIcon, C, , plain,
/* [5] */
Paste, noIcon, V, , plain,
/* [6] */
Clear, noIcon, , , plain
}
};
resource MENU (131, preload) {
131,
textMenuProc,
allEnabled,
enabled,
Special,
{ /* array: 3 elements */
/* [1] */
LookUp, noIcon, L, , plain,
/* [2] */
Confirm, noIcon, F, , plain,
/* [3] */
Send, noIcon, S, , plain
}
};