123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209 |
- 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.
|