icqdirect2.pas

本程序是转载的

    DCEVENT_OnFTInit        :
      Begin
        dcRF := TicqDCRecvFile(Sender);
        If Assigned(fOnFTInit) then
          fOnFTInit(Self, dcRF.RemoteUIN, dcRF.FTStartRec.FilesCount, dcRF.TotalBytes, dcRF.FTStartRec.Speed, dcRF.NickName);
      End;
    DCEVENT_OnFTStart       :
      Begin
        dcRF := TicqDCRecvFile(Sender);
        If Assigned(fOnFTStart) Then
          fOnFTStart(Self, dcRF.FTStartRec, dcRF.FTRequestRec.FileName, dcRF.FTRequestRec.FileSize, dcRF.FTStartRec.Speed);
      End;
    DCEVENT_OnFTFileData    :
      Begin
        dcRF := TicqDCRecvFile(Sender);
        If assigned(fOnFTFileData) Then
          fOnFTFileData(Self, dcRF.RemoteUIN, dcRF.PDataPacket, dcRF.DataPacketLen, dcRF.IsLastPacket);
      End;
    DCEVENT_OnSendFileStart :
      Begin
        dcSF := TicqDCSendFile(Sender);
        If Assigned(fOnSendFileStart) Then
          fOnSendFileStart(Self, dcSF.RemoteUIN, dcSF.SendFileRecord);
      End;
    DCEVENT_OnSendFileData  :
      Begin
        dcSF := TicqDCSendFile(Sender);
        If Assigned(fOnSendFileData) Then
          fOnSendFileData(Self, dcSF.RemoteUIN, dcSF.PDataPacket, dcSF.DataPacketLen, dcSF.IsLastPacket);
      End;
    DCEVENT_OnSendFileFinish:
      Begin
        dcSF := TicqDCSendFile(Sender);
        If Assigned(fOnSendFileFinish) Then
          fOnSendFileFinish(Self, dcSF.RemoteUIN, dcSF.SendFileRecord, dcSF.Aborted);
      End;
  End;
End;

Function TicqDCM.SendData(aUIN:LongWord; pPkt: PRawPkt):Boolean;
Var
  i:integer;
Begin
  // Send Pkt through DCMain of User (aUIN)
  Result := False;
  If GetUserIndex(aUIN, i) then
    With PicqDirectUser(fUL[i])^ Do
      If IsConnected and (DCMain <> -1) Then Begin
        TicqDCNormal(fDCL.Items[DCMain]).SendData(pPkt);
        Result := True;
      End;
End;

function TicqDCM.SendDataFile(aUIN: LongWord; Pak: PRawPkt): Boolean;
Var
  i:Integer;
Begin
  // Send Pkt Through DCRecvFile of User (aUIN)
  Result := False;
  If GetUserIndex(aUIN, i) then
    With PicqDirectUser(fUL[i])^ Do
      If DCRecvFile <> -1 then Begin
        TicqDCRecvFile(fDCL[DCRecvFile]).SendData(Pak);
        Result := True;
      End;
End;

function TicqDCM.AddFileUser(aUIN: LongWord; var aPort: Word; FTReqRec:Pointer = nil): Boolean;
Var
  I:integer;
  aDC:TicqDCRecvFile;
  FTRec:TFTRequestRec;
  BPort:Word;
Begin
  Result := False;
  BPort := FindBindPort;
  // Add a DCRecvFile to User (aUIN)
  If GetUserIndex(aUin, i) then Begin
    With PicqDirectUser(fUL[i])^ Do Begin
      If DCRecvFile <> -1 Then
        DeleteDC(DCRecvFile);
      aPort := BPort;
      aDC := TicqDCRecvFile.Create(MyUIN, aUin, aPort);
      aDC.fIncoming := True;
      DCRecvFile := fDCL.Add(aDC);
      aDC.fpUser     := PicqDirectUser(fUL.Items[i]);
      aDC.fManager   := Self;
      aDC.FPort      := BPort;
      // Proxy Settings
      aDC.FProxyType := ProxyType;
      aDC.FProxyHost := ProxyHost;
      aDC.FProxyPort := ProxyPort;
      aDC.FProxyAuth := ProxyAuth;
      aDC.FProxyPass := ProxyPass;
      aDC.FUserID    := FUserID;
      aDC.FResolve   := FResolve;
      aDC.UseProxyResolve := UseProxyResolve;
      // Events
      aDC.FOnError   := InternalOnErrorProc;
      aDC.FOnPktDump := InternalOnPktDump;
      aDC.fOnHandle  := InternalOnHandle;
      aDC.fOnDCEvent := HandleDCEvent;
      If FTReqRec <> nil then
        With aDC.FTRequestRec Do Begin
          FTRec := TFTRequestRec(FTReqRec^);
          ReqType     := FTRec.ReqType;
          ITime       := FTRec.ITime;
          IRandomID   := FTRec.IRandomID;
          UIN         := FTRec.UIN;
          Description := FTRec.Description;
          FileName    := FTRec.FileName;
          FileSize    := FTRec.FileSize;
          Seq         := FTRec.Seq;
          Port        := aPort;
        End;
      // Connect
      aDC.Start;
      Result := True;
    End;
  End;
