?? icqdirect2.pas
字號:
unit ICQDirect2;
{************************************************
For updates checkout: http://www.cobans.net
(C) Alex Demchenko(alex@ritlabs.com)
Gene Reeves(notgiven2k@lycos.com)
*************************************************}
{ Created on 01-2003}
{$HINTS OFF}
interface
//****************************************************************************//
// TicqDCM - Direct Connection Manager //
// Supplies interface to ICQClient for managing DCs. //
// //
// TicqBaseDC - Base class for direct connection //
// Handles all common tasks in a DC //
// //
// TicqDCxxxx - Direct Connection Handler classes //
// TicqDCNormal - Main DC class used for Msg, File Req, Chat Req, etc. //
// TicqDCRecvFile - DC class used to receive files. //
// TicqDCSendFile - DC class used to send files //
// TicqDCChat - DC class used for chat sessions. //
// //
//****************************************************************************//
// To Add New DC Type: //
// //
// 1. Create new subclass of TicqBaseDC. //
// 2. Implement Start, Stop and HandlePacket routines in new subclass. //
// 3. Add interface routines to TicqDCM for needed functionality. //
// //
//****************************************************************************//
// {ToDo}
// Need to add proxy support back into DC's
// must be done in ICQSock.pas.
// Need to finish TicqDCChat class
Uses
Classes, Sysutils, ICQWorks, ICQSock, WinSock, Windows;
Type
PicqDirectUser = ^TicqDirectUser;
TicqDirectUser = record
UIN, Cookie,
ExtIP, IntIP: LongWord;
Port:Word;
IsConnected:Boolean;
LastActivity: LongWord; // Last tickcount of activity
DCMain,
DCRecvFile,
DCSendFile,
DCChat:Integer
End;
TDirectUser = TicqDirectUser;
TicqBaseDC = class;
TicqDCnormal = Class;
//TicqEventType = (ET_NORMAL, ET_FILE_RECV, ET_FILE_SEND, ET_CHAT);
TicqDCEvent = Procedure(Sender: TicqBaseDC) of Object;
TOnHandle = procedure(Sender: TObject; UIN: LongWord; Pak: PRawPkt; Len: LongWord) of object;
TOnParseDirectPkt = procedure(Sender: TObject; Buffer: Pointer; BufLen: LongWord; Incoming: Boolean; UIN:Cardinal) of object;
//Direct Connection Manager
TicqDCM = Class(TObject)
Private
fSrv:TSrvSocket;
fTmpDC:TicqDCNormal;
fPort:Word;
fProxyType: TProxyType;
fProxyHost: String;
fProxyPort: Word;
fProxyAuth: Boolean;
fProxyPass: String;
fUserID: String;
fResolve: Boolean;
fOnError: TOnError;
fOnPktDump: TOnParseDirectPkt;
fOnHandle:TOnHandle;
fOnFTInit: TOnFTInit;
fOnFTStart: TOnFTStart;
fOnFTFileData: TOnFTFileData;
fOnSendFileStart:TOnSendFileStart;
fOnSendFileData:TOnSendFileData;
fOnSendFileFinish:TOnSendFileFinish;
fpUser:PicqDirectUser;
fDestroying:Boolean;
fTmrIdle:TThreadTimer;
procedure InternalOnErrorProc(Sender: TObject; ErrorType: TErrorType; ErrorMsg: String); virtual;
procedure InternalOnPktDump(Sender: TObject; Buffer: Pointer; BufLen: LongWord; Incoming: Boolean; UIN: Cardinal);
procedure InternalOnHandle(Sender: TObject; UIN: LongWord; Pak: PRawPkt; Len: LongWord);
procedure OnIdleTimeOut(Sender: TObject);
procedure OnSrvSockConnect(Sender: TObject; Socket: TMySocket);
Public
MyUIN:LongWord;
fDCL:TList; // List of DC's
fUL:TList; // List of User DC Info.
constructor Create(aMyUIN: LongWord);
destructor Destroy; override;
Function ExtIP:LongWord;
Function IntIP:LongWord;
procedure AddUser(aUIN, aCookie, aIPExt, aIPInt: LongWord; aPort: Word);
Function GetUserIndex(aUIN:LongWord; Var Idx:integer):Boolean;
Procedure HandleDCEvent(Sender: TicqBaseDC);
Function SendData(aUIN:LongWord; pPkt: PRawPkt):Boolean;
function SendDataFile(aUIN: LongWord; Pak: PRawPkt): Boolean;
Procedure DeleteUser(aUIN: LongWord);
Procedure DeleteDC(Var aIndex:Integer);
function AddFileUser(aUIN: LongWord; var aPort: Word; FTReqRec:Pointer = nil): Boolean;
Procedure SetFileRecord(aUIN: LongWord; aFileRec:TSendFileRec);
Function AddSendFileUser(aUIN:LongWord; Var aPort, aSeq:Word):Boolean;
function StopFileReceiving(aUIN: LongWord): Boolean;
Procedure StopFileSending(aUIN: LongWOrd);
procedure EstabilishConnection(aUIN: LongWord);
function ConnectionEstabilished(aUIN: LongWord): Boolean;
property BindPort: Word read FPort;
property ProxyType: TProxyType read FProxyType write FProxyType;
property ProxyHost: String read FProxyHost write FProxyHost;
property ProxyPort: Word read FProxyPort write FProxyPort;
property ProxyUserID: String read FUserID write FUserID;
property ProxyAuth: Boolean read FProxyAuth write FProxyAuth;
property ProxyPass: String read FProxyPass write FProxyPass;
property UseProxyResolve: Boolean read FResolve write FResolve default False;
Property pUser:PicqDirectUser read fpUser;
property OnPktDump: TOnParseDirectPkt read FOnPktDump write FOnPktDump;
property OnHandle: TOnHandle read FOnHandle write FOnHandle;
property OnError: TOnError read FOnError write FOnError;
property OnFTInit: TOnFTInit read FOnFTInit write FOnFTInit;
property OnFTStart: TOnFTStart read FOnFTStart write FOnFTStart;
property OnFTFileData: TOnFTFileData read FOnFTFileData write FOnFTFileData;
Property OnSendFileStart:TonSendFileStart read FOnSendFileStart write FOnSendFileStart;
Property OnSendFileData:TOnSendFileData read fOnSendFileData write fOnSendFileData;
Property OnSendFileFinish:TOnSendFileFinish read fOnSendFileFinish write fOnSendFileFinish;
End;
TDirectControl = Class(TicqDCM);
TDirectClient = TDirectControl;
//Base Direct Connection Type
TicqBaseDC = Class(TObject)
Protected
fManager:TicqDCM;
fOnDCEvent:TicqDCEvent;
fRemUIN:LongWord;
FPort:Word;
fIncoming:Boolean;
FProxyType: TProxyType;
FProxyHost: String;
FProxyPort: Word;
FProxyAuth: Boolean;
FProxyPass: String;
FUserID: String;
FResolve: Boolean;
FOnError: TOnError;
FOnPktDump: TOnParseDirectPkt;
fOnHandle: TOnHandle;
fpUser: PicqDirectUser;
CSck:TMySocket;
SSck:TSrvSocket;
fDPkt:TRawPkt;
fPktLen:Integer;
fPktSize:Integer;
procedure SetCSck(aSock:TMySocket);
procedure OnSockError(Sender: TObject);
procedure OnSockConnectError(Sender: TObject);
procedure OnConnect(Sender: TObject);
procedure OnReceive(Sender: TObject; Socket: TSocket; Buffer: Pointer; BufLen: LongWord);
procedure OnIntPktDump(Sender: TObject; Buffer: Pointer; BufLen: LongWord; Incoming: Boolean; UIN: Cardinal);
procedure OnIntError(Sender: TObject; ErrorType: TErrorType; ErrorMsg: String); virtual;
Public
EventType:Integer;
MyUIN:LongWord;
constructor Create(aMyUIN: LongWord);
destructor Destroy; override;
Function Start:Boolean;Virtual;abstract; //Used to start connection.
Procedure Stop;Virtual;abstract; //Used to stop connection.
Function SendData(Pkt: PRawPkt):Boolean;Virtual; // Used to Send Data through Connection.
Function HandlePacket(pPkt: PRawPkt; PktLen:Integer):Boolean;Virtual;
Property Client:TMySocket Read CSck write SetCSck;
Property RemoteUIN:LongWord read fRemUIN write fRemUIN;
property BindPort: Word read FPort;
property ProxyType: TProxyType read FProxyType write FProxyType;
property ProxyHost: String read FProxyHost write FProxyHost;
property ProxyPort: Word read FProxyPort write FProxyPort;
property ProxyUserID: String read FUserID write FUserID;
property ProxyAuth: Boolean read FProxyAuth write FProxyAuth;
property ProxyPass: String read FProxyPass write FProxyPass;
property UseProxyResolve: Boolean read FResolve write FResolve default False;
Property OnDCEvent:TicqDCEvent read fOnDCEvent write fOnDCEvent;
property OnPktDump: TOnParseDirectPkt read FOnPktDump write FOnPktDump;
property OnHandle: TOnHandle read fOnHandle write fOnHandle;
property OnError: TOnError read FOnError write FOnError;
End;
// DC for Main DC
TicqDCNormal = Class(TicqBaseDC)
Private
Public
Constructor Create(aMyUIN: LongWord; aClient: TMySocket; Incoming:Boolean);
Function Start:Boolean;override;
Procedure Stop;override;
Function HandlePacket(pPkt: PRawPkt; PktLen:Integer):Boolean; Override;
End;
// DC for Recv File
TicqDCRecvFile = Class(TicqBaseDC)
private
fSrvConnected:Boolean;
Procedure OnRFSrvSockConnect(Sender: TObject; Socket: TMySocket);
Public
PDataPacket:PRawPkt;
DataPacketLen:LongWord;
IsLastPacket:Boolean;
TotalBytes:LongWord;
NickName:String;
FTStartRec:TFTStartRec;
FTRequestRec:TFTRequestRec;
FTPos:LongWord;
Constructor Create(MyUIN, aUIN: LongWord; aPort:Dword);
Function Start:Boolean;override;
Procedure Stop;override;
Function HandlePacket(pPkt: PRawPkt; PktLen:Integer):Boolean; Override;
End;
// DC for Send File
TicqDCSendFile = Class(TicqBaseDC)
Private
tmrSend:TThreadTimer;
fPeerReady:Boolean;
fRemPort:DWord;
fSeq:Word;
fPkt:TRawPkt;
fConnectionFinished: Boolean;
fTransfering:Boolean;
fAborted:Boolean;
procedure OnSFConnect(Sender: TObject);
procedure OnSFDisconnect(Sender: TObject);
procedure OnSendTimer(Sender: TObject);
Procedure OnDataSent(Sender: TObject);
Public
PDataPacket:PRawPkt;
DataPacketLen:LongWord;
IsLastPacket:Boolean;
SendFileRecord:TSendFileRec;
Constructor Create(MyUIN, aUIN: LongWord; aFileRec:TSendFileRec);
Destructor Destroy;override;
Function Start:Boolean;override;
Procedure Stop;override;
Function HandlePacket(pPkt: PRawPkt; PktLen:Integer):Boolean; Override;
Property Aborted:Boolean read fAborted;
End;
// DC for chat
TicqDCChat = Class(TicqBaseDC)
Private
Public
End;
Const
// PEER Commands
PEER_INIT = $FF;
PEER_INIT2 = $03;
PEER_MSG = $02;
PEER_FILE_INIT = $00;
PEER_FILE_INITACK= $01;
PEER_FILE_DATA = $06;
//Event Types
DCEVENT_OnFTInit = $0002;
DCEVENT_OnFTStart = $0004;
DCEVENT_OnFTFileData = $0008;
DCEVENT_OnSendFileStart = $0020;
DCEVENT_OnSendFileData = $0040;
DCEVENT_OnSendFileFinish= $0080;
// Idle Timeout
MAXTICKS_TIMEOUT = 18*60*60*5; { 5 min in ticks = 18 ticks per sec, 60 sec per min, 5 min}
ResourceString
RS_ERROR_BUFFEROVERRUN = 'Buffer Overrun Error';
RS_ERROR_NO_DC_WRONGVER = 'Can not estabilish direct connection due to client using an unsupported protocol version.';
RS_ERROR_NO_DC_SECURITY = 'Can not estabilish direct connection due to security issues.';
RS_ERROR_NO_DC_UNSUPPORTEDPROXY = 'Can not estabilish direct connection due to client using an unsupported proxy type.';
RS_ERROR_NO_DC_PACKETERROR = 'Can not estabilish direct connection due to Packet Error.';
implementation
Procedure GiveUpCpuTime;
var
Msg: TMsg;
begin
While PeekMessage(Msg, 0, 0, 0, PM_REMOVE) Do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
End;
procedure FreeAndNil(var Obj);
var
P: TObject;
begin
P := TObject(Obj);
TObject(Obj) := nil;
P.Free;
end;
Function IPToStr(aIP:LongWord):String;
Var
HV:String;
Begin
HV := IntToHex(aIP, 8);
Result := '';
Result := IntToStr(HexToInt(Copy(HV, 7, 2))) + '.';
Result := Result + IntToStr(HexToInt(Copy(HV, 5, 2)))+ '.';
Result := Result + IntToStr(HexToInt(Copy(HV, 3, 2))) + '.';
Result := Result + IntToStr(HexToInt(Copy(HV, 1, 2)));
End;
//****************************************************************************//
{ TicqDCM }
constructor TicqDCM.Create(aMyUIN: LongWord);
Begin
inherited Create;
fDestroying := False;
fUL := TList.Create;
fDCL := TList.Create;
MyUIN := aMyUin;
fPort := FindBindPort;
GetMem(fpUser, SizeOf(TicqDirectUser));
With fpUser^ Do Begin
UIN := MyUIN;
Port := fPort;
ExtIP := LongWord(GetLocalIP);
IntIP := LongWord(GetLocalIP);
LastActivity := GetTickCount;
DCMain := -1;
DCRecvFile := -1;
DCSendFile := -1;
DCChat := -1;
End;
fSrv := TSrvSocket.Create;
fOnError := Nil;
fOnPktDump := Nil;
fOnHandle := Nil;
// idle timeout timer (fires once a sec and checks for nonactivity for MAXTICKS_TIMEOUT)
fTmrIdle := TThreadTimer.Create;
fTmrIdle.Interval := 1000;
fTmrIdle.OnTimer := OnIdleTimeOut;
fTmrIdle.Enabled := True;
fSrv.OnClientConnected := OnSrvSockConnect;
fSrv.StartServer(fPort);
End;
destructor TicqDCM.Destroy;
Begin
fTmrIdle.Enabled := False;
fTmrIdle.OnTimer := nil;
fTmrIdle.Free;
If fDestroying then Exit;
fDestroying := True;
fSrv.OnClientConnected := nil;
fSrv.StopServer;
fSrv.Free;
While fUL.Count > 0 do
DeleteUser(PicqDirectUser(fUL.items[0])^.UIN);
fUL.Free;
fDCL.Free;
FreeMemory(fpUser);
End;
Procedure TicqDCM.OnIdleTimeOut(Sender: TObject);
Var
i:integer;
aTC:LongWord;
Begin
If fUL.Count = 0 then Exit;
aTC := GetTickCount - MAXTICKS_TIMEOUT;
For i := 0 to fUL.Count -1 Do
With PicqDirectUser(fUL[i])^ Do
If LastActivity < aTC then Begin
if DCMain <> -1 then
DeleteDC(DCMain);
End;
End;
Function TicqDCM.ExtIP:LongWord;
Begin
Result := fpUser^.ExtIP;
End;
Function TicqDCM.IntIP:LongWord;
Begin
Result := fpUser^.IntIP;
End;
procedure TicqDCM.OnSrvSockConnect(Sender: TObject; Socket: TMySocket);
Begin
// Using Temp DC until recv PEER_INIT with user info.
fTmpDC := TicqDCNormal.Create(0,Socket, True);
GetMem(fTmpDC.fpUser, SizeOf(TicqDirectUser));
fTmpDC.MyUIN := MyUin;
fTmpDC.fManager := Self;
fTmpDC.fRemUIN := 0;
With fTmpDC.fpUser^ Do Begin
UIN := 0;
DCMain := -1;
DCRecvFile := -1;
DCSendFile := -1;
DCChat := -1;
End;
// Proxy Settings
fTmpDC.FProxyType := ProxyType;
fTmpDC.FProxyHost := ProxyHost;
fTmpDC.FProxyPort := ProxyPort;
fTmpDC.FProxyAuth := ProxyAuth;
fTmpDC.FProxyPass := ProxyPass;
fTmpDC.FUserID := FUserID;
fTmpDC.FResolve := FResolve;
fTmpDC.UseProxyResolve := UseProxyResolve;
// Events
fTmpDC.FOnError := InternalOnErrorProc;
fTmpDC.FOnPktDump := InternalOnPktDump;
fTmpDC.fOnHandle := InternalOnHandle;
fTmpDC.fOnDCEvent := HandleDCEvent;
fpUser^.DCMain := fDCL.Add(fTmpDC); // Add Connection to List
End;
procedure TicqDCM.InternalOnErrorProc(Sender: TObject; ErrorType: TErrorType; ErrorMsg: String);
Begin
If Assigned(fOnError) then
fOnError(Sender, ErrorType, ErrorMsg);
End;
procedure TicqDCM.InternalOnPktDump(Sender: TObject; Buffer: Pointer; BufLen: LongWord; Incoming: Boolean; UIN: Cardinal);
Begin
If assigned(fOnPktDump) then
fOnPktDump(Sender, Buffer, BufLen, Incoming, UIN);
End;
procedure TicqDCM.InternalOnHandle(Sender: TObject; UIN: LongWord; Pak: PRawPkt; Len: LongWord);
Begin
If Assigned(fOnHandle) then
fOnHandle(Sender, UIN, Pak, Len);
End;
Procedure TicqDCM.HandleDCEvent(Sender: TicqBaseDC);
Var
dcRF:TicqDCRecvFile;
dcSF:TicqDCSendFile;
Begin
// Handle Event From one of the DC's
Case Sender.EventType Of
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -