labradconnection.pas

As science advances, novel experiments are becoming more and more complex, requiring a zoo of contro

    fSocket.Request(Login, OnID);
   end else begin
    fSocket.Disconnect;
  end;
end;

procedure TLabRADConnection.OnID(Sender: TObject; const Packet: TLabRADPacket; Data: integer);
begin
  if (Packet.Count=1) and Packet[0].Data.IsWord then begin
    fID:=Packet[0].Data.GetWord;
    OnConn;
   end else begin
    fSocket.Disconnect;
  end;
end;

procedure TLabRADConnection.OnConn;
begin
  if assigned(fOnConnect) then fOnConnect(self, fID, fWelcome);
end;

procedure TLabRADConnection.OnDisc;
begin
  fActive:=False;
  fSocket.Kill;
  fSocket:=nil;
  if assigned(fOnDisc) then fOnDisc(self);
end;

procedure TLabRADConnection.Send(Packet: TLabRADPacket; FreePacket: Boolean);
begin
  if not assigned(fSocket) then raise ELabRADNotConnected.Create;
  fSocket.Send(Packet, FreePacket);
end;

function TLabRADConnection.Request(Packet: TLabRADPacket; FreePacket: Boolean = True; Timeout: Cardinal = $FFFFFFFF): TLabRADPacket;
begin
  if not assigned(fSocket) then raise ELabRADNotConnected.Create;
  if Packet is TLabRADAPIPacket then LookupPacket(Packet as TLabRADAPIPacket);
  Result:=fSocket.Request(Packet, FreePacket, Timeout);
end;

procedure TLabRADConnection.Request(Packet: TLabRADPacket; Data: integer; FreePacket: Boolean = True);
begin
  Request(Packet, fOnReply, Data, FreePacket);
end;

procedure TLabRADConnection.Request(Packet: TLabRADPacket; Callback: TLabRADPacketCallback; Data: integer = 0; FreePacket: Boolean = True);
begin
  if not assigned(fSocket) then raise ELabRADNotConnected.Create;
  if Packet is TLabRADAPIPacket then LookupPacket(Packet as TLabRADAPIPacket);
  fSocket.Request(Packet, Callback, Data, FreePacket);
end;

function TLabRADConnection.AsyncRequest(Packet: TLabRADPacket; FreePacket: Boolean = True): Integer;
begin
  if not assigned(fSocket) then raise ELabRADNotConnected.Create;
  if Packet is TLabRADAPIPacket then LookupPacket(Packet as TLabRADAPIPacket);
  Result:=fSocket.AsyncRequest(Packet, FreePacket);
end;

function TLabRADConnection.WaitForRequest(ID: Integer; Timeout: Cardinal = $FFFFFFFF): TLabRADPacket;
begin
  if not assigned(fSocket) then raise ELabRADNotConnected.Create;
  Result:=fSocket.WaitForRequest(ID, Timeout);
end;

procedure TLabRADConnection.OnRecvReq(const Packet: TLabRADPacket);
begin
  if assigned(fReqQueue) then fReqQueue.Enqueue(Packet);
end;

procedure TLabRADConnection.OnRecvReply(const Packet: TLabRADPacket);
begin
end;

procedure TLabRADConnection.OnRecvMsg(const Packet: TLabRADPacket);
begin
  if assigned(fMsgQueue) then fMsgQueue.Enqueue(Packet);
end;

procedure TLabRADConnection.OnSyncMsg(const Packet: TLabRADPacket);
begin
  if assigned(fOnMessage) then fOnMessage(self, Packet);
end;

procedure TLabRADConnection.OnSyncReq(const Packet: TLabRADPacket);
begin
end;

procedure TLabRADConnection.ClearCache;
begin
  setlength(fLookupCache, 0);
end;

procedure TLabRADConnection.LookupPacket(Packet: TLabRADAPIPacket);
var Req:  TLabRADPacket;
    Sets: array of string;
    a, b: integer;
    svr:  integer;
