icqsock.pas

本程序是转载的

      if S[i] = ' ' then Inc(c);
end;

{ TMySocket }
constructor TMySocket.Create;
Begin
  Inherited Create;
  FEventSocket := TEventSocket.Create;
  FEventSocket._OnConnectError := OnConnectErrorProc;
  FEventSocket._OnConnect      := OnConnect;
  FEventSocket._OnDisconnect   := OnDisconnectProc;
  FEventSocket._OnError        := OnErrorProc;
  FEventSocket._OnReceive      := OnReceive;
  FEventSocket._OnDataSent     := OnDataSentProc;
  fSocket := INVALID_SOCKET;
End;

destructor TMySocket.Destroy;
Begin
  FEventSocket.Free;
End;

Procedure TMySocket.OnConnectErrorProc(Sender: TObject);
Begin
  If Assigned(fOnConnectError) then
    fOnConnectError(Self);
End;

Procedure TMySocket.OnDisconnectProc(Sender: TObject);
Begin
  If Assigned(fOnDisconnect) then
    fOnDisconnect(Self);
  fEventSocket.FreeSocket;
End;

Procedure TMySocket.OnConnect(Sender: TObject);
Begin
  If Assigned(FOnConnectProc) then
    fOnConnectProc(Self);
End;

Procedure TMySocket.OnErrorProc(Sender: TObject; ErrorType: TErrorType; ErrorMsg: String);
Begin
  If Assigned(fOnError) then
    fOnError(Self, ErrorType, ErrorMsg);
End;

Procedure TMySocket.OnReceive(Sender: TObject; Buffer: Pointer; BufLen: LongWord);
Begin
  If Assigned(fOnRecv) then
    fOnRecv(Self, ClientSocket, Buffer, BufLen);
End;

Procedure TMySocket.OnDataSentProc(Sender: TObject);
Begin
  If Assigned(fOnDataSent) then
    fOnDataSent(Self);
End;

function TMySocket.GetClientSocket: TSocket;
Begin
  If FSocket = INVALID_SOCKET then
    Result := FEventSocket.FSocket
  Else
    Result := FSocket;
End;

procedure TMySocket.SetClientSocket(Socket: TSocket);
Begin
  fSocket := Socket;
  fEventSocket.ProxyReady := True;
  FEventSocket.StartWork(fSocket);

End;

function TMySocket.IsConnected: Boolean;
Begin
  Result := FEventSocket.Connected;
End;

procedure TMySocket.Connect;
Begin
  If FEventSocket.Connected Then exit;
  FEventSocket.Host := fHost;
  FEventSocket.Port := fPort;

  FEventSocket.ProxyReady := True;
  FEventSocket.ProxyHost  := fHost;
  FEventSocket.ProxyPort  := fPort;

  FEventSocket.Connect;
End;

procedure TMySocket.Disconnect;
Begin
  If Not FEventSocket.Connected then Exit;
  FEventSocket.FreeSocket;
End;

procedure TMySocket.SendData(var Buf; BufLen: LongWord);
Begin
  FEventSocket.SendData(@Buf, BufLen);
End;

Procedure TMySocket.SetHost( aHost: String);
Begin
  FEventSocket.Host := aHost;
End;

Procedure TMySocket.SetPort( aPort: Word);
Begin
  FEventSocket.Port := aPort
End;

Function  TMySocket.GetHost: String;
Begin
  Result := FEventSocket.Host;
End;

Function  TMySocket.GetPort: Word;
Begin
  Result := FEventSocket.Port;
End;

Procedure TMySocket.SetProxyType( aProxyType: TProxyType);
Begin
  //
End;

Procedure TMySocket.SetProxyHost( aProxyHost: String);
Begin
  FEventSocket.ProxyHost := aProxyHost;
End;

Procedure TMySocket.SetProxyPort( aProxyPort: Word);
Begin
  FEventSocket.ProxyPort := aProxyPort;
End;

Procedure TMySocket.SetProxyAuth( aProxyAuth: Boolean);
Begin
  FEventSocket.ProxyAuth := aProxyAuth;
End;

Procedure TMySocket.SetProxyPass( aProxyPass: String);
Begin
  FEventSocket.ProxyPass := aProxyPass;
End;

Procedure TMySocket.SetProxyUser( aProxyUser: String);
Begin
  FEventSocket.ProxyUser := aProxyUser;
End;

Procedure TMySocket.SetProxyRslv( aProxyRslv: Boolean);
Begin
  FEventSocket.ProxyResolve := aProxyRslv;
End;

Function  TMySocket.GetProxyType: TProxyType;
Begin
  Result := P_NONE;
End;

Function  TMySocket.GetProxyHost: String;
Begin
  Result := FEventSocket.ProxyHost;
End;

Function  TMySocket.GetProxyPort: Word;
Begin
  Result := FEventSocket.ProxyPort;
End;

Function  TMySocket.GetProxyAuth: Boolean;
Begin
  Result := FEventSocket.ProxyAuth;
End;

Function  TMySocket.GetProxyPass: String;
Begin
  Result := FEventSocket.ProxyPass;
End;

Function  TMySocket.GetProxyUser: String;
Begin
  Result := FEventSocket.ProxyUser;
End;

Function  TMySocket.GetProxyRslv: Boolean;
Begin
  Result := FEventSocket.ProxyResolve;
End;

{ TSrvSocket }
constructor TSrvSocket.Create;
Begin
  inherited Create;
  fSrv := TServerSocket.Create;
  //fSrv.OnConnected := OnCliConnProc;
  fSrv.FreeOnTerminate    := False;
  fSrv._OnClientConnected := OnSrvConnProc;
  fSrv._OnError           := OnSrvErrProc;
  fIsListening := False;
End;

destructor TSrvSocket.Destroy;
Begin
  fSrv.FreeOnTerminate := True;
  StopServer;
  inherited Destroy;
End;

procedure TSrvSocket.OnSrvErrProc(Sender: TObject; ErrorType: TErrorType; ErrorMsg: String);
Begin
  If assigned(fOnError) then
    fOnError(Sender, ErrorType, ErrorMsg);
End;

procedure TSrvSocket.OnSrvConnProc(Sender: TObject; Socket: TSocket);
Var
  aMS:TMySocket;
Begin
  If Assigned(fOnClientConnected) then Begin
    aMS := TMySocket.Create;
    aMS.ProxyType := P_None;
    aMS.ClientSocket := Socket;
    fOnClientConnected(Self, aMS);
  End;
End;

function TSrvSocket.GetPort:Word;
Begin
  Result := fSrv.Port;
End;

procedure TSrvSocket.SetPort( aPort: Word);
Begin
  fSrv.Port := aPort;
  fPort := aPort;
End;

function TSrvSocket.StartServer(Port: Word): Boolean;
Begin
  fSrv.Port := Port;
  fPort := Port;
  Result := fSrv.Start;
  fIsListening := Result;
End;

function TSrvSocket.StopServer: Boolean;
Begin
  fSrv.FreeSocket;
  fIsListening := False;
  Result := True;
End;

{ TServerSocket }

procedure TServerSocket.OnClientConnected;
Begin
  If assigned(fOnCliConn) then
    Synchronize(DoConnEvent);
End;

procedure TServerSocket.DoConnEvent;
Begin
  fOnCliConn(Self, fClient);
End;

constructor TNetBuffer.Create;
begin
  inherited Create;
  FPkt := nil;
  Shared := 0;
end;

destructor TNetBuffer.Destroy;
begin
  Clear;
  if Shared = 1 then DeleteCriticalSection(CS);
  inherited;
end;

{Swap pointers}
procedure XChg(var Critical, Normal); assembler;
asm
  mov  ecx, [edx]
  xchg [eax], ecx
  mov  [edx], ecx
end;

procedure TNetBuffer.Enter; {Synchronization - enter critical section}
var
  j: Integer;
begin
  j := 1; XChg(Shared, j); if j = 0 then InitializeCriticalSection(CS);
  EnterCriticalSection(CS);
end;

procedure TNetBuffer.Leave; {Synchronization - leave critical section}
begin
  LeaveCriticalSection(CS);
end;

procedure TNetBuffer.Clear;
var
  p: Pointer;
begin
  while FPkt <> nil do begin
    p := FPkt^.Next;
    FreeMem(FPkt);
    FPkt := p;
  end;
end;

procedure TNetBuffer.AddPacket(Buffer: Pointer; BufLen: LongWord);
var
  p: PNetPacket;
begin
  if BufLen > CNetPktLen then BufLen := CNetPktLen;
  if FPkt = nil then begin
    GetMem(FPkt, SizeOf(TNetPacket));
    p := FPkt;
  end else begin
    p := FPkt;
    while p <> nil do begin
      if p^.Next = nil then Break;
      p := p^.Next;
    end;
    GetMem(p^.Next, SizeOf(TNetPacket));
    p := p^.Next;
  end;
  p^.BufLen := BufLen;
  p^.Offset := 0;
  p^.Next := nil;
  Move(Buffer^, p^.Buf, BufLen);
end;

procedure TNetBuffer.DelPacket;
var
  p: PNetPacket;
begin
  if (FPkt = nil) then Exit;
  if FPkt^.Next <> nil then
  begin
    p := FPkt^.Next;
    FreeMem(FPkt);
    FPkt := p;
  end else
  begin
    FreeMem(FPkt);
    FPkt := nil;
  end;
end;

function TNetBuffer.GetPacket(Buffer: Pointer): LongWord;
begin
  if (FPkt = nil) or (FPkt^.Offset >= FPkt^.BufLen) then
    Result := 0
  else begin
    Move(Ptr(LongWord(@FPkt^.Buf) + FPkt^.Offset)^, Buffer^, FPkt^.BufLen - FPkt^.Offset);
    Result := FPkt^.BufLen - FPkt^.Offset;
  end;
end;

function TNetBuffer.SkipData(Len: Word): Boolean;
begin
  if FPkt = nil then
    Result := True
  else begin
    Inc(FPkt^.Offset, Len);
    Result := FPkt^.Offset >= FPkt^.BufLen;
  end;
end;

procedure TNetBuffer.AddStr(const Value: String);
begin
  AddPacket(@Value[1], Length(Value));
end;

function TNetBuffer.GetStr: String;
var
  p: array[0..CNetPktLen] of Char;
begin
  p[GetPacket(@p)] := #0;
  Result := PChar(@p);
end;

function TNetBuffer.GetLength: LongWord;
var
  p: PNetPacket;
begin
  Result := 0;
  p := FPkt;
  while p <> nil do begin
    Inc(Result, p^.BufLen);
    p := p^.Next;
  end;
end;


//@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
//@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
//@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

{ TCustromSocket }

{** CONSTRUCTOR **}
constructor TCustomSocket.Create;
begin
  inherited Create(True);
  FConnected := False;
  FWorking := False;
  FAssync := DefaultSockType;
  FBuffer := TNetBuffer.Create;
end;


{** DESTRUCTOR **}
destructor TCustomSocket.Destroy;
begin
  FreeSocket;
  if FBuffer <> nil then FBuffer.Free;
  inherited Destroy;
end;