?? icqclient.pas
字號:
property DisableDirectConnections: Boolean read FUseDirect write FUseDirect default False;
property ProxyType: TProxyType read FProxyType write FProxyType default P_NONE;
property ProxyHost: String read FProxyHost write FProxyHost;
property ProxyPort: Word read FProxyPort write FProxyPort;
property ProxyUserID: String read FProxyUser write FProxyUser;
property ProxyResolve: Boolean read FProxyResolve write FProxyResolve default False;
property ProxyAuth: Boolean read FProxyAuth write FProxyAuth default False;
property ProxyPass: String read FProxyPass write FProxyPass;
property UIN: LongWord read FLUIN write FLUIN;
property Password: String read FLPass write FLPass;
property ErrorLanguage: TICQLangType read FErrLang write SetErrorLang default LANG_EN;
property ICQServer: String read FIp write FIp;
property ICQPort: Word read FPort write FPort;
property PortRangeFirst: Word read GetPortFirst write SetPortFirst;
property PortRangeLast: Word read GetPortLast write SetPortLast;
property ConvertToPlaintext: Boolean read FDoPlain write FDoPlain;
property ContactList: TStrings read FContactLst write SetContactList;
property VisibleList: TStrings read FVisibleLst write SetVisibleList;
property InvisibleList: TStrings read FInvisibleLst write SetInvisibleList;
property AutoAwayMessage: String read FAutoAwayMsg write FAutoAwayMsg;
property OnLogin: TNotifyEvent read FOnLogin write FOnLogin;
property OnLogOff: TNotifyEvent read FOnLogOff write FOnLogOff;
property OnMessageRecv: TOnMsgProc read FOnMsg write FOnMsg;
property OnURLRecv: TOnURLProc read FOnURL write FOnURL;
property OnOfflineMsgRecv: TOnOffMsgProc read FOnOffMsg write FOnOffMsg;
property OnOfflineURLRecv: TOnOffURLProc read FOnOffURL write FOnOffURL;
property OnPktParse: TOnAdvPktParse read FOnPktParse write FOnPktParse;
property OnPktDirectParse: TOnParseDirectPkt read FOnDPktParse write FOnDPktParse;
property OnConnectionFailed: TNotifyEvent read FOnConnectionFailed write FOnConnectionFailed;
property OnStatusChange: TOnStatusChange read FOnStatusChange write FOnStatusChange;
property OnUserOffline: TOnUserEvent read FOnUserOffline write FOnUserOffline;
property OnAddedYou: TOnUserEvent read FOnAddedYou write FOnAddedYou;
property OnUserGeneralInfo: TOnUserGeneralInfo read FOnUserGeneralInfo write FOnUserGeneralInfo;
property OnUserWorkInfo: TOnUserWorkInfo read FOnUserWorkInfo write FOnUserWorkInfo;
property OnUserInfoMore: TOnUserInfoMore read FOnUserInfoMore write FOnUserInfoMore;
property OnUserInfoAbout: TOnUserInfoAbout read FOnUserInfoAbout write FOnUserInfoAbout;
property OnUserInfoInterests: TOnUserInfoInterests read FOnUserInfoInterests write FOnUserInfoInterests;
property OnUserInfoMoreEmails: TOnUserInfoMoreEmails read FOnUserInfoMoreEmails write FOnUserInfoMoreEmails;
property OnUserInfoBackground: TOnUserInfoBackground read FOnUserInfoBackground write FOnUserInfoBackground;
property OnUserFound: TOnUserFound read FOnUserFound write FOnUserFound;
property OnUserNotFound: TNotifyEvent read FOnUserNotFound write FOnUserNotFound;
property OnServerListRecv: TOnServerListRecv read FOnServerListRecv write FOnServerListRecv;
property OnAdvancedMsgAck: TOnAdvMsgAck read FOnAdvMsgAck write FOnAdvMsgAck;
property OnMsgAck: TOnMsgAck read FOnMsgAck write FOnMsgAck;
property OnNewUINRegistered: TOnUserEvent read FOnNewUINRegistered write FOnNewUINRegistered;
property OnNewUINRefused: TNotifyEvent read FOnNewUINRefused write FOnNewUINRefused;
property OnAutoMsgResponse: TOnAutoMsgResponse read FOnAutoMsgResponse write FOnAutoMsgResponse;
property OnUnregisterOk: TNotifyEvent read FOnUnregisterOk write FOnUnregisterOk;
property OnUnregisterBadPassword: TNotifyEvent read FOnUnregBadPass write FOnUnregBadPass;
property OnContactListRecv: TOnContactListRecv read FOnContactListRecv write FOnContactListRecv;
property OnContactListRequest: TOnContactListReq read FOnContactListReq write FOnContactListReq;
property OnDirectPacketAck: TOnDirectPktAck read FOnDirectPktAck write FOnDirectPktAck;
property OnSMSRefused: TNotifyEvent read FOnSmsRefused write FOnSmsRefused;
property OnSMSAck: TOnSMSAck read FOnSMSAck write FOnSMSAck;
property OnOnlineInfo: TOnOnlineInfo read FOnOnlineInfo write FOnOnlineInfo;
property OnError: TOnError read FOnError write FOnError;
property ConnectionTimeout: Byte read FTimeout write FTimeout;
property OnSMSReply: TOnSMSReply read FOnSMSReply write FOnSMSReply;
property OnInfoChanged: TOnInfoChanged read FOnInfoChanged write FOnInfoChanged;
property OnAuthorizationChangedOk: TNotifyEvent read FOnAuthSet write FOnAuthSet;
property OnAuthResponse: TOnAuthResponse read FOnAuthResponse write FOnAuthResponse;
property OnAuthRequest: TOnAuthRequest read FOnAuthReq write FOnAuthReq;
property OnSSLChangeResponse: TOnChangeResponse read FOnChangeResponse write FOnChangeResponse;
property OnFTRequest: TOnFTRequest read FOnFTRequest write FOnFTRequest;
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;
property OnUserInfoShort: TOnUserInfoShort read FOnUserInfoShort write FOnUserInfoShort;
end;
TMyTimer = class(TObject)
private
FInterval: LongWord;
FWindowHandle: THandle;
FOnTimer: TNotifyEvent;
FEnabled: Boolean;
FTag: Integer;
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;
FSocket := nil; FSendSocket := nil;
FHTTPBuffer := TNetBuffer.Create;
end;
{*** DESTRUCTOR ***}
destructor TICQNet.Destroy;
begin
FreeSocket(FSocket);
FreeSocket(FSendSocket);
FHTTPBuffer.Free;
inherited Destroy;
end;
procedure TICQNet._OnConnect(Sender: TObject);
begin
if FProxyType = P_HTTP then begin
if Sender = FSocket then begin
if not FHTTPConnected then begin
FHTTPConnected := True;
FSocket.SendStr(CreateHTTP_INIT(ProxyAuth, ProxyUser, ProxyPass))
end else
FSocket.SendStr(CreateHTTP_RECV(FHTTPIP, FHTTPSid, ProxyAuth, ProxyUser, ProxyPass));
end else begin
FCanSend := True;
SendHTTPData;
end;
end;
end;
procedure TICQNet._OnError(Sender: TObject; ErrorType: TErrorType; ErrorMsg: String);
begin
if Sender = FSocket then FreeSocket(FSendSocket) else FreeSocket(FSocket);
if Assigned(OnError) then
FOnError(Self, ErrorType, ErrorMsg);
if Assigned(OnConnectError) then
FOnConnectError(Self);
end;
procedure TICQNet._OnConnectError(Sender: TObject);
begin
if Sender = FSocket then FreeSocket(FSendSocket) else FreeSocket(FSocket);
if Assigned(OnConnectError) then
FOnConnectError(Self);
end;
procedure TICQNet._OnDisconnect(Sender: TObject);
begin
if Sender = FSocket then FreeSocket(FSendSocket) else FreeSocket(FSocket);
if Assigned(OnDisconnect) then
FOnDisconnect(Self);
end;
procedure TICQNet._OnReceive(Sender: TObject; Buffer: Pointer; BufLen: LongWord);
begin
if Sender = FSocket then begin
if ProxyType <> P_HTTP then
HandleFlapData(Buffer, BufLen)
else begin
{$IFDEF HTTP_DEBUG}
LogText('http.txt', 'Received (proxy): '#13#10 + DumpPacket(Buffer, BufLen) + #13#10#13#10);
{$ENDIF}
HandleHTTPData(Buffer, BufLen);
HTTPReconnect;
end;
end else begin
{$IFDEF HTTP_DEBUG}
LogText('http.txt', 'Received (send-proxy): '#13#10 + PChar(Buffer));
{$ENDIF}
FCanSend := False;
HTTPResend;
end;
end;
procedure TICQNet._OnDataSent(Sender: TObject);
begin
end;
procedure TICQNet.SendHTTPData;
var
Len: LongWord;
Buffer: array[0..$FFFF-1] of Byte;
Pkt: TRawPkt;
begin
if (FCanSend) then begin
if FHTTPFirstResend then begin
CreateHTTP_LOGIN(@pkt, Host, Port);
Inc(FHTTPSeq);
FSendSocket.SendStr(CreateHTTP_Header('POST', 'http://' + FHTTPIP + '/data?sid=' + FHTTPSid + '&seq=' + IntToStr(FHTTPSeq), FHTTPIP, pkt.Len + 14, ProxyAuth, ProxyUser, ProxyPass));
CreateHTTP_DATA_HDR(@pkt, 3, pkt.Len);
FSendSocket.SendData(@pkt, pkt.Len);
CreateHTTP_LOGIN(@pkt, Host, Port);
FSendSocket.SendData(@pkt, pkt.Len);
FHTTPFirstResend := False;
FHTTPBuffer.Enter;
FHTTPBuffer.Clear;
FHTTPBuffer.Leave;
end;
FHTTPBuffer.Enter;
Len := FHTTPBuffer.GetLength;
if Len > 0 then begin
Inc(FHTTPSeq);
FSendSocket.SendStr(CreateHTTP_Header('POST', 'http://' + FHTTPIP + '/data?sid=' + FHTTPSid + '&seq=' + IntToStr(FHTTPSeq), FHTTPIP, Len + 14, ProxyAuth, ProxyUser, ProxyPass));
if FHTTPFirstResend then begin
end else
CreateHTTP_DATA_HDR(@pkt, 5, Len);
{$IFDEF HTTP_DEBUG}
LogText('http.txt', 'SENDING: '#13#10 + DumpPacket(@pkt, pkt.Len) + #13#10#13#10);
{$ENDIF}
FSendSocket.SendData(@pkt, pkt.Len);
Len := FHTTPBuffer.GetPacket(@Buffer);
while Len > 0 do begin
{$IFDEF HTTP_DEBUG}
LogText('http.txt', 'SENDING: '#13#10 + DumpPacket(@Buffer, Len) + #13#10#13#10);
{$ENDIF}
FHTTPBuffer.DelPacket;
FSendSocket.SendData(@Buffer, Len);
Len := FHTTPBuffer.GetPacket(@Buffer);
end;
FCanSend := False;
end;
FHTTPBuffer.Leave;
end;
end;
procedure TICQNet.HTTPReconnect;
begin
FreeSocket(FSocket);
FSocket := THTTPSocket.Create;
FSocket.ProxyHost := FProxyHost;
FSocket.ProxyPort := FProxyPort;
FSocket.Host := FHTTPIP;
FSocket.Port := FHTTPPort;
FSocket.ProxyReady := False;
FSocket.ProxyUser := FProxyUser;
FSocket.ProxyPass := FProxyPass;
FSocket.ProxyAuth := FProxyAuth;
FSocket.ProxyResolve := FProxyResolve;
FSocket._OnConnect := _OnConnect;
FSocket._OnError := _OnError;
FSocket._OnConnectError := _OnConnectError;
FSocket._OnDisconnect := _OnDisconnect;
FSocket._OnReceive := _OnReceive;
FSocket.ErrorLanguage := FErrLang;
FSocket.Connect;
{$IFDEF HTTP_DEBUG}
LogText('http.txt', 'Initializing RECV thread...' + #13#10#13#10);
{$ENDIF}
end;
procedure TICQNet.HTTPResend;
begin
FreeSocket(FSendSocket);
FSendSocket := THTTPSocket.Create;
FSendSocket.ProxyHost := FProxyHost;
FSendSocket.ProxyPort := FProxyPort;
FSendSocket.Host := FHTTPIP;
FSendSocket.Port := FHTTPPort;
FSendSocket.ProxyReady := False;
FSendSocket.ProxyUser := FProxyUser;
FSendSocket.ProxyPass := FProxyPass;
FSendSocket.ProxyAuth := FProxyAuth;
FSendSocket.ProxyResolve := FProxyResolve;
FSendSocket._OnConnect := _OnConnect;
FSendSocket._OnError := _OnError;
FSendSocket._OnConnectError := _OnConnectError;
FSendSocket._OnDisconnect := _OnDisconnect;
FSendSocket._OnReceive := _OnReceive;
FSendSocket._OnDataSent := _OnDataSent;
FSendSocket.ErrorLanguage := FErrLang;
FSendSocket.Connect;
{$IFDEF HTTP_DEBUG}
LogText('http.txt', 'Initializing SEND thread...' + #13#10#13#10);
{$ENDIF}
end;
procedure TICQNet.HandleHTTPDataPak(Buffer: Pointer; BufLen: LongWord);
var
pkt: TRawPkt;
ptype: Word;
sw: LongWord;
begin
Move(Buffer^, pkt.Data, BufLen);
pkt.Len := 0;
GetInt(@pkt, 2); //Version
ptype := GetInt(@pkt, 2);
Inc(pkt.Len, 6);
case ptype of
2 {HELLO REPLY}:
begin
FHTTPSeq := 0;
sw := GetInt(@pkt, 4); FHTTPSid := IntToHex(sw, 8);
sw := GetInt(@pkt, 4); FHTTPSid := FHTTPSid + IntToHex(sw, 8);
sw := GetInt(@pkt, 4); FHTTPSid := FHTTPSid + IntToHex(sw, 8);
sw := GetInt(@pkt, 4); FHTTPSid := FHTTPSid + IntToHex(sw, 8);
FHTTPSid := LowerCase(FHTTPSid);
FHTTPIP := GetWStr(@pkt);
FHTTPPort := GetLInt(@pkt, 2);
{FHTTPBuffer.Enter;
//FHTTPBuffer.Clear;
FHTTPBuffer.AddPacket(@pkt, pkt.Len);
FHTTPBuffer.Leave;}
FHTTPFirstResend := True;
HTTPResend; {Initialize send connection}
end;
5 {FLAP PACKETS}: begin
HandleFlapData(Ptr(LongWord(@pkt.Data) + pkt.Len + 2), BufLen - pkt.Len - 2);
end;
7: begin
FreeSockets;
if Assigned(OnError) then
FOnError(Self, ERR_PROXY, ICQLanguages[FErrLang].Translate(IMSG_EHTTP_INIT));
end;
end;
end;
procedure TICQNet.HandleHTTPData(Buffer: Pointer; BufLen: LongWord);
var
Len: Word;
Buf: TRawPkt;
l: LongWord;
begin
l := 0;
while True do
begin
if l = BufLen then Break;
Len := Swap16(PWord(Buffer)^);
if (Len > 8192) or (Len < 12) then Break;
Move(Ptr(LongWord(Buffer) + 2)^, Buf, Len);
Inc(l, Len + 2);
Buffer := Ptr(LongWord(Buffer) + Len + 2);
{Handle ICQ Pak packet}
HandleHTTPDataPak(@Buf, Len);
end;
end;
procedure TICQNet.HandleFlapData(Buffer: Pointer; BufLen: LongWord);
var
i, len: LongWord;
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -