icqdirect2.pas

本程序是转载的

procedure TicqBaseDC.OnIntPktDump(Sender: TObject; Buffer: Pointer; BufLen: LongWord; Incoming: Boolean; UIN: Cardinal);
Begin
  If Assigned(fOnPktDump) Then
    fOnPktDump(Sender, Buffer, BufLen, Incoming, UIN);
End;

procedure TicqBaseDC.OnIntError(Sender: TObject; ErrorType: TErrorType; ErrorMsg: String);
Begin
  If Assigned(fOnError) Then
    fOnError(Sender, ErrorType, ErrorMsg);
End;

Function TicqBaseDC.HandlePacket(pPkt: PRawPkt; PktLen:Integer):Boolean;
Var
  i:Integer;
  PktPos:Integer;
  aPktLen:Integer;
  lPkt:TRawPkt;
  PrtVer, Port, Port2:Word;
  CheckByte, PrxType:Byte;
  UIN, aRemUIN, Cookie, ExtIP, IntIP:LongWord;
Begin
  Result := False;
  // Handle Incoming Packet;
  PktPos := pPkt^.Len;
  Try
    If Assigned(fOnPktDump) Then
      fOnPktDump(Self, pPkt, PktLen, True, fpUser^.UIN);
    // Decode Packet Len and Command
    aPktLen := GetLint(pPkt, 2);
    Case GetInt(pPkt, 1) Of
      PEER_INIT:
        Begin
          Try
            // Get Data From Packet.
            PrtVer    := GetLInt(pPkt, 2);// ProtoVersion (WORD.L)
            CheckByte := GetLInt(pPkt, 2);// $2B  ??  (BYTE)
            UIN       := GetLInt(pPkt, 4);//  UIN (DOWRD.L)
            Inc(pPkt^.Len, 2);// $00 - $00  (WORD)
            Port      := GetLInt(pPkt, 4);// Port (DWORD.L)
            aRemUIN   := GetLInt(pPkt, 4);// Remote UIN  (DWORD.L)
            ExtIP     := GetLInt(pPkt, 4);// IP's (2 x DWORD.L)
            IntIP     := GetLInt(pPkt, 4);
            PrxType   := GetInt(pPkt, 1);// ProxyType (Byte)
            Port2     := GetLInt(pPkt, 4);// Port (DWORD.L)
            Cookie    := GetInt(pPkt, 4);// Cookie (DWORD)

            // Put Data where it Belongs.
            If fIncoming And (fpUser^.UIN = 0)Then Begin
              // Need to Check if RemUIN is in User list, if not then
              // Should Denie connection (not in Contacts) else
              // Should Move the connection over to that user.

              If fManager.GetUserIndex(aRemUIN, i) then Begin
                fRemUIN := aRemUIN;
                With PicqDirectUser(fManager.fUL[i])^ Do Begin
                  If DCMain <> -1 then
                    DeleteDC(DCMain);
                  DCMain := fManager.fDCL.IndexOf(Self);
                  // Ok Connection is moved, free mem.
                  FreeMem(fpUser, SizeOf(TicqDirectUser));
                  fpUser := PicqDirectUser(fManager.fUL[i]);
                End;
              End Else Begin
                // Else Denie connection.
                i := fManager.fDCL.IndexOf(Self);
                fManager.DeleteDC(i);
              End;
            End;
            // Ack it.
            CreatePEER_ACK(@lPkt);
            SendData(@lPkt);
            // Check Data.
            If PrtVer < 7 then Begin
              OnIntError(Self, ERR_Internal, RS_ERROR_NO_DC_WRONGVER);
            End;
            If (Uin <> MyUIN) or (fRemUIN <> aRemUIN) or
               (Port <> Port2) or (fpUser^.Cookie <> Cookie)Then Begin
              OnIntError(Self, ERR_INTERNAL, RS_ERROR_NO_DC_SECURITY);
              OnSockError(Self);
              Exit;
            End;
            If (PrxType <> 01) and (PrxType <> 02) and (PrxType <> 04) Then Begin
              OnIntError(Self, ERR_INTERNAL, RS_ERROR_NO_DC_UNSUPPORTEDPROXY);
              OnSockError(Self);
              Exit;
            End;
            If fIncoming Then Begin
              // And Send a PEER_INIT
              CreatePEER_INIT(@lpkt, fpUser^.Cookie, aRemUIN, MyUIN, fpUser^.Port, fpUser^.ExtIP, fpUser^.IntIP, CSck.ProxyType);
              SendData(@lPkt);

            End Else Begin
              // And Send PEER_INIT2
              CreatePEER_INIT2(@lpkt, FIncoming);
              SendData(@lpkt);
              //fpUser^.IsConnected := True;
            End;
            Result := True;
          Except
            OnIntError(Self, ERR_INTERNAL, RS_ERROR_NO_DC_PACKETERROR);
          End;
        End;
      PEER_INIT2:
        Begin
        Result := True;
        If fIncoming then Begin
          CreatePEER_INIT2(@lpkt, FIncoming);
          SendData(@lpkt);
          Result := True;
        End;
        fpUser^.IsConnected := True;
        //Result := False;
        End;
    Else
      Result := False;
    End;
  Finally
    If Not Result then
      pPkt^.Len := PktPos;
  End;
