{
infusion bbs irc module, written by skaboy101.
}
{$I DIRECT.INC}
Unit InfuIrc;
Interface
Procedure DoInfusionIrc;
Implementation
Uses Dos, FileLock, Crt, Configrt, Gensubs, Gentypes, Subs1, Modem,
Windows, SubsOvr, Subs2, MailRet, Mainr2, MyComman, little;
Const MaxNodes = 20;
MaxBuffedStrs = 5;
NodeFile = 'FORUM.';
Colors : Array[0..10] of Byte = (15,11,9,12,13,14,8,10,7,5,4);
Type
ChatRec = Record
Node : Byte;
Case Code : Byte of
0 : (TxtStr : String[80];); {Regular User Inputed Line}
2 : (sendNumber,getNumber : byte;text : string[80]);{msg}
3 : (); {Current node has left chat}
4 : (); {Current node has entered chat}
5 : (NickName : String[15];); {Changed Nick Name}
End ;
Var
currentChannel : 0..999;
NodeInChat : Array[0..MaxNodes] Of Boolean;
Names : Array[0..MaxNodes] Of Mstr;
BufStr : Lstr;
BufArray : Array[1..MaxBuffedStrs] of String[80];
BufArrayPos : Byte;
ChatFile : File of ChatRec;
Chat : ChatRec;
FileMarker : Word;
DidName : Boolean;
ircDone : boolean;
msgText : string[80];
name : string[15];
nodeForMsg : byte;
Function lookUpNode(strbuff : string) : byte;
var x : byte;
found : boolean;
begin
strBuff := copy(strBuff,6,length(strBuff)-5);
if pos(' ',strBuff)<0 then
begin
multiColor('|CR|15:|07:|08: |08(|07(|15msg|07)|08) |03error, use /msg <username> <text> .. .');
lookUpNode := 0;
exit;
end;
name := copy(strBuff,1,pos(' ',strBuff)-1);
x := 0;
repeat
inc(x);
if upString(names[x]) = upString(name) then
begin
found := true;
lookUpNode := x;
end;
until (found=true) or (x>=cfg.totalNodes);
if not found or (name='') then begin
multiColor('|CR|15:|07:|08: |08(|07(|15msg|07)|08) |03error, user ('+name+') not found .. .');
lookUpNode := 0;
exit;
end;
msgText := copy(strBuff,pos(' ',strBuff)+1,length(strBuff)-length(name));
end;
Function iCoolStr(cTopChar : char;cHeader,cStr : string) : string;
begin
iCoolStr := '|08'+cTopChar+'|07'+cTopChar+'|15'+cTopChar+' |08(|07('+cHeader+'|07)|08) '+cStr+'|CR';
end;
Function Wrap(Var st : String; MaxLen : Byte) : String;
Var
Len : Byte;
Begin
Len := Byte(St[0]);
If Len <= MaxLen Then
Begin
Wrap := St;
St[0] := #0;
End
Else
Begin
While (St[Len] <> #32) AND (Len > 0) Do Dec(Len);
If Len = 0 Then Len := MaxLen + 1;
Wrap := Copy(St, 1, Len);
Delete(St, 1, Len);
End;
End;
Procedure SetNodeNames(Node : Byte);
Procedure CheckNode(N : Byte);
Var M : MultiNodeRec;
Begin
Seek(MNFile, N-1);
NRead(MNFile, M);
Names[N] := M.Name;
If Pos('irc channel', UpString(M.Status)) > 0 Then NodeInChat[N] := True
Else NodeInChat[N] := False;
End;
Var X : Byte;
Begin
OpenMNFile;
If Node = 0 then For X := 1 to FileSize(MNFile) Do CheckNode(X)
Else CheckNode(Node);
Close(MNFile);
End;
Function InitChatFile(case_ : boolean) : Boolean;
Var I : Byte;
Begin
if not case_ then
begin
multiColor(strng^.enter_Irc_Channel);inputBox(3);
currentChannel := stoi(inpt);
end;
if currentChannel > 999 then currentChannel := 999;
Assign(ChatFile, cfg.DataDir + NodeFile + strr(currentChannel));
ResetOrReWrite(ChatFile, SizeOf(ChatRec));
If NOT IsOpen(ChatFile) then
Begin
SendCr('■ Error opening forum datafile, tell sysop to increase FILES=## in config.sys');
Close(ChatFile);
I := IoResult;
InitChatFile := False;
Exit;
End;
Chat.Node := cfg.NodeNum;
Chat.Code := 4;
Seek(ChatFile, FileSize(ChatFile));
NWrite(ChatFile, Chat);
NodeInChat[cfg.NodeNum] := True;
UpdateNode('In irc channel '+strr(currentChannel)+'..','');
WriteLog(0,0,'Entered Irc channel #'+strr(currentChannel));
InitChatFile := True;
FileMarker := FileSize(ChatFile);
End;
Procedure DeActivateNodeChat;
Var
OnlyNode : Boolean;
X : Byte;
Begin
WriteLog(0,0,urec.handle+' left the forum');
Seek(ChatFile, FileSize(ChatFile));
Chat.Node := cfg.NodeNum;
Chat.Code := 3;
NWrite(ChatFile, Chat);
NodeInChat[cfg.NodeNum] := False;
FileMarker := FileSize(ChatFile);
OnlyNode := True;
UpdateNode('','');
For X := 0 to MaxNodes Do
If NodeInChat[X] Then OnlyNode := False;
If OnlyNode then
Begin
Reset(ChatFile);
If (FileSize(ChatFile) > FileMarker) then
Begin
Close(ChatFile);
Exit;
End;
Truncate(ChatFile);
Close(ChatFile);
End;
End;
Procedure iShowMOTD;
var cMotd : text;
cBufStr : string;
begin
if not exist(cfg.textfiledir+'MOTD.IRC') then
multiColor(iCoolStr(':','Motd','|07Notify operator, MOTD.IRC does not exist...')) else
begin
tassign(cMotd,cfg.textFileDir+'MOTD.IRC');
treset(cMotd);
repeat
treadln(cMotd,cBufStr);
multiColor('|08:|07:|15: '+cBufStr);
until eof(cMotd);
tclose(cMotd);
end;
end;
Procedure RightColor(Node : Byte; Str : String);
Begin
If WhereX <> 1 Then SendCr('');
if copy(str,1,5)='@ACT@' then
begin
multiColor('|08:|07:|15: |03'+names[node]+copy(str,6,length(str)-5));
end else
begin
if (node<>cfg.nodenum) then
begin
AnsiColor(URec.Color1);
multiColor('|03<');
AnsiColor(URec.Color3);
multiColor(Names[Node]+'|03> ');
AnsiColor(Colors[Node]);
SendStr(Str);
end else
begin
multiColor('|08: |03');
sendStr(str);
end;
end;
DidName := True;
End;
Procedure showWhois(handle : string);
var
uFile : file of userrec;
uShit : ^userRec;
begin
new(uShit);
assign(uFile,cfg.dataDir+'USERS');
reset(uFile);
seek(uFile,1);
repeat
read(uFile,uShit^);
until (upstring(uShit^.handle)=upString(handle)) or eof(uFile);
close(uFile);
if upString(uShit^.handle)<>upString(handle) then
begin
multiColor('|CR'+iCoolStr(':','whois',handle+' does not exist on this system.. |CR'));
end else
begin
multiColor('|CR|15/|07----------------------------------------------------|15\');
multiColor('|CR|15x h|07andle |07:|08: |15'+tab(uShit^.handle,38)+'x');
multiColor('|CR|15x r|07eal_name |07:|08: |15'+tab(uShit^.realName,38)+'x');
multiColor('|CR|15x u|07ser_note |07:|08: |15'+tab(uShit^.privateNote,38)+'x');
multiColor('|CR|15x a|07philz |07:|08: |15'+tab(uShit^.aphilz,38)+'x');
multiColor('|CR|15\|07----------------------------------------------------|15/|CR');
end;
dispose(uShit);
end;
Procedure WriteChatStr(Str : String);
Var
I : Byte;
tempfile : text;
tempstr : string;
Begin
Chat.Node := cfg.NodeNum;
Chat.Code := 0;
Seek(ChatFile, FileSize(ChatFile));
If BufArrayPos > 0 then
Begin
For I := 1 to BufArrayPos Do
Begin
Chat.TxtStr := BufArray[I];
{ NWrite(ChatFile, Chat);}
BufArray[I] := '';
End;
BufArrayPos := 0;
End;
If Str <> '' then
Begin
if upString(str)='/LIST' then
begin
Node_Listing;
SendStr(#13#10);
end else
if upString(copy(str,1,4))='/MSG' then
begin
nodeForMsg := lookUpNode(str);
if (nodeForMsg>0) and (names[nodeForMsg]<>'') then
begin
chat.code := 2;
chat.sendNumber := cfg.nodeNum;
chat.getNumber := lookUpNode(str);
chat.text := msgText;
NWrite(ChatFile, Chat);
multiColor('|CR|15:|07:|08: |08(|07(|15'+names[chat.getNumber]+'|07)|08) |03'+msgText);
name := '';
end else
multiColor('|CR|15:|07:|08: |08(|07(|15msg|07)|08) |03error, use /msg <username> <text> .. .');
end else
if upString(str)='/IMU' then
begin
Send_Node_Message(False);
end else
if upString(copy(str,1,5))='/JOIN' then
begin
if (str[7]<>'#') then multiColor('|CR|08:|07:|15: |07(|08(|15join|08)|07)|03 must specify with # directive .. ') else
begin
currentChannel := stoi(copy(str,8,length(str)-7));
initChatFile(true);
end;
end else
if upString(str)='/QUIT' then
begin
ircDone := true;
chat.code := 3;
end else
if upString(str)='/CLEAR' then
ansiCls else
if upString(str)='/HELP' then
begin
if not exist(cfg.textfileDir+'HELP.IRC') then
multicolor('|CR|07h|15elp file doesnt exist, contact operator ... |CR')
else begin
tassign(tempFile,cfg.textFileDir+'HELP.IRC');
treset(tempFile);
repeat
tReadLn(tempFile,tempStr);
multiColor(tempStr);
until eof(tempFile);
tClose(tempFile);
end;
end else
if upString(copy(str,1,6))='/WHOIS' then
begin
showWhois(copy(str,8,length(str)-7));
end else
if upString(copy(str,1,3)) = '/ME' then
begin
str := '@ACT@'+copy(str,4,length(Str)-3);
Chat.TxtStr := Str;
NWrite(ChatFile, Chat);
end else
if upString(copy(str,1,5))='/NICK' then
begin
chat.code := 5;
chat.nickName := copy(str,7,length(str)-6);
nWrite(chatFile,chat);
end else
if upString(str)='/MOTD' then
iShowMotd else
if str[1] = '/' then multiColor('|CR|15:|07:|08: |15(|07(|03command error|07)|15) |07invalid command, type |03/help'+
'|07 for listing ..');
end;
if (str[1] <> '/') and (chat.code=0) then begin
if copy(str,1,5)='@ACT@' then
begin
rightColor(cfg.nodeNum, str);
end else
begin
multiColor('|CR|09<|11'+names[cfg.nodeNum]+'|09> ');ansiColor(colors[cfg.nodeNum]);
sendFull(str);
Chat.TxtStr := Str;
NWrite(ChatFile, Chat);
end;
end else
if (str[1] = '/') and (chat.code<>0) then begin
if chat.code = 3 then multicolor('|CR|15:|07:|08: |15(|07(|03part|07)|15) |07'+names[chat.node]+' has left us .. ');
Chat.TxtStr := Str;
NWrite(ChatFile, Chat);
end;
End;
{:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Procedure PerformNodeChat;
Var
I : Byte;
K : Char;
TempStr : String;
Procedure WriteOut;
Begin
Chat.TxtStr := BufStr;
Chat.Code := 0;
WriteChatStr(Chat.TxtStr);
BufStr := '';
SendCr('');
DidName := False;
End;
Begin
Chat.Code := 0;
Chat.Node := cfg.NodeNum;
Chat.TxtStr := '';
AnsiCls;
multiColor(iCoolStr(':','Load','|15Initializing Infusion_IRC...'));
multiColor(iCoolStr(':','Load','|07infuIRC v1.1a2r2.test03 now loaded...'));
iShowMOTD;
multiColor(iCoolStr(':','Help','|07Type /help for command help...'));
SendCr('');
DidName := False;
Repeat
NoBreak := True;
If (FileSize(ChatFile) > FileMarker) then
Begin {1}
Seek(ChatFile, FileMarker);
While Not EOF(ChatFile) Do
Begin {2}
NRead(ChatFile, Chat);
Inc(FileMarker);
Case Chat.Code of {3}
0 : If Chat.Node <> cfg.NodeNum Then {4}
If WhereX <> 1 then
Begin
While WhereX <> 1 Do SendStr(^H#32^H);
RightColor(Chat.Node, Chat.TxtStr+#13#10);
RightColor(cfg.NodeNum, BufStr);
End
Else
Begin
RightColor(Chat.Node, Chat.TxtStr+#13#10);
DidName := False;
End;
2 : begin
if chat.getNumber = cfg.nodeNum then
multiColor('|CR|15:|07:|08: |08(|07(|15msg|03/|15'+names[chat.sendNumber]+'|07)|08) |03'+chat.text+'|CR');
end;
3 : Begin {4}
If WhereX <> 1 then
Begin
While WhereX <> 1 Do SendStr(^H#32^H);
multicolor(iCoolStr(':','Part',names[chat.node]+' is outta here .. |CR'));
RightColor(cfg.NodeNum, BufStr);
End
Else
Begin
multicolor('|CR'+iCoolStr(':','Part',names[chat.node]+' is outta here .. |CR'));
DidName := False;
End;
Names[Chat.Node] := '';
NodeInChat[Chat.Node] := False;
End; {3}
5 : begin
if pos('/NICK',upString(chat.nickName))>0 then
chat.nickname := copy(chat.nickName,pos('/NICK',upString(chat.nickName))+6,length(chat.nickname)-5);
names[chat.node] := chat.nickName;
end;
4 : Begin {4}
SetNodeNames(Chat.Node);
If WhereX <> 1 then
Begin
While WhereX <> 1 Do SendStr(^H#32^H);
multiColor('|CR|15:|07:|08: |07(|08(|15join|08)|07) |03'+names[chat.node]+' has joined channel #'+strr(currentChannel)+'|CR');
RightColor(cfg.NodeNum, BufStr);
End
Else
Begin
multiColor('|CR|15:|07:|08: |07(|08(|15join|08)|07) |03'+names[chat.node]+' has joined channel #'+strr(currentChannel)+'|CR');
DidName := False;
End;
End; {3}
End;
End; {1}
End; {0}
If CharReady Then
Begin
K := WaitForChar(True);
Case K Of {2}
^M : begin
if (bufStr<>'') then
begin
WriteOut;
end;
end;
^H : If BufStr <> '' Then
Begin {3}
Dec(BufStr[0]);
SendStr(^H#32^H);
End; {2}
^A..^Z:;
Else
Begin {3}
If ((Length(BufStr)+1) > (76 - (Length(Urec.Handle)))) Then
Begin {4}
BufStr := BufStr+K;
Inc(BufArrayPos);
BufArray[BufArrayPos] := Wrap(BufStr, (80 - (Length(Urec.Handle)+4)) );
For I := 1 to Length(BufStr) Do SendStr(^H#32^H);
SendCr('');
RightColor(cfg.NodeNum, BufStr);
WriteChatStr('');
End {3}
Else
Begin {4}
If ((Length(BufStr) = 0) and (NOT DidName)) then
RightColor(cfg.NodeNum, K) Else DirectOutChar(K);
BufStr := BufStr+K;
End; {3}
End; {2}
End; {1}
End; {0}
TimeSlice;
Until (ircDone=true) or (HungUpOn);
End;
{:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::}
Procedure DoInfusionIrc;
Begin
FillChar(NodeInChat, SizeOf(NodeInChat),0);
FillChar(Names, SizeOf(Names),0);
SetNodeNames(0);
FillChar(BufStr, SizeOf(BufStr), 0);
FillChar(BufArray, Sizeof(BufArray), 0);
BufArrayPos := 0;
If Not InitChatFile(false) then Exit;
PerformNodeChat;
DeActivateNodeChat;
ClearChain;
ircDone := false;
End;
Begin
End.