begin
  if not Packet.fLookup then exit;

  // Do Cache Lookup
  svr:=0;
  // Find Server Entry
  if Packet.fTarget<>'' then begin
    while (svr<length(fLookupCache)) and (fLookupCache[svr].Server.Name<>Packet.fTarget) do inc(svr);
    if svr<length(fLookupCache) then begin
      Packet.fTarget:='';
      Packet.Target:=fLookupCache[svr].Server.ID;
    end;
   end else begin
    while (svr<length(fLookupCache)) and (fLookupCache[svr].Server.ID<>Packet.Target) do inc(svr);
  end;

  // Find Settings
  if svr<length(fLookupCache) then begin
    for a:=1 to length(Packet.fSettings) do begin
      if Packet.fSettings[a-1]<>'' then begin
        b:=0;
        while (b<length(fLookupCache[svr].Settings)) and
              (fLookupCache[svr].Settings[b].Name<>Packet.fSettings[a-1]) do inc(b);
        if b<length(fLookupCache[svr].Settings) then begin
          Packet.fSettings[a-1]:='';
          Packet[a-1].Setting:=fLookupCache[svr].Settings[b].ID;
        end;
      end;
    end;
  end;

  // Done?
  Packet.fLookup:=Packet.fTarget<>'';
  a:=0;
  while (not Packet.fLookup) and (a<length(Packet.fSettings)) do begin
    Packet.fLookup:=Packet.fSettings[a]<>'';
    inc(a);
  end;
  if not Packet.fLookup then exit;

  // Create Lookup Packet
  Req:=TLabRADPacket.Create(0, $FFFFFFFF, 1, 1);

  // Add Server Name or ID
  if Packet.fTarget<>'' then begin
    Req.AddRecord(3, 's*s');
    Req[0].Data.SetString(0, Packet.fTarget);
   end else begin
    Req.AddRecord(3, 'w*s');
    Req[0].Data.SetWord  (0, Packet.Target);
  end;

  // Add list of Settings
  setlength(Sets, 0);
  for a:=1 to length(Packet.fSettings) do begin
    if Packet.fSettings[a-1]<>'' then begin
      setlength(Sets, length(Sets)+1);
      Sets[high(Sets)]:=Packet.fSettings[a-1];
    end;
  end;
  Req[0].Data.SetArraySize(1, length(Sets));
  for a:=1 to length(Sets) do
    Req[0].Data.SetString([1, a-1], Sets[a-1]);

  // Request Lookup
  Req:=Request(Req);

  // Check for Errors
  if Req[0].Data.IsError then begin
    Req.Free;
    raise ELabRADEXception.Create(Req[0].Data.GetWord(0), Req[0].Data.GetString(1));
   end else begin
    // Update Server ID and insert into Cache if needed
    if Packet.fTarget<>'' then begin
      svr:=Req[0].Data.GetWord(0);
      setlength(fLookupCache, length(fLookupCache)+1);
      fLookupCache[high(fLookupCache)].Server.Name:=Packet.fTarget;
      fLookupCache[high(fLookupCache)].Server.ID:=svr;
      Packet.fTarget:='';
      Packet.Target:=svr;
      svr:=high(fLookupCache);
    end;
    // Update Settings and insert into Cache
    b:=0;
    for a:=1 to length(Packet.fSettings) do begin
      if Packet.fSettings[a-1]<>'' then begin
        setlength(fLookupCache[svr].Settings, length(fLookupCache[svr].Settings)+1);
        fLookupCache[svr].Settings[high(fLookupCache[svr].Settings)].Name:=Packet.fSettings[a-1];
        fLookupCache[svr].Settings[high(fLookupCache[svr].Settings)].ID:=Req[0].Data.GetWord([1, b]);
        Packet.fSettings[a-1]:='';
        Packet[a-1].Setting:=fLookupCache[svr].Settings[high(fLookupCache[svr].Settings)].ID;
        inc(b);
      end;
    end;
  end;
  
  // Done
  Req.Free;
