hi can someone translate the source for pb 4 ?
i tried it but it doesnt work i dont get any events after i am connected to the server:
;Declarations
Declare CheckDccEvents(DCCEvent,idx,param1$)
Declare CheckForIdentReq()
Declare CheckIrcEvents(TotalEvents)
Declare ConnectIrc(IrcServer$,Port$,nick$,FullName$,Email$,ident$,rs.b)
Declare ConvertIP(ll,encip$)
Declare DCCChatAccept(sis)
Declare DCCClear(idx)
Declare DCCFileAccept(sis,resumefile)
Declare DCCFileProgress(fnum,curpos,totalpos)
Declare DCCRefuse(sis)
Declare DCCSearchIndex(filename$,idx)
Declare DCCSend(filename$,ToNick$,res)
Declare ExtractHostInfo(host$,nick$,ident$,hostip$)
Declare GetFreeDCCSlot(idx)
Declare InitIdent()
Declare InitIRC()
Declare ProcessIrcEvent(E$,evid,host$,param1$,param2$,ch$,msg$,sis)
Declare ResetConnection()
Declare SendIRC(dta$)
Declare SplitIntoArguments(E$)
#IrcOnline=1:#PrivMessage=2:#JoinChannel=3:#Notice=4:#TopicSetBy=5:#BanlistLine=6:#ChannelNames=7
#Mode=8:#ChannelCreateDate=9:#UserLeftIRC=10:#KickedFromChannel=11:#PartChannel=12:#TopicChange=12
#NickChange=14:#DCCSendRequest=15:#DCCChatRequest=16:#BannedFromChannel=20:#NeedChannelKey=21
#InviteOnly=22:#RegisteredOnly=23:#ChannelFull=24:#NickInUse=25:#ChannelInvite=26
#IRCERROR=-1:#DCCFileReceivedComplete=1:#DCCTextReceived=3:#DCCTimeout=10
Structure connectioninfo
Nick.s
Hostname.s
Servername.s
Realname.s
state.b
cid.l
Ident.s
Server.s
Modes.s
IdentReq.b
ServerTimeSync.l
Login.s
EndStructure
Structure dcctrans
Type.b
state.b
cnid.l
remotehost.s
remoteport.l
File.s
filepos.l
filesize.l
Nick.s
Timeout.l
LastTimeout.l
EndStructure
Global IrcBuffer$,IdentEnable.b,CrLF$,Filepath$,DCCPort.l,DCCIP$,DCCSendSize.l,MaxDCCSlots,IrcServerOnline.b
Global DebugSent.b,DebugRcv.b,DCCTimeout
Global Dim ConnInfo.connectioninfo(1) ;Connection information
Global Dim Events$(256) ;Events buffer, the amount shouldn't exceed 20 unless there is major server lag
Global Dim Arg$(50) ;This is used to split arguments from a received line from server
Global Dim DCCInfo.dcctrans(0) ;Number of DCC slots, will be reGlobal Dimensioned on irc connection based on MaxDCCSlots
Global Dim Byte1.l(5)
CrLF$=Chr(13)+Chr(10)
;IRC Functions
Procedure InitIRC()
nn=InitNetwork():If nn=0 : MessageRequester("Error,","Can't initialize TCP/IP", 0) : End: EndIf ;Initialize Network
ExamineIPAddresses()
Repeat
rr=NextIPAddress()
If rr:a$=IPString(rr):EndIf
If Mid(a$,1,7)<>"192.168" And Mid(a$,1,7)<>"0.0.0.0":DCCIP$=a$:EndIf
Until rr=0
EndProcedure
Procedure SendIRC(dta$)
If ConnInfo(0)\cid
If DebugSent=#True:Debug "--> "+dta$:EndIf
dta$=dta$+Chr(13)+Chr(10)
rr = SendNetworkData(ConnInfo(0)\cid, @dta$, Len(dta$))
Else
If DebugRcv=#True:Debug "** Not connected to IRC server **":EndIf
EndIf
EndProcedure
Procedure ircjoin(Channel.s)
SendIRC("JOIN "+Channel+Chr(13)+Chr(10))
EndProcedure
Procedure IRCLeave(Channel.s)
SendIRC("PART "+Channel+Chr(13)+Chr(10))
EndProcedure
Procedure IRCChangeNick(Name.s)
SendIRC("NICK "+ReplaceString(Name, " ", "_")+Chr(13)+Chr(10))
EndProcedure
Procedure IRCSendText(Channel.s, Text.s)
SendIRC("PRIVMSG "+Channel+" :"+Text+Chr(13)+Chr(10))
EndProcedure
Procedure CheckForIdentReq()
If ConnInfo(0)\state>2
If IdentEnable
nn=NetworkServerEvent()
If nn
cnid=EventClient()
Select nn
Case 2 ;DATA ARRIVAL
dta$=Space(2048):ll=ReceiveNetworkData(cnid,@dta$,2048)
If ll>2:dta$=Mid(dta$,1,ll-2):a$=dta$+" : USERID : UNIX : "+ConnInfo(0)\Ident+Chr(13)+Chr(10):EndIf
rr = SendNetworkData(cnid, @a$, Len(a$))
EndSelect
EndIf
EndIf
EndIf
EndProcedure
Procedure InitIdent()
rr=CreateNetworkServer(0,113):If rr=0:IdentEnable=0:EndIf
EndProcedure
Procedure ConnectIrc(IrcServer$,Port$,nick$,FullName$,Email$,ident$,rs.b)
Global Dim DCCInfo.dcctrans(MaxDCCSlots+1)
ConnInfo(0)\state=1:If IdentEnable:InitIdent():EndIf
ConnInfo(0)\Nick=nick$:ConnInfo(0)\Hostname=Email$:ConnInfo(0)\Servername="127.0.0.1":ConnInfo(0)\Realname=FullName$:ConnInfo(0)\Ident=ident$
ConnInfo(0)\Login="USER "+ConnInfo(0)\Nick+" "+Chr(34)+ ConnInfo(0)\Hostname+Chr(34)+" "+Chr(34)+"127.0.0.1"+Chr(34)+" :"+ConnInfo(0)\Realname
ConnInfo(0)\cid= OpenNetworkConnection(IrcServer$, Val(Port$))
If ConnInfo(0)\cid
ConnInfo(0)\state=2
SendIRC("NICK "+ConnInfo(0)\Nick)
Else
If DebugRcv=#True:Debug "** Could not open "+IrcServer$+":"+Port$:EndIf
ConnInfo(0)\state=0
EndIf
rs=ConnInfo(0)\cid
EndProcedure
Procedure ResetConnection()
If ConnInfo(0)\cid:res=CloseNetworkConnection(ConnInfo(0)\cid):EndIf
ConnInfo(0)\state=0:ConnInfo(0)\cid=0:IrcBuffer$=""
EndProcedure
Procedure CheckIrcEvents(TotalEvents)
TotalEvents=0
If ConnInfo(0)\state<2:ProcedureReturn:EndIf
nn=NetworkClientEvent(ConnInfo(0)\cid)
Select nn
Case 1
Case 2 ;Data arrival from server, lets retrieve it
readmoredata:
dta$=Space(2048):ll=ReceiveNetworkData(ConnInfo(0)\cid,@dta$,2048):IrcBuffer$=IrcBuffer$+Mid(dta$,1,ll)
If ll=2048:Goto readmoredata:EndIf ;This indicates there are more to read if len is same size as the buffer retrieved
Case 5
MessageRequester("","")
EndSelect
If ConnInfo(0)\state=2:ConnInfo(0)\state=3:SendIRC(ConnInfo(0)\Login):EndIf ;Once connected, send login string (nick/email etc...)
;Checking & parsing received lines sent from server
If IrcBuffer$="":ProcedureReturn:EndIf
TotalEvents=0
Repeat
xx=FindString(IrcBuffer$,Chr(13)+Chr(10),1)
If xx
ln$=Mid(IrcBuffer$,1,xx-1)
IrcBuffer$=Mid(IrcBuffer$,xx+2,Len(IrcBuffer$)-xx-1)
If DebugRcv=#True:Debug ln$:EndIf
If UCase(Mid(ln$,1,4))="PING":SendIRC("PONG"+Mid(ln$,5,Len(ln$)-4)):EndIf ;PING encountered, send PONG to server to keep the connection alive
TotalEvents=TotalEvents+1:Events$(TotalEvents)=ln$
EndIf
If UCase(Mid(ln$,1,5))="ERROR":ResetConnection():evid=-1:ProcedureReturn:EndIf
Until xx=0
EndProcedure
Procedure SplitIntoArguments(E$)
ee$=Trim(e$):Ttl=0
Repeat
xx=FindString(ee$," ",1)
If xx:Ttl=Ttl+1:Arg$(Ttl)=Mid(ee$,1,xx-1):ee$=Mid(ee$,xx+1,Len(ee$)-xx):ee$=Trim(ee$):EndIf
Until xx=0 Or Ttl=15
If Trim(ee$)<>"":Arg$(Ttl+1)=Trim(ee$):EndIf
EndProcedure
Procedure ExtractHostInfo(host$,nick$,ident$,hostip$)
xx=FindString(host$,"!",1)
If xx
nick$=Mid(host$,1,xx-1):host$=Mid(host$,xx+1,Len(host$)-xx)
xx=FindString(host$,"@",1):If xx:ident$=Mid(host$,1,xx-1):hostip$=Mid(host$,xx+1,Len(host$)-xx):EndIf
EndIf
EndProcedure
Procedure ProcessIrcEvent(E$,evid,host$,param1$,param2$,ch$,msg$,sis)
Shared nick$,idx,encip$
SplitIntoArguments(E$)
evid=0:sis=0:host$=Mid(Arg$(1),2,Len(Arg$(1))-1):param1$=Arg$(3):msg$=""
xx=FindString(E$,":",2)
If xx
msg$=Mid(E$,xx+1,Len(E$)-xx) ;Retrieve text msg/notices sent by server
EndIf
If UCase(Mid(E$,1,5))="ERROR":evid=-1:ProcedureReturn:EndIf
If FindString(Arg$(1),"!",1):host$=Mid(Arg$(1),2,Len(Arg$(1))-1):EndIf
If Mid(param1$,1,1)=":":param1$=Mid(param1$,2,Len(param1$)-1):EndIf
Select UCase(Arg$(2))
Case "366":sis=0: Case "368":sis=0
Case "001": ConnInfo(0)\Nick=Arg$(3):ConnInfo(0)\Server=Mid(Arg$(1),2,Len(Arg$(1)))
Case "255": evid=1
Case "PRIVMSG": evid=2:sis=0
ExtractHostInfo(host$,nick$,ident$,hostip$)
If UCase(Mid(msg$,1,9))=Chr(1)+"DCC SEND"
SplitIntoArguments(msg$)
ll=Val(Arg$(4))
ConvertIP(ll,encip$)
param1$=Arg$(5):param2$=Arg$(3):msg$=Arg$(6)
flen=FileSize(Filepath$+param2$):If flen<1:flen=0:EndIf
GetFreeDCCSlot(idx)
If idx
DCCInfo(idx)\remotehost=encip$:DCCInfo(idx)\remoteport=Val(param1$):DCCInfo(idx)\filesize=Val(msg$)
DCCInfo(idx)\File=param2$:DCCInfo(idx)\state=0:DCCInfo(idx)\Type=1
DCCInfo(idx)\filepos=flen:DCCInfo(idx)\Nick=nick$
EndIf
evid=15:sis=idx ;Raise Event of a DCC Send request along with the DCC slot index
EndIf
If UCase(Mid(msg$,1,11))=Chr(1)+"DCC ACCEPT" ;remote accepted your resume request
For gg=1 To MaxDCCSlots
If DCCInfo(gg)\filepos=Val(Arg$(8))
DCCInfo(gg)\state=2:DCCInfo(gg)\remoteport=Val(Arg$(7))
EndIf
Next
EndIf
If UCase(Mid(msg$,1,11))=Chr(1)+"DCC RESUME"
DCCSearchIndex(param2$,idx)
DCCInfo(idx)\filepos=Val(Arg$(8)):FileSeek(50+idx,DCCInfo(idx)\filepos)
SendIRC("PRIVMSG "+DCCInfo(idx)\Nick+" :"+Chr(1)+"DCC ACCEPT file.ext "+Str(DCCPort)+" "+Str(DCCInfo(idx)\filepos)+Chr(1))
EndIf
If UCase(Mid(msg$,1,9))=Chr(1)+"DCC CHAT"
ll=Val(Arg$(7))
ConvertIP(ll,endip$)
GetFreeDCCSlot(idx)
If idx
DCCInfo(idx)\Type=3 ;Type 3 = DCC Chat request received
DCCInfo(idx)\remotehost=endip$:DCCInfo(idx)\remoteport=Val(Arg$(8))
DCCInfo(idx)\Nick=nick$:DCCInfo(idx)\state=0
evid=16:sis=idx
EndIf
EndIf
Case "JOIN":evid=3:sis=0:ch$=Mid(Arg$(3),2,Len(Arg$(3))-1)
Case "NOTICE":evid=4:ch$=Arg$(3)
;If xx:msg$=Mid(e$,xx,Len(e$)-xx+1):If Mid(msg$,1,1)=":":msg$=Mid(msg$,2,Len(msg$)-1):EndIf:EndIf
Case "333":evid=5:param2$=Arg$(5) ;Set by
Case "367":evid=6:param1$=Arg$(5):param2$=Arg$(6):msg$=Arg$(7) ;Banlist
Case "353":evid=7:ch$=Arg$(5):xx=FindString(msg$,":",1):If xx:msg$=Mid(msg$,xx+1,Len(msg$)-xx):EndIf ;Names
Case "MODE":evid=8:param1$=Arg$(4):xx=FindString(E$,Arg$(5),1):If xx:param2$=Mid(E$,xx,Len(E$)-xx+1):EndIf ;Modes
Case "329":evid=9:msg$=Arg$(4):ch$=Arg$(3) ;Channel creation time
Case "QUIT":evid=10:xx=FindString(msg$,":",1):If xx:msg$=Mid(msg$,xx+1,Len(msg$)-xx):EndIf ;User quit irc
Case "391":ConnInfo(0)\ServerTimeSync=Date()-Val(Arg$(5)):evid=20
Case "KICK":ch$=Arg$(3):param1$=Arg$(4):evid=11
Case "PART":evid=12:ch$=Mid(Arg$(3),2,Len(Arg$(3))-1)
Case "TOPIC":evid=13:ch$=Arg$(3)
Case "NICK":evid=14:param1$=msg$
Case "474":evid=20:ch$=Arg$(4) ;cannot join channel (banned +b)
Case "475":evid=21:ch$=Arg$(4) ;cannot join channel (key is needed +k)
Case "473":evid=22:ch$=Arg$(4) ;cannot join channel (invite only +i)
Case "477":evid=23:ch$=Arg$(4) ;cannot join channel (registered users only +r)
Case "471":evid=24:ch$=Arg$(4) ;Channel full (limit +l)
Case "433":evid=25:param1$=Arg$(4)
Case "INVITE":evid=26:ch$=msg$
EndSelect
endproc:
EndProcedure
Procedure ConvertIP(ll,encip$)
i4=ll & 255:i3=(ll/256) & 255:i2=(ll/65536) & 255:i1=(ll/16777216) & 255
encip$=Str(i1)+"."+Str(i2)+"."+Str(i3)+"."+Str(i4)
EndProcedure
Procedure GetFreeDCCSlot(idx)
idx=-1
For gg=1 To MaxDCCSlots
If DCCInfo(gg)\Type=0:idx=gg:ProcedureReturn:EndIf
Next
EndProcedure
Procedure DCCFileAccept(sis,resumefile)
Shared idx
If DCCInfo(sis)\filepos=0:resumefile=0:EndIf
If resumefile
SendIRC("PRIVMSG "+DCCInfo(sis)\Nick+" :"+Chr(1)+"DCC RESUME "+DCCInfo(sis)\File+" "+Str(DCCInfo(sis)\remoteport)+" "+Str(DCCInfo(sis)\filepos)+Chr(1))
DCCInfo(sis)\state=1 ; State 1=wait for resume confirmation
Else
DCCInfo(sis)\state=2 ; State 2=ready to receive
DCCInfo(sis)\filepos=0
EndIf
rr=OpenFile(50+sis,Filepath$+DCCInfo(sis)\File)
If rr=0 ;Failed to open file, let's see if that file is in another dcc slot
DCCSearchIndex(DCCInfo(sis)\File,idx)
If idx>0 And sis<>idx
CloseFile(50+idx)
DCCInfo(idx)\state=DCCInfo(sis)\state:DCCInfo(idx)\filepos=DCCInfo(sis)\filepos:DCCInfo(idx)\remoteport=DCCInfo(sis)\remoteport
DCCClear(sis)
sis=idx:If DCCInfo(sis)\filepos>0:DCCInfo(sis)\filepos=0:EndIf
EndIf
rr=OpenFile(50+sis,Filepath$+DCCInfo(sis)\File)
If rr:If DCCInfo(sis)\filepos:FileSeek(50+sis,DCCInfo(sis)\filepos):EndIf:EndIf
EndIf
If DCCInfo(sis)\filepos>0 And resumefile=1:FileSeek(50+sis,DCCInfo(sis)\filepos):EndIf
EndProcedure
Procedure DCCChatAccept(sis)
If DCCInfo(sis)\Type=3:DCCInfo(sis)\state=1:EndIf
EndProcedure
Procedure DCCRefuse(sis)
DCCInfo(sis)\Type=0:DCCInfo(sis)\File="":DCCInfo(sis)\Timeout=0
EndProcedure
Procedure DCCClear(idx)
DCCInfo(idx)\Type=0:DCCInfo(idx)\state=0:DCCInfo(idx)\Timeout=0:DCCInfo(idx)\filepos=0:DCCInfo(idx)\filesize=0
DCCInfo(idx)\Nick="":DCCInfo(idx)\File=""
EndProcedure
Procedure DCCFileProgress(fnum,curpos,totalpos)
If DCCInfo(fnum)\filesize And fnum>0
curpos=DCCInfo(fnum)\filepos:totalpos=DCCInfo(fnum)\filesize
Else
totalpos=-1:curpos=-1
EndIf
EndProcedure
Procedure DCCSend(filename$,ToNick$,res)
For gg=1 To MaxDCCSlots
If DCCInfo(gg)\Type=2
If DebugRcv=#True:Debug "DCC SEND in progress, cancel or wait (pb networkserver limitation)":EndIf
ProcedureReturn:EndIf
Next
For gg=1 To MaxDCCSlots
If DCCInfo(gg)\Type=0
fs=FileSize(filename$)
If fs<1:res=-1:ProcedureReturn:EndIf
res=gg
DCCInfo(gg)\Type=2:a$=DCCIP$:pw=0:ircfile$=filename$:DCCInfo(gg)\state=0
OpenFile(50+gg,filename$)
For tt=Len(filename$) To 1 Step -1
If Mid(filename$,tt,1)="\":ircfile$=Mid(filename$,tt+1,Len(filename$)-tt):Goto endp13:EndIf
Next
endp13:
Repeat
xx=FindString(a$,".",1)
vv=Val(Mid(a$,1,xx)):a$=Mid(a$,xx+1,Len(a$))
pw=pw+1:Byte1(pw)=vv
Until xx=0
Byte1(pw)=Val(a$)
ll=Byte1(4)+Byte1(3)*256+Byte1(2)*65536+Byte1(1)*16777216
rr=CreateNetworkServer(1,DCCPort): SendIRC("PRIVMSG "+ToNick$+" :"+Chr(1)+"DCC SEND "+ircfile$+" "+Str(ll)+" "+Str(DCCPort)+" "+Str(fs)+Chr(1))
DCCInfo(gg)\state=1:DCCInfo(gg)\Nick=ToNick$
ProcedureReturn
EndIf
Next
EndProcedure
Procedure CheckDccEvents(DCCEvent,idx,param1$)
idx=0:DCCEvent=0
If ConnInfo(0)\cid=0:ProcedureReturn:EndIf
For gg=1 To MaxDCCSlots
If DCCInfo(gg)\Type>0 And DCCInfo(gg)\LastTimeout<>Date()
da=0:If DCCInfo(gg)\Type=3 And DCCInfo(gg)\state:da=1:EndIf ;Don't increment timeout if in a dcc chat
If da=0:DCCInfo(gg)\LastTimeout=Date():DCCInfo(gg)\Timeout=DCCInfo(gg)\Timeout+1:EndIf
If DCCInfo(gg)\Timeout=>DCCTimeout:DCCEvent=10:idx=gg
If DCCInfo(idx)\Type<3:CloseFile(50+idx):EndIf
If DCCInfo(idx)\Type=2:CloseNetworkServer(1):EndIf
DCCClear(idx):ProcedureReturn
EndIf
EndIf
Select DCCInfo(gg)\Type
Case 1 ;Type=DCC Receive
Select DCCInfo(gg)\state
Case 2 ;Establish connection with remote host
DCCInfo(gg)\cnid=OpenNetworkConnection(DCCInfo(gg)\remotehost,DCCInfo(gg)\remoteport)
DCCInfo(gg)\state=3:DCCInfo(gg)\Timeout=0
Case 3 ;Check for incoming data
rr=0:If DCCInfo(gg)\cnid:rr=NetworkClientEvent(DCCInfo(gg)\cnid):EndIf
If rr=2
rcv=AllocateMemory(8192):ll = ReceiveNetworkData(DCCInfo(gg)\cnid, rcv, 8192)
dta$=Mid(dta$,1,ll):DCCInfo(gg)\filepos=DCCInfo(gg)\filepos+ll
b1=DCCInfo(gg)\filepos & 255:b2=(DCCInfo(gg)\filepos/256) & 255:b3=(DCCInfo(gg)\filepos/65536) & 255
b4=(DCCInfo(gg)\filepos/16777216) & 255:mem= AllocateMemory(4)
PokeS(mem,Chr(b4)):PokeS(mem+1,Chr(b3)):PokeS(mem+2,Chr(b2)):PokeS(mem+3,Chr(b1))
rr=SendNetworkData(DCCInfo(gg)\cnid,mem,4)
WriteData(50+gg,rcv, ll):DCCInfo(gg)\Timeout=0
If DCCInfo(gg)\filepos=>DCCInfo(gg)\filesize:CloseFile(50+gg):DCCInfo(gg)\Type=0:DCCInfo(gg)\state=0:DCCEvent=1:idx=gg:EndIf
EndIf
EndSelect
Case 2 ;Type=DCC Send
Select DCCInfo(gg)\state
Case 1
rr=NetworkServerEvent()
If rr=1:DCCInfo(gg)\state=3:DCCInfo(gg)\cnid=EventClient():EndIf
Case 2
rr=NetworkServerEvent()
If rr=2
cnid=EventClient():rcv=AllocateMemory(8192)
ll = ReceiveNetworkData(cnid, rcv, 8192):DCCInfo(gg)\state=3:DCCInfo(gg)\Timeout=0
If DCCInfo(gg)\filepos=>Lof(50+gg):CloseFile(50+gg):DCCClear(gg):CloseNetworkServer(1):DCCEvent=2:EndIf
EndIf
Case 3 ; Send a packet
FileSeek(50+gg,DCCInfo(gg)\filepos)
pcks=DCCSendSize
If Lof(50+gg)-Loc(50+gg)<pcks:pcks=Lof(50+gg)-Loc(50+gg):EndIf
If pcks>0
snd=AllocateMemory(pcks)
ReadData(50+gg,snd,pcks)
rr=SendNetworkData(DCCInfo(gg)\cnid,@snd,pcks)
If rr=pcks:DCCInfo(gg)\filepos=DCCInfo(gg)\filepos+pcks:EndIf
DCCInfo(gg)\state=2:DCCInfo(gg)\Timeout=0
EndIf
EndSelect
Case 3 ;Type=DCC Chat (initiated by remote)
Select DCCInfo(gg)\state
Case 1
DCCInfo(gg)\cnid=OpenNetworkConnection(DCCInfo(gg)\remotehost,DCCInfo(gg)\remoteport)
DCCInfo(gg)\state=2:DCCInfo(gg)\Timeout=0
Case 2
rr=0:If DCCInfo(gg)\cnid:rr=NetworkClientEvent(DCCInfo(gg)\cnid):EndIf
If rr=2
a$=Space(8192):ll = ReceiveNetworkData(DCCInfo(gg)\cnid, @a$, 8192)
If ll>0:param1$=Mid(a$,1,ll):DCCEvent=3:idx=gg:EndIf
EndIf
EndSelect
EndSelect
Next
EndProcedure
Procedure DCCSearchIndex(filename$,idx) ;Find out where this file information is in which dcc slot
idx=0
For gg=1 To MaxDCCSlots
If DCCInfo(gg)\Type>0 And DCCInfo(gg)\File=filename$
idx=gg
ProcedureReturn
EndIf
Next
EndProcedure
