icqclient.pas

DarkMoon v4.11 (远程控制) 国外收集的代码,控件下载: http://www.winio.cn/Blogs/jishuwenzhang/200712/20071208230135.

    procedure UpdateTimer;
    procedure SetEnabled(Value: Boolean);
    procedure SetInterval(Value: LongWord);
    procedure SetOnTimer(Value: TNotifyEvent);
    procedure WndProc(var Msg: TMessage);
  protected
    procedure Timer; dynamic;
  public
    constructor Create;
    destructor Destroy; override;
    property Tag: Integer read FTag write FTag;
  published
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property Interval: LongWord read FInterval write SetInterval default 1000;
    property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
  end;

procedure Register;

implementation
{-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}

{*** CONSTRUCTOR ***}
constructor TICQNet.Create;
begin
  inherited Create;
end;

{*** DESTRUCTOR ***}
destructor TICQNet.Destroy;
begin
  inherited;
end;

procedure TICQNet.Connect;
begin
  FSrcLen := 0;
  FFlapSet := False;
  inherited;
end;

{No proxy data is received here.}
procedure TICQNet.OnReceive(Buffer: Pointer; BufLen: LongWord);
var
  i, len: LongWord;
  flap: TFlapHdr;
begin
  inherited;
  for i := 0 to BufLen - 1 do
  begin
    FSrcBuf[FSrcLen] := PByte(LongWord(Buffer) + i)^;
    Inc(FSrcLen);
    //Searching for the Flap header
    if (FSrcLen >= TFLAPSZ) and (not FFlapSet) then
    begin
      FFlapSet := True;
      FNewFlap := PFlapHdr(@FSrcBuf)^;
      FNewFlap.DataLen := Swap16(FNewFlap.DataLen);
      FNewFlap.Seq := Swap16(FNewFlap.Seq);
      if FNewFlap.DataLen > 8192 then
      begin
        if Assigned(OnError) then
          OnError(Self, ERR_PROTOCOL, 'Length of received packet exceeds maximum supported by protocol. Len = ' + IntToStr(FNewFlap.DataLen));
        Disconnect;
        Exit;
      end;
    end;
    //Whole packet was received
    if FSrcLen = FNewFlap.DataLen + TFLAPSZ then
    begin
      if FNewFlap.Ident <> $2a then
      begin
        if Assigned(OnError) then
          OnError(Self, ERR_PROTOCOL, 'Received malformed packet');
        Disconnect;
        Exit;
      end;
      Move(FNewFlap, flap, SizeOf(FNewFlap));      
      //Preparing structures for receiving the next packet
      FNewFlap.DataLen := 0;
      len := FSrcLen; FSrcLen := 0;
      FFlapSet := False;
      //Dump packet (if needed)
      if Assigned(OnPktParseA) then
        OnPktParseA(Self, @FSrcBuf, len, True);
      //Handling packet
      if Assigned(OnHandlePkt) then
        FHandlePkt(flap, Ptr(LongWord(@FSrcBuf) + TFLAPSZ));
    end;
  end;
end;


{-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}

{*** CONSTRUCTOR ***}
constructor TICQClient.Create(AOwner: TComponent);
begin
  inherited;
  FLastError := '';                     //Last error

  FContactLst := TStringList.Create;    //Contact list
  FVisibleLst := TStringList.Create;    //Visible list
  FInvisibleLst := TStringList.Create;  //Invisible list

  FInfoChain := TStringList.Create;     //Info request chain
  FSInfoChain := TStringList.Create;    //Short info request chain

  //Socket for working with TCP
  FSock := TICQNet.Create;
  FSock.OnError := OnIntError;

  FTimer := TMyTimer.Create;              //Timeout timer
  FTimer.OnTimer := OnTimeout;          //Set timeout event
  FTimer.Enabled := False;              //Disable timer by default

  Randomize;                            //Initialize random generator
  FSeq := Random($AAAA);                //Choose random seq, which is used in Flap header

  FDirect := nil;                       //Do not initialize direct control until we connect
end;

{*** DESTRUCTOR ***}
destructor TICQClient.Destroy;
begin
  if FDirect <> nil then
    FDirect.Free;

  FSock.OnConnectError := nil;
  FSock.OnConnectProc := nil;
  FSock.OnDisconnect := nil;
  FSock.OnError := nil;
  FSock.OnReceiveProc := nil;
  FSock.Free;

  FTimer.OnTimer := nil;
  FTimer.Free;

  //Free TStringList objects
  FContactLst.Free;
  FVisibleLst.Free;
  FInvisibleLst.Free;
  FInfoChain.Free;
  FSInfoChain.Free;

  inherited;
end;

{Set NetICQ's properties}
procedure TICQClient.InitNetICQ;
begin
  //Assign properties
  FSock.Host := FIp;
  FSock.Port := FPort;
  FSock.ProxyType := FProxyType;
  FSock.ProxyHost := FProxyHost;
  FSock.ProxyPort := FProxyPort;
  FSock.ProxyUserID := FUserID;
  FSock.ProxyAuth := FProxyAuth;
  FSock.ProxyPass := FProxyPass;
  FSock.UseProxyResolve := ProxyResolve;

  //Assign events
  FSock.OnHandlePkt := HandlePacket;
  FSock.OnDisconnect := FTOnDisconnect;
  FSock.OnConnectError := FTOnConnectError;
  FSock.OnPktParseA := FTOnPktParse;
end;

{Called when error happened.}
procedure TICQClient.OnIntError(Sender: TObject; ErrorType: TErrorType; ErrorMsg: String);
begin
  FLastError := ErrorMsg;
  if Assigned(OnError) then
    FOnError(Self, ErrorType, ErrorMsg);
end;

{Logins to server.}
procedure TICQClient.Login(Status: LongWord = S_ONLINE);
begin
  if FDirect <> nil then
  begin
    FDirect.OnError := nil;
    FDirect.OnHandle := nil;
    FDirect.OnPktDump := nil;
    FDirect.Free;
  end;

  if not DisableDirectConnections then
  begin
    FDirect := TDirectControl.Create(FLUIN);
    FDirect.OnPktDump := FTOnDirectParse;
    FDirect.OnHandle := HDirectMsg;
    FDirect.OnError := OnIntError;
    FDirect.OnFTInit := OnFTInitProc;
    FDirect.OnFTStart := OnFTStartProc;
    FDirect.OnFTFileData := OnFTFileDataProc;

    //Assign proxy settings
    FDirect.ProxyType := ProxyType;
    FDirect.ProxyHost := ProxyHost;
    FDirect.ProxyPort := ProxyPort;
    FDirect.ProxyUserID := ProxyUserID;
    FDirect.ProxyAuth := ProxyAuth;
    FDirect.ProxyPass := ProxyPass;
    FDirect.UseProxyResolve := ProxyResolve;
  end;


  FDSeq := Random(High(Word));
  FSeq2 := 2;
  FCookie := '';
  FFirstConnect := True;
  FStatus := Status;
  FLoggedIn := False;
  FRegisteringUIN := False;

  InitNetICQ;
  FTimer.Interval := FTimeout * 1000;
  FTimer.Enabled := False;
  if FTimeout <> 0 then
    FTimer.Enabled := True;
    
  FSock.Connect;
end;

{Registers a new UIN.}
procedure TICQClient.RegisterNewUIN(const Password: String);
begin
  FRegisteringUIN := True;
  FRegPassword := Password;
  FLoggedIn := False;
  InitNetICQ;
  FTimer.Interval := FTimeout * 1000;
  FTimer.Enabled := True;
  FSock.Connect;
end;

{Disconnect user from server.}
procedure TICQClient.Disconnect;
begin
  FTimer.Enabled := False;
  FSock.Disconnect;
  if Assigned(OnConnectionFailed) then
    FOnConnectionFailed(Self);
end;

{Send a message to UIN.}
procedure TICQClient.SendMessage(UIN: LongWord; const Msg: String);
var
  pkt: TRawPkt;
begin
  if not LoggedIn then Exit;
  CreateCLI_SENDMSG(@pkt, 0, Random($FFFFAA), UIN, Msg, FSeq);
  FSock.SendData(pkt, pkt.Len);
end;

{Send an URL message to UIN.}
procedure TICQClient.SendURL(UIN: LongWord; const URL, Description: String);
var
  pkt: TRawPkt;
begin
  if not LoggedIn then Exit;
  CreateCLI_SENDURL(@pkt, 0, Random($FFFFAA), FLUIN, UIN, URL, Description, FSeq);
  FSock.SendData(pkt, pkt.Len);
end;

{Adds UIN to contact list after logon(when you are online), UIN automaticly
added to ContactList TStrings. After adding the UIN you will receive status
notifications. Returns True when UIN is added to the list(it wasn't there before).}
function TICQClient.AddContact(UIN: LongWord): Boolean;
var
  pkt: TRawPkt;
begin
  Result := False;
  if FContactLst.IndexOf(IntToStr(UIN)) < 0 then
  begin
    FContactLst.Add(IntToStr(UIN));
    Result := True;
  end else
    Exit;
  if not LoggedIn then Exit;
  CreateCLI_ADDCONTACT(@pkt, IntToStr(UIN), FSeq);           {SNAC(x03/x04)}
  FSock.SendData(pkt, pkt.Len);
end;

{Removes UIN from contact list. Use while you are online.}
procedure TICQClient.RemoveContact(UIN: LongWord);
var
  idx: Integer;
  pkt: TRawPkt;
begin
  idx := FContactLst.IndexOf(IntToStr(UIN));
  if idx > -1 then
    FContactLst.Delete(idx);
  if not LoggedIn then Exit;
  CreateCLI_REMOVECONTACT(@pkt, UIN, FSeq);
  FSock.SendData(pkt, pkt.Len);
end;

{Removes UIN from the visible list. Use while you are online.}
procedure TICQClient.RemoveContactVisible(UIN: LongWord);
var
  idx: Integer;
  pkt: TRawPkt;
begin
  idx := FVisibleLst.IndexOf(IntToStr(UIN));
  if idx > -1 then
    FVisibleLst.Delete(idx);
  if not LoggedIn then Exit;
  CreateCLI_REMVISIBLE(@pkt, UIN, FSeq);
  FSock.SendData(pkt, pkt.Len);
end;

{Removes UIN from the invisible list. Use while you are online.}
procedure TICQClient.RemoveContactInvisible(UIN: LongWord);
var
  idx: Integer;
  pkt: TRawPkt;
begin
  idx := FInvisibleLst.IndexOf(IntToStr(UIN));
  if idx > -1 then
    FInvisibleLst.Delete(idx);
  if not LoggedIn then Exit;
  CreateCLI_REMINVISIBLE(@pkt, UIN, FSeq);
  FSock.SendData(pkt, pkt.Len);
end;

{Query info about UIN. As answer you will recieve theese events: OnUserWorkInfo,
OnUserInfoMore, OnUserInfoAbout, OnUserInfoInterests, OnUserInfoMoreEmails,
OnUserFound.}
procedure TICQClient.RequestInfo(UIN: LongWord);
var
  pkt: TRawPkt;
begin
  if not LoggedIn then Exit;
  FInfoChain.Values[IntToStr(FSeq2)] := IntToStr(UIN);  
  CreateCLI_METAREQINFO(@pkt, FLUIN, UIN, FSeq, FSeq2);
  FSock.SendData(pkt, pkt.Len);