end;


constructor TLabRADAPIPacket.Create(                                    Target: TLabRADID);
begin
  inherited Create(0, $FFFFFFFF, 1, Target);
  fTarget:='';
  setlength(fSettings, 0);
  fLookup:=False;
end;

constructor TLabRADAPIPacket.Create(Context: TLabRADContext;            Target: TLabRADID);
begin
  inherited Create(Context, 1, Target);
  fTarget:='';
  setlength(fSettings, 0);
  fLookup:=False;
end;

constructor TLabRADAPIPacket.Create(ContextHigh, ContextLow: TLabRADID; Target: TLabRADID);
begin
  inherited Create(ContextHigh, ContextLow, 1, Target);
  fTarget:='';
  setlength(fSettings, 0);
  fLookup:=False;
end;

constructor TLabRADAPIPacket.Create(                                    Target: string   );
begin
  if Target='' then raise ELabRADEmptyTarget.Create;
  inherited Create(0, $FFFFFFFF, 1, 0);
  fTarget:=Target;
  setlength(fSettings, 0);
  fLookup:=True;
end;

constructor TLabRADAPIPacket.Create(Context: TLabRADContext;            Target: string   );
begin
  if Target='' then raise ELabRADEmptyTarget.Create;
  inherited Create(Context, 1, 0);
  fTarget:=Target;
  setlength(fSettings, 0);
  fLookup:=True;
end;

constructor TLabRADAPIPacket.Create(ContextHigh, ContextLow: TLabRADID; Target: string   );
begin
  if Target='' then raise ELabRADEmptyTarget.Create;
  inherited Create(ContextHigh, ContextLow, 1, 0);
  fTarget:=Target;
  setlength(fSettings, 0);
  fLookup:=True;
end;


function TLabRADAPIPacket.AddRecord(Setting: TLabRADID; TypeTag: string):              TLabRADRecord;
begin
  Result:=inherited AddRecord(Setting, TypeTag);
  setlength(fSettings, length(fSettings)+1);
  fSettings[high(fSettings)]:='';
end;

function TLabRADAPIPacket.AddRecord(Setting: TLabRADID; Data: TLabRADData=nil):        TLabRADRecord;
begin
  Result:=inherited AddRecord(Setting, Data);
  setlength(fSettings, length(fSettings)+1);
  fSettings[high(fSettings)]:='';
end;

function TLabRADAPIPacket.AddRecord(Setting: TLabRADID; Code: integer; Error: string): TLabRADRecord;
begin
  Result:=inherited AddRecord(Setting, Code, Error);
  setlength(fSettings, length(fSettings)+1);
  fSettings[high(fSettings)]:='';
end;

function TLabRADAPIPacket.AddRecord(Setting: string;    TypeTag: string):              TLabRADRecord;
begin
  if Setting='' then raise ELabRADEmptySetting.Create;
  Result:=inherited AddRecord(0, TypeTag);
  setlength(fSettings, length(fSettings)+1);
  fSettings[high(fSettings)]:=Setting;
  fLookup:=True;
end;

function TLabRADAPIPacket.AddRecord(Setting: string;    Data: TLabRADData=nil):        TLabRADRecord;
begin
  if Setting='' then raise ELabRADEmptySetting.Create;
  Result:=inherited AddRecord(0, Data);
  setlength(fSettings, length(fSettings)+1);
  fSettings[high(fSettings)]:=Setting;
  fLookup:=True;
end;

function TLabRADAPIPacket.AddRecord(Setting: string;    Code: integer; Error: string): TLabRADRecord;
begin
  if Setting='' then raise ELabRADEmptySetting.Create;
  Result:=inherited AddRecord(0, Code, Error);
  setlength(fSettings, length(fSettings)+1);
  fSettings[high(fSettings)]:=Setting;
  fLookup:=True;
end;

end.