*$USEFUNCS
*$INCLUDE:FIDO.LIB
*$INCLUDE:BREAL.LIB
declare procedure GetConference(integer conf, var string Name, var byte Type, var int Security, var string msgfilename)
declare procedure GetConfTypeNames()
declare procedure ShowPage(int buffer)
declare function ReadBuffer(int buffer, int startConf) int
declare function ReadBufferPrev(int Buffer, int StartConf) int
declare function FindLast(int StartConf) int
declare function FindLast2(int StartConf) int
declare function FindFirstConf(int LastConf) int
declare procedure SetLightBar(int Buffer,int Line)
declare procedure DeleteLightBar(int Buffer, int Line)
declare procedure LightBar(int Buffer, int Line)
declare procedure ShowWait(int Line)
declare procedure GetConfig()
int poscount(9)
string Cwait, Cnum, Ctyp, CbarY, CbarN, CconfY, CconfN, Chighmail, Cactmail, Clastmail
int StartConflineX, StartConfLineY, StartStatus, startXhigh, startYhigh
int startXact, startYact, SnumX, SnumY, StypX, StypY, startXlast, startYlast
string confname(1)
string ReqSec(1)
Byte ConfType(1)
string MsgFile(1)
int confNumber(1)
string ConfTypeNames(6)
string Leer
int chan1, chan2, recordLen
int PageLen
int curLine
int allowShow, allowHIGH, allowACT, allowFIDO, allowCONFtyp, allowLAST
int IdleTime
int usesAnsi
STRING VERSION
; Fido Compatible Nets
int anzFidoComp
string adConfName(1)
int adConfBegin(1)
int adConfEnd(1)
begin
version = "2.21"
wrunet PCBNODE(),"Q",UN_NAME(),UN_CITY(),"Using: @X0FPOBJOIN " + version," "
LOG "### using POBJOIN.PPE ver. " + STRING(version) + " ###", false
int areas
int curRead
int curReadPos
int curPos
int curFidoReadPos
int i
int idle
unsigned bnum, bnum1
string line, line1, line2
int length, lenConfTyp
int chan3
integer conf
string cnamePath
string input
string jconf
allowShow = true
allowHIGH = true
allowACT = true
allowFIDO = true
allowCONFtyp = true
if (ansion() = FALSE) then
join ""
end
endif
if (grafmode() = "G") then
usesAnsi = TRUE
else
usesAnsi = FALSE
endif
int test
if (tokcount() > 0) then
jconf = tokenstr()
goto joincnf
endif
:anfang
GetConfig()
; PageLen = NumConfLines
cls
print "@X08POB(@X0Ac@X08)1995 POBJOIN [PPE3] coded by Reinhard Schuerer & Rainer Lindner@X8F * Wait *"
curFidoReadPos = 0
if (allowFIDO = true) then
areas = getFidoCFG()
endif
getuser
redim ConfName, PageLen * 3
redim ReqSec, PageLen * 3
redim ConfType, PageLen * 3
redim MsgFile, PageLen * 3
redim ConfNumber, PageLen * 3
Leer = " "
cnamePath = getCNamePath()
GetConfTypeNames()
; Channel fuer Msg-File reservieren
chan1 = fnext()
if (chan1 = -1) then
println "Kein File Handle frei"
goto error
endif
fopen chan1, cnamePath + ".@@@", O_RD, S_DN
if (ferr(chan1)) then
print "Konnte cnames.@@@ nicht oeffnen"
goto error
endif
fread chan1, recordLen, 2
chan2 = fnext()
if (chan2 = -1) then
println "Kein File Handle frei"
goto error1
endif
fopen chan2, cnamePath + ".ADD", O_RD, S_DN
if (ferr(chan2)) then
println "Konnte cnames.add nicht oeffnen"
goto error1
endif
chan3 = fnext()
if (chan3 = -1) then
println "Kein File Handle frei"
goto error2
endif
cls
dispfile ppepath()+ppename(), 1+2+4
ansipos 54,23
print "@X08POBJOIN ", version, " - POB(@X0Ac@X08)1995"
input = ""
conf = 1
curRead = 1
curReadPos = 1
curLine = 1
idle = 0
ShowWait(curLine)
curPos = readBuffer(0, curConf())
ShowPage(0)
while ((input <> chr(27)) & (input <> chr(13))) do
if ((input >= "0") & (input <= "9") & (poscount(input) >= 0)) then
curPos = poscount(input)
ShowWait(curLine)
curLine = 1
curPos = ReadBuffer(0, curPos)
ShowPage(0)
endif
if (( upper(input) >= "A") & ( upper(input) <= "Z")) then
endif
if (input <> "") idle = 0
select case (input)
case ""
; read fido cfg records
if (allowFIDO = false) then
elseif (areas > curFidoReadPos) then
ReadFidoEntry()
curFidoReadPos = curFidoReadPos + 1;
if (curFidoReadPos = areas) fclose fidoChan
endif
if (idle < IdleTime) idle = idle + 1
if (idle = IdleTime) then
idle = IdleTime + 1
if (ferr(chan3)) goto cont1
fopen chan3, MsgFile(curLine - 1), O_RD, S_DN
if (ferr(chan3)) goto cont1
if (allowHIGH = true) then
fseek chan3, 0, SEEK_SET
fread chan3, bnum, 4
line = breal2unsigned(bnum)
ansipos startXhigh, startYhigh
length = len(line)
line = line + left(Leer, 5 - length)
print Chighmail, line
endif
if (allowACT = true) then
fseek chan3, 8, SEEK_SET
fread chan3, bnum1, 4
line1 = breal2unsigned(bnum1)
ansipos startXact, startYact
length = len(line1)
line1 = line1 + left(Leer, 5 - length)
print Cactmail, line1
endif
fclose chan3
if (allowLAST = true) then
ansipos startXlast,startYlast
line2 = U_LMR(confnumber(curline - 1))
length = len(line2)
line2 = line2 + left(Leer, 5 - length)
print Clastmail, line2
endif
ansipos 1,23
endif
:cont1
; ; read net conference vom cnames
; if (curRead <= hiconfnum()) then
; getConference(chan1, chan2, recordLen, curRead, confname(curReadPos), conftype(curReadPos), reqsec(curReadPos), msgfile(curReadPos))
; if (ConfName(curReadPos) <> "") curReadPos = curReadPos + 1
; curRead = curRead + 1
; endif
case "UP"
if ((curLine > 1) & (confname(curLine - 2) <> "")) then
deleteLightBar(0, curLine)
curLine = curLine - 1
setLightBar(0, curLine)
else
ShowWait(curLine)
curPos = ReadBufferPrev(0, curPos - 1)
curLine = PageLen
ShowPage(0)
endif
case "DOWN"
if ((curLine < PageLen) & (confname(curLine) <> "")) then
deleteLightBar(0, curLine)
curLine = curLine + 1
setLightBar(0, curLine)
else
if (curPos < hiconfnum() - PageLen) then
ShowWait(curLine)
curPos = FindLast(curPos)
curPos = ReadBuffer(0, curPos)
curLine = 1
ShowPage(0)
endif
endif
case "RIGHT","PGDN"
if (curPos < hiconfnum() - PageLen) then
ShowWait(curLine)
curPos = FindLast(curPos)
curPos = ReadBuffer(0, curPos)
ShowPage(0)
endif
case "LEFT","PGUP"
ShowWait(curLine)
curPos = ReadBufferPrev(0, curPos - 1)
ShowPage(0)
case "HOME"
ShowWait(curLine)
curLine = 1
curPos = ReadBuffer(0, 0)
ShowPage(0)
case "END"
ShowWait(curLine)
curPos = FindFirstConf(hiconfnum()) + 1
curPos = ReadBuffer(0, curPos)
Showpage(0)
end select
input = inkey()
if ((input = chr(13)) & (reqsec(curLine-1) > u_sec)) input = ""
endwhile
cls
jconf = confnumber(curLine - 1)
if (input <> chr(13)) then
kbdstuff chr(13)
else
:joincnf
kbdstuff chr(13)
join jconf
tokenize jconf
conf = gettoken()
if (curconf() <> conf) goto anfang
wrunet PCBNODE(),"A",UN_NAME(),UN_CITY()," "," "
endif
:skip
:error2
fclose chan2
:error1
fclose chan1
:error
wrunet PCBNODE(),"A",UN_NAME(),UN_CITY()," "," "
END
procedure GetConference(integer conf, var string Name, var byte Type, var int Security, var string msgfilename)
string confname1
string confname2
fseek chan1, conf * recordLen + 2, SEEK_SET
fseek chan2, conf * 256 + 127, SEEK_SET
fread chan2, Type, 1
fseek chan2, 80, SEEK_CUR
fread chan1, confname1, 14
fseek chan1, 6, SEEK_CUR
fread chan1, Security, 2
fseek chan1, 5, SEEK_CUR
fread chan1, msgfilename, 32
fread chan2, confname2, 48
Name = confname1 + confname2
if ((allowShow = false) & (Security > u_sec)) Name = ""
endproc
procedure GetConfTypeNames()
int chan
int i
chan = fnext()
fopen chan, ppepath()+ppename()+".ctn", O_RD, S_DN
for i = 0 to 5
fget chan, ConfTypeNames(i)
next
fclose chan
endproc
procedure ShowPage(int buffer)
int y
int pos
int length
string line
for y=StartConfLineY to (StartConfLineY + PageLen -1)
pos = y-StartConfLineY + buffer * PageLen
line = " " + confname(pos)
length = len(line)
line = line + left(Leer, 61 - length)
ansipos StartConfLineX - 1,y
if (reqsec(pos) > u_sec) then
print CconfN
else
print CconfY
endif
print line
next
SetLightBar(0, CurLine)
endproc
function ReadBuffer(int Buffer, int StartConf) int
int read
int newpos;
int conf
read = 0
int pos
pos = Buffer * PageLen
conf = StartConf
while ((conf < hiconfnum()) & (read < PageLen)) do
getConference(conf, confname(read + pos), conftype(read + pos), reqsec(read + pos), msgfile(read + pos))
confnumber(read + pos) = conf
if (ConfName(read + pos) <> "") read = read + 1
conf = conf + 1
endwhile
if (read < PageLen) then
newpos = findFirstConf(conf) + 1
if (newpos < StartConf) then
StartConf = ReadBuffer(buffer, newpos)
else
while (read < PageLen) do
ConfName(pos + read) = ""
read = read + 1
endwhile
endif
endif
ReadBuffer = StartConf
endfunc
function ReadBufferPrev(int Buffer, int StartConf) int
int read
int conf
read = 0
int pos
pos = (Buffer + 1) * PageLen - 1
conf = StartConf
while ((conf >= 0) & (read < PageLen)) do
getConference(conf, confname(pos - read), conftype(pos - read), reqsec(pos - read), msgfile(pos - read))
confnumber(pos - read) = conf
if (ConfName(pos - read) <> "") read = read + 1
conf = conf - 1
endwhile
conf = conf + 1
if (read < PageLen) then
ReadBufferPrev = ReadBuffer(buffer, 0)
else
ReadBufferPrev = conf
endif
endfunc
function FindLast(int StartConf) int
int read
int conf
read = 0
string dummy, dummy3
int dummy2
conf = StartConf
while ((conf < hiconfnum()) & (read < PageLen)) do
getConference(conf, dummy, dummy2, dummy2, dummy3)
if (dummy <> "") read = read + 1
conf = conf + 1
endwhile
FindLast = conf
endfunc
function FindLast2(int StartConf) int
int read
int conf
read = 0
string dummy, dummy3
int dummy2
conf = StartConf
while ((conf < hiconfnum()) & (read =< PageLen)) do
getConference(conf, dummy, dummy2, dummy2, dummy3)
if (dummy <> "") read = read + 1
conf = conf + 1
endwhile
FindLast = conf
endfunc
function FindFirstConf(int LastConf) int
int read
int conf
read = 0
string dummy, dummy3
int dummy2
conf = LastConf
while ((conf >= 0) & (read < PageLen)) do
getConference(conf, dummy, dummy2, dummy2, dummy3)
if (dummy <> "") read = read + 1
conf = conf - 1
endwhile
FindFirstConf = conf
endfunc
procedure LightBar(int buffer, int zeile)
int y, i
int pos
int length
string line
pos = buffer * PageLen + zeile - 1
y = StartConfLineY + zeile - 1
line = confname(pos)
length = len(line)
line = line + left(Leer, 60 - length)
ansipos StartConflineX,y
print line
line = confnumber(pos)
length = len(line)
line = line + left(Leer, 4 - length)
ansipos SnumX, SnumY
print Cnum, line
if (allowCONFtyp = true) then
line = ConfTypeNames(conftype(pos))
if ((confType(pos) = 5) & (allowFIDO = true)) then
line = line + " " + "[" + fidoareaname(confnumber(pos)) + "]"
for i = 1 to anzFidoComp
if ((confnumber(pos) >= adConfBegin(i)) & (confnumber(pos) <= adConfEnd(i))) then
line = adConfName(i) + " [" + fidoareaname(confnumber(pos)) + "]"
endif
next
endif
length = len(line)
line = line + left(Leer, lenConfTyp - length)
ansipos StypX, StypY
print Ctyp, line
endif
endproc
procedure SetLightBar(int Buffer, int zeile)
if (reqsec(zeile - 1 + Buffer * PageLen) > u_sec) then
if (usesAnsi = TRUE) then
print CbarN
else
ansipos StartConfLineX - 1, StartConfLineY + zeile - 1
print "<"
endif
else
if (usesAnsi = TRUE) then
print CbarY
else
ansipos StartConfLineX - 1, StartConfLineY + zeile - 1
print ">"
endif
endif
LightBar(buffer, zeile)
print CconfY
endproc
procedure DeleteLightBar(int Buffer, int zeile)
if (usesAnsi = TRUE) then
if (reqsec(zeile - 1 + Buffer * PageLen) > u_sec) then
print CconfN
else
print CconfY
endif
else
ansipos StartConfLineX - 1, StartConfLineY + zeile - 1
print " "
endif
LightBar(buffer, zeile)
endproc
procedure ShowWait(int Zeile)
print Cwait
ansipos StartConfLineX + 52, StartConflineY + zeile - 1
print "* Wait *"
print CconfY
endproc
procedure GetConfig()
int chan
string confline
chan = fnext()
fopen chan, ppepath()+ppename()+".cfg", O_RD, S_DN
if (!ferr(chan)) then
fget chan, allowShow
fget chan, Cnum
fget chan, Ctyp
fget chan, CbarY
fget chan, CconfY
fget chan, CbarN
fget chan, CconfN
fget chan, Chighmail
fget chan, Cactmail
fget chan, Clastmail
fget chan, PageLen
fget chan, StartConfLineX
fget chan, StartConfLineY
fget chan, SnumX
fget chan, SnumY
fget chan, StypX
fget chan, StypY
fget chan, startXhigh
fget chan, startYhigh
fget chan, startXact
fget chan, startYact
fget chan, startXlast
fget chan, startYlast
fget chan, allowHIGH
fget chan, allowACT
fget chan, allowFIDO
fget chan, allowCONFtyp
fget chan, allowLAST
for i=0 to 9
fget chan, poscount(i)
next i
fget chan, Cwait
fget chan, IdleTime
fget chan, lenConfTyp
fget chan, anzFidoComp
redim adConfName, anzFidoComp
redim adConfBegin, anzFidoComp
redim adConfEnd, anzFidoComp
for i = 1 to anzFidoComp
fget chan, adConfName (i)
fget chan, adConfBegin(i)
fget chan, adConfEnd(i)
next
fclose chan
endif
endproc