End;

//****************************************************************************//
{ TicqDCNormal }
constructor TicqDCNormal.Create(aMyUIN: LongWord; aClient: TMySocket; Incoming:Boolean);
Begin
  Inherited Create(aMyUIN);
  fIncoming := Incoming;
    Client := aClient;
    CSck.OnConnectError := OnSockConnectError;
    CSck.OnDisconnect   := OnSockError;
    Csck.OnConnectProc  := OnConnect;
    CSck.OnReceiveProc  := OnReceive;
End;

Function TicqDCNormal.Start:Boolean;
Var
  inaddr: in_addr;
Begin
  Result := False;
  If fIncoming then Begin
    Exit;
  End;
  // Connect
  inaddr.S_addr := fpUser^.ExtIP;
  CSck.Host := inet_ntoa(inaddr);
  CSck.Port := fpUser^.Port;
  CSck.Connect;
  Result := True;
End;

Procedure TicqDCNormal.Stop;
Begin
  // Disconnect
  cSck.Disconnect;
  fpUser^.IsConnected := False;
End;

Function TicqDCNormal.HandlePacket(pPkt: PRawPkt; PktLen:Integer):Boolean;
Var
  aPktLen:Integer;
  CheckByte, PrxType:Byte;
  UIN, aRemUIN, Cookie, ExtIP, IntIP:LongWord;
Begin
  Result := Inherited HandlePacket(pPkt, PktLen);
  If Result then Exit;
  // Handle Incoming Packet;
    aPktLen := GetLint(pPkt, 2);
    Case GetInt(pPkt, 1) Of
       PEER_MSG:
         Begin
           // Pass Pkt back to ICQClient for handling.
           pPkt^.Len := PktLen;  // Set Len to Size of Pkt for Decryption.
           Result := False;
         End;
    Else
      Result := False;
    End;
End;

//****************************************************************************//
{ TicqDCRecvFile }
Constructor TicqDCRecvFile.Create(MyUIN, aUIN: LongWord; aPort:Dword);
Begin
  Inherited Create(MyUIN);
  fRemUIN := aUIN;
  fPort   := aPort;
  DataPacketLen := 0;
  NickName := '';
  IsLastPacket := False;
  TotalBytes := 0;
  FTRequestRec.UIN := aUIN;
  FTRequestRec.Port:= aPort;
  FTStartRec.UIN   := aUIN;
End;

Procedure TicqDCRecvFile.OnRFSrvSockConnect(Sender: TObject; Socket: TMySocket);
Begin
  Client := Socket;

  CSck.OnConnectError := OnSockConnectError;
  CSck.OnDisconnect   := OnSockError;
  Csck.OnConnectProc  := OnConnect;
  CSck.OnReceiveProc  := OnReceive;

  SSck.StopServer;
  fSrvConnected := True
End;

Function TicqDCRecvFile.Start:Boolean;
Begin
  SSck := TSrvSocket.Create;
  SSck.OnClientConnected := OnRFSrvSockConnect;
  SSck.StartServer(FTRequestRec.Port);
  Result := True;
End;

Procedure TicqDCRecvFile.Stop;
Begin
  If fSrvConnected then Begin
    CSck.Disconnect;
  End Else
    SSck.StopServer;
End;

Function TicqDCRecvFile.HandlePacket(pPkt: PRawPkt; PktLen:Integer):Boolean;
Var
  aPktLen:Integer;
  lPkt:TRawPkt;
Begin
  Result := Inherited HandlePacket(pPkt, PktLen);
  If Result then Exit;
  // Handle Incoming Packet;
    aPktLen := GetLint(pPkt, 2);
    Case GetInt(pPkt, 1) Of
      PEER_FILE_INIT:
        Begin
          Inc(pPkt^.Len, 4);  //Skip Unknown (00 00 00 00)
          FTStartRec.FilesCount := GetLInt(pPkt, 4);  // Number of files sent
          TotalBytes := GetLint(pPkt, 4);             // TotalSize of all Files
          FTStartRec.Speed := GetLInt(pPkt, 4);       // Speed: 0 = Pause, 64 = Bo Delay
                                                      // 0 < n < 64 = (64-n) * 0.05s delay.
          NickName := GetLNTS(pPkt);                  // Nick of Sender;

          CreatePEER_FILEINITACK(@lPkt, FTStartRec.Speed, NickName);
          SendData(@lPkt);

          EventType := DCEVENT_OnFTInit;
          If assigned(fOnDCEvent) then  // Call the Event OnFTInit
            fOnDCEvent(Self);
        End;
      PEER_MSG:
        Begin
          pPkt^.Len := 3;
          Inc(pPkt^.Len, 1);
          FTRequestRec.FileName := GetLNTS(pPkt);
          GetLNTS(pPkt);
          FTRequestRec.FileSize := GetLInt(pPkt, 4);
          FTPos := 0;
          EventType := DCEVENT_OnFTStart;
          If Assigned(fOnDCEvent) Then
            fOnDCEvent(Self);
          pPkt^.Len := PktLen;
          Result := False;
        End;
      PEER_FILE_DATA:
      Begin
        DataPacketLen := aPktLen -1;
        Inc(FTPos, DataPacketLen);
        IsLastPacket := Not (FTPos < FTRequestRec.FileSize);
        PDataPacket := Ptr(LongWord(pPkt) + 3);
        EventType := DCEVENT_OnFTFileData;
        If Assigned(fOnDCEvent) then
          fOnDCEvent(Self);
        If IsLastPacket and (FTStartRec.FilesCount = 1) then
          CSck.Disconnect;    //Last File Dissconnect
        Result := True;
      End;
    Else
      Result := False;
    End;

End;

//****************************************************************************//
{ TicqDCSendFile }
Constructor TicqDCSendFile.Create(MyUIN, aUIN: LongWord; aFileRec:TSendFileRec);
Begin
  Inherited Create(MyUIN);
  pDataPacket := @fPkt;

  fRemUIN := aUIN;

  tmrSend := TThreadTimer.Create;
  tmrSend.Interval := 1;
  tmrSend.OnTimer  := OnSendTimer;

  fConnectionFinished := False;
  fTransfering := False;
  fAborted := False;

  CSck := TMySocket.Create;
  CSck.OnConnectError := OnSockConnectError;
  CSck.OnDisconnect   := OnSFDisconnect;
  Csck.OnConnectProc  := OnSFConnect;
  CSck.OnReceiveProc  := OnReceive;
  CSck.OnDataSent     := OnDataSent;

  With SendFileRecord Do Begin
    SendFileRecord.Uin := aFileRec.UIN;
    Nick      := aFileRec.Nick;
    Seq       := aFileRec.Seq;
    FilesCount:= aFileRec.FilesCount;
    FilePath  := aFileRec.FilePath;
    FileName  := aFileRec.FileName;
    FileDescription := aFileRec.FileDescription;
    FileSize  := aFileRec.FileSize;
    TotalSize := aFileRec.TotalSize;
    SendFileRecord.Port := fRemPort;;
    Speed := aFileRec.Speed;
    Files := aFileRec.Files;
  End;
End;

Procedure TIcqDCSendFile.OnSFDisconnect(Sender: TObject);
Begin
  If Not fTransfering then exit;
  fTransfering := False;
  fAborted := True;
  EventType := DCEVENT_OnSendFileFinish;
  If Assigned(fOnDCEvent) then
    fOnDCEvent(Self);

  OnSockError(Self);
End;

Destructor TicqDCSendFile.Destroy;
Begin
  tmrSend.Free;
  inherited Destroy;
End;

Procedure TicqDCSendFile.OnDataSent(Sender: TObject);
Begin
  If fConnectionFinished then
    fTransfering := False;
End;

procedure TicqDCSendFile.OnSendTimer(Sender: TObject);
Var
  lPkt:TRawPkt;