End;

Procedure TicqDCM.SetFileRecord(aUIN: LongWord; aFileRec:TSendFileRec);
Var
  i:integer;
  aDC:TicqDCSendFile;
Begin
  If GetUserIndex(aUIN, i) Then
    With PicqDirectUser(fUL[i])^ Do Begin
      If DCSendFile <> -1 Then
        DeleteDC(DCSendFile);
      aDC := TicqDCSendFile.Create(MyUin, aUin, aFileRec);
      DCSendFile := fDCL.Add(aDC);
      aDC.MyUIN     := MyUin;
      aDC.fpUser    := PicqDirectUser(fUL[i]);
      aDC.fIncoming := False;
      aDC.fManager  := Self;
      aDC.FOnError   := InternalOnErrorProc;
      aDC.FOnPktDump := InternalOnPktDump;
      aDC.fOnHandle  := InternalOnHandle;
      aDC.OnDCEvent := HandleDCEvent;
    End;
End;

Function TicqDCM.AddSendFileUser(aUIN:LongWord; Var aPort, aSeq:Word):Boolean;
Var
  i:integer;
Begin
  // Add a DCSendFile to User (aUIN);
  Result := False;
  If GetUserIndex(aUin, i) Then
    With PicqDirectUser(fUL[i])^ do Begin
      If DCSendFile <> -1 Then
       With TicqDCSendFile(fDCL[DCSendFile]) Do Begin
         //fpUser^.Port := Port;
         fSeq := aSeq;
         fRemPort := aPort;
         Start;
        End;
    End;
End;

function TicqDCM.StopFileReceiving(aUIN: LongWord): Boolean;
Var
  I:Integer;
Begin
  Result := false;
  // Break DCRecvFile connection for User (aUIN)
  If GetUserIndex(aUIN, i) Then
    With PicqDirectUser(fUL[i])^ Do
      If DCRecvFile <> -1 then
        DeleteDC(DCRecvFile);
  Result := True;
End;

Procedure TicqDCM.StopFileSending(aUIN: LongWord);
Var
  I:Integer;
Begin
  // Stop File Sending;
  If GetUserIndex(aUIN, i) then
    With PicqDirectUser(fUL[i])^ Do
      If DCSendFile <> -1 then Begin
        TicqDCSendFile(fDCL[DCSendFile]).Stop;
        Sleep(100);
        DeleteDC(DCSendFile);
      End;
End;

procedure TicqDCM.EstabilishConnection(aUIN: LongWord);
Var
  i, i2: integer;
  aDC:TicqDCNormal;
Begin
  // Establish DCMain connection for User (aUIN)
  If GetUserIndex(aUIN, i) then
    With PicqDirectUser(fUL.Items[i])^ Do Begin
      If IsConnected then Exit;
      If fpUser^.IntIP + fpUser^.ExtIP = 0 then Exit;
      if fpUser^.Port < 1025 Then Exit;
      If DCMain <> -1 then
        TicqDCNormal(fDCL.Items[DCMain]).Free;
      aDC := TicqDCNormal.Create(aUIN, TMySocket.Create, False);
      DCMain := fDCL.Add(aDC);
      aDC.fpUser     := PicqDirectUser(fUL.Items[i]);
      aDC.fManager   := Self;
      aDC.fRemUIN    := aUIN;
      aDC.MyUIN      := MyUIN;
      aDC.fPort      := FindBindPort;
      // Proxy Settings
      aDC.FProxyType := ProxyType;
      aDC.FProxyHost := ProxyHost;
      aDC.FProxyPort := ProxyPort;
      aDC.FProxyAuth := ProxyAuth;
      aDC.FProxyPass := ProxyPass;
      aDC.FUserID    := FUserID;
      aDC.FResolve   := FResolve;
      aDC.UseProxyResolve := UseProxyResolve;
      // Events
      aDC.FOnError   := InternalOnErrorProc;
      aDC.FOnPktDump := InternalOnPktDump;
      aDC.fOnHandle  := InternalOnHandle;
      aDC.fOnDCEvent := HandleDCEvent;
      // Connect
      aDC.Start;
      Sleep(100);
      If aDC.Client.Connected Then // If Socket is connecting then give up time and wait.
        For i2 := 0 to 300 Do Begin
          Sleep(10);
          GiveUpCpuTime;
          If IsConnected then Break;
        End;
    End;
