'===========================================================================
' Subject: RETRIEVE CURRENT SEGMENT           Date: 08-14-98 (18:00)       
'  Author: Sten Daniel Soersdal               Code: QB, PDS                
'  Origin: prinz@mailexcite.com             Packet: MEMORY.ABC
'===========================================================================
'
' Havnt you ever wondered about what secrets lurk under that
' little interpreter/compiler engine called QuickBASIC ?
'
' As every little programmer knows, information saves time.
' And every once in a while sometimes you really need that
' little piece of info to finish that project.
' Well i studied the quick libraries and libraries which are
' used in all QB programs, and i found out that alot of
' QB's internal "variables" are fully accessable by user
' assembly routines. I can give you a little preview of the
' information i soon will fully release.
'
' This information is strictly for informational purposes only,
' I (the author) take no responsibility for the information herein.
'
'
' Snack:
'       Havnt you ever wanted a way to get the current segment
'       defined by 'DEF SEG' ? I know alot of subs out there have had
'       to clear the current defined segment so they could do their stuff.
'       And that is really sad...
'
' Well here is the stuff.. (Remember QB45 only, not QBasic 1.1)
'
' 1.  First extract this little object file.
' 2.  LIB Whatevr.lib -+bastard.obj;
' 3.  LINK whatevr.LIB, whatevr.QLB, NUL, <qb45 path>\LIB\BQLB45.LIB /Q;
' 4.  QB prinz.bas /L whatevr
' 5.  DECLARE FUNCTION GetSeg%
'
' Then you might test the routine with this.
'
' DEF SEG=&HB800
' A%=GetSeg%
' PRINT HEX$(A%)
'
' Now the program should output 'B800', Voila ! 
' Please note that the .OBJ file could be added to any .LIB and .QLB file
'
' Greetings to: William Yu - I love your ABC, btw, my reader is soon to
'                            be released, i did an all asm thing.
'                            I cant help it, i love efficiency and SPEED !
'               Class      - Long time no see, havnt seen you on IRC for
'                            a looong time, please contact me ! (email)
'               Question   - Call me, ill love to write that multitasking
'                            routine for your new kernel to Linux(edu. reasons) 
' 
'>>> Page 1 of BASTARD.OBJ begins here. TYPE:BINAA TLEN:160
DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2
SUB V1:OPEN "O",1,"BASTARD.OBJ",4^6:Z&=160:?STRING$(50,177);
U"&O2%0M10BC20A3S20B<=&eP%%%1gfx%yfwiA.yj'.y).g#xx*.%ifyf%+ilw%tz
U"u)%ifyf%)hti4j*g,%%m)%%',&0&g,%m%%%)+.&3g,%%m%%%(+&4&i+%*9x'x()
U"'[-%%*gIx%jl%G&_2%%%&+lj%yxjl#%%%l&W)%%Sq&Jo%-%&%(%p%%6Ddk++%=&
U";I&&PY#'%%C
END SUB
CLOSE:IF S=230AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!
SUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32
IF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1
S=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUB