****我做了一套程序，可以让"彩虹天地"的单机软件狗像网络狗一样使用，可以省不少钱啊，转让源程序，,感兴趣的进来

implementation
function TNetSoftDog.TestIp(IP:string): boolean;
var
WSAData:TWSADATA;
Addr:DWORD;
begin
  WSAStartup(2, WSAData);
  Addr:=inet_addr(PChar(IP));
  if gethostbyaddr(@Addr,sizeof(Addr),PF_INET)=nil then
   result:= false
   else result:= true;
  WSACleanup();
end;function TNetSoftDog.TestHost(AHost :string) : boolean;
var
 WSAData:TWSADATA;
begin
  WSAStartup(2, WSAData);
  if GetHostByName(PChar(AHost))=nil then
   result:= false
   else result:= true;
  WSACleanup();
end;constructor TNetSoftDog.Create(AHost, AHostIp :string; APort :integer);  function IsIpAddr(AIPStr :string) :boolean;
  var i,k:integer;
 begin
 k := 0;
  if trim(AIpStr) <>'' then
 begin
  for i:= 0 to length(AIPStr) do
  begin
       if (AIPStr[i] <'0') and (AIPStr[i]>'9') and (AIPStr[i] <>'.') then
       begin
             result := false;
             Exit;
       end;
     if (AIPStr[i] = '.') then k := k +1;
  end;
    if k <>3 then
    begin
         Result := false;
         Exit;
    end;
   Result := true;
end;
end;
begin
      inherited Create;
      FHost := AHost;
      FHostIp := AHostIp;      FClientSocket := TClientSocket.Create(nil);
      FClientSocket.ClientType := ctNonBlocking;
      if (FHostIp <> '') and IsIpAddr(FHostIP) then
        FClientSocket.Address := FHostIp
      else
        FClientSocket.Host := FHost;      FClientSocket.OnWrite := OnClientWrite;
      FClientSocket.OnRead := OnClientRead;
      FClientSocket.OnError := OnClientError;
      FClientSocket.Port := APort;
      FOpFinished := false;      FTimer := TTimer.Create(nil);
      FTimer.Enabled := false;
      FTimer.OnTimer := OnTimer;
end;destructor TNetSoftDog.Destroy;
begin
    if FClientSocket.Active then
      FClientSocket.Active := false;
    inherited;
end;function TNetSoftDog.DoFunc :longint;
var bServerExists :boolean;
begin
     try
        if FClientSocket.Host <>'' then
          bServerExists := TestHost(FClientSocket.Host)
        else
          bServerExists := TestIP(FClientSocket.Address);
          
       if not bServerExists then  //如果服务器没连网，或不存在
       begin
           FCommData.Result := -9;
           FCommData.ErrMessage := '指定的网络狗服务器不存在或没有连网！';
           Exit;
       end;       if FClientSocket.Active then
          OnClientWrite(FClientSocket, FClientSocket.Socket)
       else
          FClientSocket.Active := true;
          
       StartTimerOut(30);  //设置超时30秒       while not FOpFinished do Application.ProcessMessages;       Result := FCommData.Result;
     except
       FOpFinished := true;
       FCommData.Result := -100;
       FCommData.ErrMessage := '寻找网络软件狗失败！请注意网络连接或狗服务器设置是否正确！';
       Result := FCommData.Result;
     end;
end;function TNetSoftDog.LogIn() : longint;
begin
     FCommData.Command := dcLog;
     result := DoFunc();
end;function TNetSoftDog.LogOut() : longint;
begin
   result := 0;
    if FClientSocket.Active then
      FClientSocket.Active := false;
end;function TNetSoftDog.ReadStr(nAddr, nLen :integer;var AStr :string) :longint;
begin
    FCommData.Command := dcReadStr;
    FCommData.DataStr := '';
    FCommData.DogAddr := nAddr;
    FCommData.ByteSize := nLen;
    result := DoFunc();
    Astr := FCommData.DataStr;
end;function TNetSoftDog.WriteStr(nAddr:integer; AStr :string) :longint;
begin
    FCommData.Command := dcWriteStr;
    FCommData.DogAddr := nAddr;
    FCommData.DataStr := AStr;
    Result := DoFunc();
end;function TNetSoftDog.ReadWord(nAddr :integer; var AData :Word) :longint;
begin
   FCommData.Command := dcReadWord;
   FCommData.DogAddr := nAddr;
   Result := DoFunc();
   AData := FCommData.DataWord;
end;function TNetSoftDog.WriteWord(nAddr :integer; AData :Word) :longint;
begin
   FCommData.Command := dcWriteWord;
   FCommData.DogAddr := nAddr;
   FCommData.DataWord := AData;
   Result := DoFunc();
end;function TNetSoftDog.ReadFloat(nAddr :integer; var AData :Real) :longint;
begin
   FCommData.Command := dcReadFloat;
   FCommData.DogAddr := nAddr;
   Result := DoFunc();
   AData := FCommData.DataFloat;
end;function TNetSoftDog.WriteFloat(nAddr :integer; AData :Real) :longint;
begin
   FCommData.Command := dcWriteFloat;
   FCommData.DogAddr := nAddr;
   FCommData.DataFloat := AData;
   Result := DoFunc();
end;function TNetSoftDog.GetLinceCount(AModeNo:integer; var ALince:integer):longint;
begin
   FCommData.Command := dcReadWord;
   FCommData.DogAddr := $30+ 2*AModeNo; //模块号
   Result := DoFunc;
   ALince := FCommData.DataWord;
end;function TNetSoftDog.AutoCheckTxDog() :longint;
begin
    FCommData.Command := dcAutoCheck;
    Result := DoFunc();
end;procedure TNetSoftDog.OnClientRead(Sender: TObject;
            Socket: TCustomWinSocket);
var nByte :integer;
begin
  nByte := Socket.ReceiveBuf(FCommData, sizeof(FCommData));
  if (nByte <> sizeof(FCommData)) or (FCommData.FlagHeader <>111) or
     (FCommData.FlagEnd <>222) then
     begin
        FCommData.ErrMessage := '数据块传送错误！';
        FCommData.Result := -11;
     end;
     FOpFinished := true;
end;procedure TNetSoftDog.OnClientWrite(Sender: TObject;
            Socket: TCustomWinSocket);
begin
      FCommData.FlagHeader := 111;
      FCommData.FlagEnd := 222;
      FCommData.Result := -1;
      FClientSocket.Socket.SendBuf(FCommData, sizeof(FCommData));
      FOpFinished := false;
end;procedure TNetSoftDog.OnClientError(Sender: TObject;
        Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
          var ErrorCode: Integer);
begin
      FOpFinished := true;
      FCommData.ErrMessage := '狗服务器未运行，或端口号设置错误！';
      FCommData.Result := ErrorCode;
      ErrorCode := 0;
end;procedure TNetSoftDog.StartTimerOut(ASec :integer);
begin
    FTimeOut := Asec;
    FTimer.Interval := 1000;
    FTimer.Enabled := true;
end;procedure TNetSoftDog.OnTimer(Sender:TObject);
begin
   if FTimeOut <=0 then
   begin
      if not FOpFinished then
      begin
          FCommData.Result := 200;
          FCommData.ErrMessage := '寻找网络狗服务器超时！';
          FTimer.Enabled := false;
          FOpFinished := true;
      end;
   end
    else
  if FOpFinished then
     FTimer.Enabled := false
  else
    Dec(FTimeOut);
end;end.