SoftDogService.pas 3.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209
  1. unit SoftDogService;
  2. interface
  3. uses Classes, Windows;
  4. const
  5. ConfigName = 'config.scs';
  6. type
  7. TBytes = array of Byte;
  8. TScSoftDog = class
  9. private
  10. FV0MaxLinks: Integer;
  11. FV1MaxLinks: Integer;
  12. FV2MaxLinks: Integer;
  13. FCriticalSection: TRTLCriticalSection;
  14. public
  15. constructor Create;
  16. destructor Destroy; override;
  17. function ReadUserDog: Boolean;
  18. function ReadData(const AAddr, ABytes: Integer): string;
  19. property V0MaxLinks: Integer read FV0MaxLinks;
  20. property V1MaxLinks: Integer read FV1MaxLinks;
  21. property V2MaxLinks: Integer read FV2MaxLinks;
  22. end;
  23. TProperty = class(TComponent)
  24. private
  25. FPort: Integer;
  26. public
  27. constructor Create;
  28. published
  29. property Port: Integer read FPort write FPort;
  30. end;
  31. TScPersistent = class
  32. private
  33. FFileDir: string;
  34. FProperty: TProperty;
  35. function GetPort: Integer;
  36. procedure SetPort(const Value: Integer);
  37. published
  38. constructor Create;
  39. destructor Destroy; override;
  40. procedure WritePersistentProperty;
  41. procedure ReadPersistentProperty;
  42. property FileDir: string read FFileDir write FFileDir;
  43. property Port: Integer read GetPort write SetPort;
  44. end;
  45. implementation
  46. uses SysUtils;
  47. var
  48. DogAddr: integer;
  49. DogBytes: integer;
  50. DogData: ^byte;
  51. function WriteDog: LongInt; external;
  52. function ReadDog: LongInt; external;
  53. {$L rgdlw32d.obj}
  54. { TScPersistent }
  55. function TScPersistent.GetPort: Integer;
  56. begin
  57. Result := FProperty.Port;
  58. end;
  59. procedure TScPersistent.WritePersistentProperty;
  60. var
  61. sName: string;
  62. MeStream: TMemoryStream;
  63. begin
  64. MeStream := TMemoryStream.Create;
  65. try
  66. sName := FFileDir + ConfigName;
  67. MeStream.WriteComponent(FProperty);
  68. MeStream.SaveToFile(sName);
  69. finally
  70. MeStream.Free;
  71. end;
  72. end;
  73. procedure TScPersistent.SetPort(const Value: Integer);
  74. begin
  75. FProperty.Port := Value;
  76. end;
  77. procedure TScPersistent.ReadPersistentProperty;
  78. var
  79. sName: string;
  80. MeStream: TMemoryStream;
  81. begin
  82. MeStream := TMemoryStream.Create;
  83. try
  84. sName := FFileDir + ConfigName;
  85. if not FileExists(sName) then Exit;
  86. MeStream.LoadFromFile(sName);
  87. MeStream.ReadComponent(FProperty);
  88. finally
  89. MeStream.Free;
  90. end;
  91. end;
  92. constructor TScPersistent.Create;
  93. begin
  94. FProperty := TProperty.Create;
  95. end;
  96. destructor TScPersistent.Destroy;
  97. begin
  98. FProperty.Free;
  99. inherited;
  100. end;
  101. { TProperty }
  102. constructor TProperty.Create;
  103. begin
  104. inherited Create(nil);
  105. FPort := 5500;
  106. end;
  107. { TScSoftDog }
  108. constructor TScSoftDog.Create;
  109. begin
  110. InitializeCriticalSection(FCriticalSection);
  111. end;
  112. destructor TScSoftDog.Destroy;
  113. begin
  114. DeleteCriticalSection(FCriticalSection);
  115. inherited;
  116. end;
  117. function TScSoftDog.ReadData(const AAddr, ABytes: Integer): string;
  118. var
  119. serinal: LongInt;
  120. arrData: TBytes;
  121. // arrData: array [0..99] of Byte;
  122. begin
  123. EnterCriticalSection(FCriticalSection);
  124. try
  125. SetLength(Result, ABytes);
  126. SetLength(arrData, ABytes);
  127. DogAddr := AAddr;
  128. DogBytes := ABytes;
  129. if (AAddr = 0) and (ABytes = 0) then
  130. DogData := @serinal
  131. else
  132. DogData := @arrData[0];
  133. if ReadDog = 0 then
  134. begin
  135. if (AAddr = 0) and (ABytes = 0) then
  136. Result := IntToStr(serinal)
  137. else
  138. Move(arrData[0], Result[1], ABytes);
  139. end
  140. else Result := '';
  141. finally
  142. LeaveCriticalSection(FCriticalSection);
  143. end;
  144. end;
  145. function TScSoftDog.ReadUserDog: Boolean;
  146. var
  147. arrData: array [0..2] of Byte;
  148. begin
  149. EnterCriticalSection(FCriticalSection);
  150. try
  151. Result := True;
  152. DogAddr := $52;
  153. DogBytes := Length(arrData);
  154. DogData := @arrData;
  155. if ReadDog = 0 then
  156. begin
  157. FV0MaxLinks := arrData[0];
  158. FV1MaxLinks := arrData[1];
  159. FV2MaxLinks := arrData[2];
  160. if (FV0MaxLinks = 0) and (FV1MaxLinks = 0)
  161. and (FV2MaxLinks = 0) then
  162. Result := False;
  163. end
  164. else Result := False;
  165. finally
  166. LeaveCriticalSection(FCriticalSection);
  167. end;
  168. end;
  169. end.