unit SoftDogService; interface uses Classes, Windows; const ConfigName = 'config.scs'; type TBytes = array of Byte; TScSoftDog = class private FV0MaxLinks: Integer; FV1MaxLinks: Integer; FV2MaxLinks: Integer; FCriticalSection: TRTLCriticalSection; public constructor Create; destructor Destroy; override; function ReadUserDog: Boolean; function ReadData(const AAddr, ABytes: Integer): string; property V0MaxLinks: Integer read FV0MaxLinks; property V1MaxLinks: Integer read FV1MaxLinks; property V2MaxLinks: Integer read FV2MaxLinks; end; TProperty = class(TComponent) private FPort: Integer; public constructor Create; published property Port: Integer read FPort write FPort; end; TScPersistent = class private FFileDir: string; FProperty: TProperty; function GetPort: Integer; procedure SetPort(const Value: Integer); published constructor Create; destructor Destroy; override; procedure WritePersistentProperty; procedure ReadPersistentProperty; property FileDir: string read FFileDir write FFileDir; property Port: Integer read GetPort write SetPort; end; implementation uses SysUtils; var DogAddr: integer; DogBytes: integer; DogData: ^byte; function WriteDog: LongInt; external; function ReadDog: LongInt; external; {$L rgdlw32d.obj} { TScPersistent } function TScPersistent.GetPort: Integer; begin Result := FProperty.Port; end; procedure TScPersistent.WritePersistentProperty; var sName: string; MeStream: TMemoryStream; begin MeStream := TMemoryStream.Create; try sName := FFileDir + ConfigName; MeStream.WriteComponent(FProperty); MeStream.SaveToFile(sName); finally MeStream.Free; end; end; procedure TScPersistent.SetPort(const Value: Integer); begin FProperty.Port := Value; end; procedure TScPersistent.ReadPersistentProperty; var sName: string; MeStream: TMemoryStream; begin MeStream := TMemoryStream.Create; try sName := FFileDir + ConfigName; if not FileExists(sName) then Exit; MeStream.LoadFromFile(sName); MeStream.ReadComponent(FProperty); finally MeStream.Free; end; end; constructor TScPersistent.Create; begin FProperty := TProperty.Create; end; destructor TScPersistent.Destroy; begin FProperty.Free; inherited; end; { TProperty } constructor TProperty.Create; begin inherited Create(nil); FPort := 5500; end; { TScSoftDog } constructor TScSoftDog.Create; begin InitializeCriticalSection(FCriticalSection); end; destructor TScSoftDog.Destroy; begin DeleteCriticalSection(FCriticalSection); inherited; end; function TScSoftDog.ReadData(const AAddr, ABytes: Integer): string; var serinal: LongInt; arrData: TBytes; // arrData: array [0..99] of Byte; begin EnterCriticalSection(FCriticalSection); try SetLength(Result, ABytes); SetLength(arrData, ABytes); DogAddr := AAddr; DogBytes := ABytes; if (AAddr = 0) and (ABytes = 0) then DogData := @serinal else DogData := @arrData[0]; if ReadDog = 0 then begin if (AAddr = 0) and (ABytes = 0) then Result := IntToStr(serinal) else Move(arrData[0], Result[1], ABytes); end else Result := ''; finally LeaveCriticalSection(FCriticalSection); end; end; function TScSoftDog.ReadUserDog: Boolean; var arrData: array [0..2] of Byte; begin EnterCriticalSection(FCriticalSection); try Result := True; DogAddr := $52; DogBytes := Length(arrData); DogData := @arrData; if ReadDog = 0 then begin FV0MaxLinks := arrData[0]; FV1MaxLinks := arrData[1]; FV2MaxLinks := arrData[2]; if (FV0MaxLinks = 0) and (FV1MaxLinks = 0) and (FV2MaxLinks = 0) then Result := False; end else Result := False; finally LeaveCriticalSection(FCriticalSection); end; end; end.