End;

function TicqDCM.ConnectionEstabilished(aUIN: LongWord): Boolean;
Var
  i:integer;
  p:PicqDirectUser;
Begin
  // Poll for DCMain Connection for User (aUIN), should open a DCMain
  Result := False;
  If GetUserIndex(aUIN, i) then Begin
    P := PicqDirectUser(fUL.Items[i]);
    Result := P^.IsConnected;
    If Result Then
      Exit;
    // Attemp to Establish Connection
    EstabilishConnection(aUIN);  // Implements Connect On Demmand
    Result := P^.IsConnected;
  End;
End;

Procedure TicqDCM.DeleteUser(aUIN: LongWord);
Var
  i:integer;
Begin
 If GetUserIndex(aUIN, i) Then
   With PicqDirectUser(fUL.Items[i])^ Do Begin
     // Disconnect any connections
     If DCChat <> -1 then
       DeleteDC(DCChat);
     If DCSendFile <> -1 then
       DeleteDC(DCSendFile);
     If DCRecvFile <> -1 then
       DeleteDC(DCRecvFile);
     If DCMain <> -1 then
       DeleteDC(DCMain);
     FreeMem(fUL.Items[i], SizeOf(TicqDirectUser));
     fUL.Delete(i);
     Exit;
   End;
End;

Procedure TicqDCM.DeleteDC(Var aIndex:Integer);
Var
  aDC:TicqBaseDC;
Begin
  If (aIndex < 0) or (aIndex > (fDCL.Count -1))Then Begin
    aIndex := -1;
    Exit;
  End;
  aDC := TicqBaseDC(fDCL[aIndex]);

  fDCL.Delete(aIndex);
  aIndex := -1;
  If aDC = nil then Exit;
  With aDC Do
    If CSck <> nil then
      If CSck.Connected Then
        CSck.Disconnect;
  FreeAndNil(aDC);
End;

Function TicqDCM.GetUserIndex(aUIN:LongWord; Var Idx:integer):Boolean;
Var
  i:Integer;
Begin
  Result := False;
  For i := 0 to fUL.Count -1 Do
    If PicqDirectUser(fUL[i])^.UIN = aUIN then Begin
      Idx := i;
      Result := True;
      Exit;
    End;
End;
procedure TicqDCM.AddUser(aUIN, aCookie, aIPExt, aIPInt: LongWord; aPort: Word);
Var
  i:integer;
  p: PicqDirectUser;
Begin
  If GetUserIndex(aUIN, i) then
    With PicqDirectUser(fUL[i])^ Do Begin
    Cookie := aCookie;
    ExtIP  := aIPExt;
    IntIP  := aIPExt;
    Port   := aPort;
    IsConnected := False;
    If DCChat <> -1 Then
      DeleteDC(DCChat);
    If DCSendFile <> -1 Then
      DeleteDC(DCSendFile);
    If DCRecvFile <> -1 Then
      DeleteDC(DCRecvFile);
    If DCMain <> -1 then
      DeleteDC(DCMain);
    Exit;
    End;
  GetMem(p, SizeOf(TicqDirectUser));
  p^.UIN    := aUin;
  p^.Cookie := aCookie;
  p^.ExtIP  := aIPExt;
  p^.IntIP  := aIPInt;
  p^.Port   := aPort;
  p^.IsConnected := False;
  p^.DCMain      := -1;
  p^.DCRecvFile  := -1;
  p^.DCSendFile  := -1;
  p^.DCChat      := -1;
  fUL.Add(p);
End;

//****************************************************************************//
{ TicqBaseDC }
constructor TicqBaseDC.Create(aMyUIN: LongWord);
Begin
  Inherited Create;
  CSck := nil;
  SSck := nil;
  MyUin := aMyUIN;
  OnDCEvent := nil;
  OnError   := nil;
  OnHandle  := nil;
  OnPktDump := nil;