Begin
  // Send Data;
  tmrSend.Enabled := False;

  If Not CSck.Connected then Exit;
  If IsLastPacket then Begin
    fConnectionFinished := True;
    DataPacketLen := 0;
    EventType := DCEVENT_OnSendFileData;
    If Assigned(fOnDCEvent) then Begin
      fOnDCEvent(Self);
    End;
    Inc(SendFileRecord.FilesCurrent);
    EventType := DCEVENT_OnSendFileFinish;
    If Assigned(fOnDCEvent) Then
      fOnDCEvent(Self);
    If SendFileRecord.Files.Count > SendFileRecord.FilesCurrent then Begin
      With SendFileRecord Do Begin
        FileName := ExtractFileName(Files[FilesCurrent]);
        FilePath := ExtractFilePath(Files[FilesCurrent]);
        FileSize := ICQWorks.FileSize(Files[FilesCurrent]);
      End;
      IsLastPacket := False;
      EventType := DCEVENT_OnSendFileStart;
      If Assigned(fOnDCEvent) Then
        fOnDCEvent(Self);

      CreatePEER_FILE_START(@lPkt, SendFileRecord.FileName, SendFileRecord.FileSize, SendFileRecord.Speed);
      SendData(@lPkt);
      exit;
    End;
    // No More Files
    CSck.Disconnect;
    Sleep(150);  // Give time for CSck to disconnect.
    fManager.DeleteDC(fpUser^.DCSendFile);
    Exit;
  End;
  EventType := DCEVENT_OnSendFileData;
  If assigned(fOnDCEvent) then Begin
    fOnDCEvent(Self);
    CreatePEER_FILE_DATA(@lPkt, PDataPacket, DataPacketLen);
    SendData(@lPkt);
    tmrSend.Enabled := True;;
  End;
End;

procedure TicqDCSendFile.OnSFConnect(Sender: TObject);
Var
  lPkt:TRawPkt;
Begin
//  fpUser^.IsConnected := True;
  fConnectionFinished := False;
  fTransfering := False;
  fAborted := False;
  fPeerReady := False;
    CreatePEER_INIT(@lPkt, fpUser^.Cookie, fRemUIN, MyUIN, fPort, fManager.ExtIP, fManager.IntIP, fManager.fProxyType);
    SendData(@lPkt);
End;


Function TicqDCSendFile.Start:Boolean;
Var
  inaddr: in_addr;
Begin
  InAddr.S_addr := fpUser^.ExtIP;
  Csck.Host := inet_ntoa(inaddr);
  CSck.Port := fRemPort;;
  SendFileRecord.Port := fpUser^.Port;
  CSck.Connect;
  EventType := DCEVENT_OnSendFileStart;
  If Assigned(fOnDCEvent) Then
    fOnDCEvent(Self);
  Result := True
End;

Procedure TicqDCSendFile.Stop;
Begin
  CSck.Disconnect;
End;

Function TicqDCSendFile.HandlePacket(pPkt: PRawPkt; PktLen:Integer):Boolean;
Var
  aPktLen:Integer;
  lPkt:TRawPkt;
Begin
  Result := True;
  // Handle Incoming Packet;
   If Assigned(fOnPktDump) Then
     fOnPktDump(Self, pPkt, PktLen, True, fpUser^.UIN);

    aPktLen := GetLint(pPkt, 2);
    Case GetInt(pPkt, 1) Of
       PEER_INIT:
         Begin
           CreatePEER_ACK(@lPkt);
           SendData(@lPkt);
           CreatePEER_FILE_INIT(@lPkt, SendFileRecord.FilesCount, SendFileRecord.FileSize, SendFileRecord.Speed, SendFileRecord.Nick);
           SendData(@lPkt);
           fPeerReady := True;
           Result := True;
         End;
       PEER_INIT2:
         Begin
           tmrSend.Enabled := True;
           Result := True;
         End;
       PEER_FILE_INITACK:
         Begin
           If fPeerReady then Begin
             CreatePEER_FILE_START(@lPkt, SendFileRecord.FileName, SendFileRecord.FileSize, SendFileRecord.Speed);
             SendData(@lPkt);
             Result := True;
           End;
         End;
      PEER_MSG:
        Begin
          // Pass Pkt back to ICQClient for handling.
          pPkt^.Len := PktLen;  // Set Len to Size of Pkt for Decryption.
          Result := False;
        End;
    Else
      Result := False;
    End;
End;

//****************************************************************************//
{ TicqDCChat }
end.