End;

destructor TicqBaseDC.Destroy;
Begin
  Inherited Destroy;
  Try
    //CSck.Disconnect;
    CSck.Free;
  Except
  End;
End;

Procedure TicqBaseDC.SetCSck(aSock:TMySocket);
Begin
  If CSck = aSock then Exit;
  If CSck <> nil then
    CSck.Free;
  CSck := aSock;
End;

Function TicqBaseDC.SendData(Pkt: PRawPkt):Boolean;
var
  buf: array[0..$FFFF - 1] of Byte;
Begin
  // Send Data
  If CSck.Connected Then Begin
    CSck.SendData(Pkt^.Len, 2);
    CSck.SendData(Pkt^, Pkt^.Len);
    Result := True;
  End Else Begin
    OnSockError(Self);
    Result := False;
    Exit;
  End;
  fpUser^.LastActivity := GetTickCount;
  If Assigned(fOnPktDump) Then Begin
    PWord(@buf)^ := Pkt^.Len;
    Move(Pkt^.Data, Ptr(LongWord(@buf) + 2)^, Pkt^.Len);
    fOnPktDump(Self, @Buf, Pkt^.Len + 2, False, fRemUIN);
  End;
End;

procedure TicqBaseDC.OnSockError(Sender: TObject);
Begin
  //fpUser^.IsConnected := False;

  Try
    If Sender is TMySocket then
    With Sender as TMySocket do Begin
      OnConnectError := Nil;
      OnDisconnect   := Nil;
      OnError        := Nil;
      If Connected Then
        Disconnect;
    End;
  Except
    //Ignore any errors
  End;

  If fpUser^.DCMain <> -1 Then
    If Sender = TicqBaseDC(fManager.fDCL[fpUser^.DCMain]).CSck then Begin
      fManager.DeleteDC(fpUser^.DCMain);
      fpUser^.IsConnected := False;
      Exit;
    End;
  If fpUser^.DCRecvFile <> -1 then
    If Sender = TicqBaseDC(fManager.fDCL[fpUser^.DCRecvFile]).CSck then Begin
      fManager.DeleteDC(fpUser^.DCRecvFile);
      Exit;
    End;
  If fpUser^.DCSendFile <> -1 then
    If Sender = TicqBaseDC(fManager.fDCL[fpUser^.DCSendFile]).CSck then Begin
      fManager.DeleteDC(fpUser^.DCSendFile);
      Exit;
    End;
  If fpUser^.DCChat <> -1 then
    If Sender =  TicqBaseDC(fManager.fDCL[fpUser^.DCChat]).CSck then
      fManager.DeleteDC(fpUser^.DCChat);
End;

procedure TicqBaseDC.OnSockConnectError(Sender: TObject);
Begin
  OnSockError(Self);
End;

procedure TicqBaseDC.OnConnect(Sender: TObject);
Var
  Pkt:TRawPkt;
Begin
  If fIncoming then Begin

  End Else
    With fpUser^ DO Begin
        LastActivity := GetTickCount;
        CreatePEER_INIT(@pkt, Cookie, fRemUIN, MyUIN, fManager.fpUser^.Port, fManager.fpUser^.ExtIP, fManager.fpUser^.IntIP, CSck.ProxyType);
        SendData(@pkt);
    End;
End;

{Recieve data and packetize it, then send it to the subclass}
procedure TicqBaseDC.OnReceive(Sender: TObject; Socket: TSocket; Buffer: Pointer; BufLen: LongWord);
Var
  i:integer;
Begin
  fpUser^.LastActivity := GetTickCount;

  If BufLen = 0 then Exit;
  For i := 0 to BufLen -1 Do Begin
    fDPkt.Data[fPktLen] := PByte(LongWord(Buffer) + LongWord(i))^;
    Inc(fPktLen);
    If fPktLen = 2 then Begin
      fPktSize := PWord(@fDPkt)^;
      If fPktSize > SizeOf(fDPkt.Data) Then Begin
        OnIntError(Self, ERR_INTERNAL, RS_ERROR_BUFFEROVERRUN);
        OnSockError(Self);
        Exit;
      End;
    End;
    If fPktLen = (fPktSize + 2) then Begin
      fDPkt.Len := 0;
      fPktSize  := 0;
      If Not HandlePacket(@fDPkt, fPktLen) Then
        fManager.InternalOnHandle(Sender, fpUser^.UIN, @fDPkt, fDPkt.Len);
      fPktLen   := 0;
    End;
  End;
End;