testser.pp 17 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597
  1. Program testser;
  2. { Program to test serialization }
  3. {$Mode Delphi}
  4. Uses
  5. {$ifdef go32v2}
  6. dpmiexcp,
  7. {$endif}
  8. Typinfo,classes,iostream;
  9. Const TypeNames : Array [TTYpeKind] of string[15] =
  10. ('Unknown','Integer','Char','Enumeration',
  11. 'Float','Set','Method','ShortString','LongString',
  12. 'AnsiString','WideString','Variant','Array','Record',
  13. 'Interface','Class','Object','WideChar','Bool');
  14. Const OrdinalTypes = [tkInteger,tkChar,tkENumeration,tkbool];
  15. Type
  16. TMyEnum = (meFirst,meSecond,meThird);
  17. TMyTestObject = Class(TComponent)
  18. Private
  19. FBoolean : Boolean;
  20. FByte : Byte;
  21. FChar : Char;
  22. FWord : Word;
  23. FInteger : Integer;
  24. Flongint : Longint;
  25. FCardinal : Cardinal;
  26. FReal : Real;
  27. FExtended : Extended;
  28. FMyEnum : TMyEnum;
  29. FAnsiString : AnsiSTring;
  30. FObj : TObject;
  31. FStored : Boolean;
  32. Function GetBoolean : Boolean;
  33. Function GetByte : Byte;
  34. Function GetChar : Char;
  35. Function GetWord : Word;
  36. Function GetInteger : Integer;
  37. Function GetLongint : Longint;
  38. Function GetCardinal : Cardinal;
  39. Function GetReal : Real;
  40. Function GetExtended : Extended;
  41. Function GetAnsiString : AnsiString;
  42. Function GetMyEnum : TMyEnum;
  43. Procedure SetBoolean ( Value : Boolean);
  44. Procedure SetByte ( Value : Byte );
  45. Procedure SetChar ( Value : Char );
  46. Procedure SetWord ( Value : Word );
  47. Procedure SetInteger ( Value : Integer );
  48. Procedure SetLongint ( Value : Longint );
  49. Procedure SetCardinal ( Value : Cardinal );
  50. Procedure SetReal ( Value : Real );
  51. Procedure SetExtended ( Value : Extended );
  52. Procedure SetAnsiString ( Value : AnsiString );
  53. Procedure SetMyEnum ( Value : TMyEnum );
  54. Function GetVirtualBoolean : Boolean; virtual;
  55. Function GetVirtualByte : Byte; virtual;
  56. Function GetVirtualChar : Char; virtual;
  57. Function GetVirtualWord : Word; virtual;
  58. Function GetVirtualInteger : Integer; virtual;
  59. Function GetVirtualLongint : Longint; virtual;
  60. Function GetVirtualCardinal : Cardinal; virtual;
  61. Function GetVirtualReal : Real; virtual;
  62. Function GetVirtualExtended : Extended; virtual;
  63. Function GetVirtualAnsiString : AnsiString; virtual;
  64. Function GetVirtualMyEnum : TMyEnum; virtual;
  65. Procedure SetVirtualBoolean ( Value : Boolean); virtual;
  66. Procedure SetVirtualByte ( Value : Byte ); virtual;
  67. Procedure SetVirtualChar ( Value : Char ); virtual;
  68. Procedure SetVirtualWord ( Value : Word ); virtual;
  69. Procedure SetVirtualInteger ( Value : Integer ); virtual;
  70. Procedure SetVirtualLongint ( Value : Longint ); virtual;
  71. Procedure SetVirtualCardinal ( Value : Cardinal ); virtual;
  72. Procedure SetVirtualReal ( Value : Real ); virtual;
  73. Procedure SetVirtualExtended ( Value : Extended ); virtual;
  74. Procedure SetVirtualAnsiString ( Value : AnsiString ); virtual;
  75. Procedure SetVirtualMyEnum ( Value : TMyEnum ); virtual;
  76. Function GetStaticStored : Boolean;
  77. Function GetVirtualStored : Boolean;virtual;
  78. Public
  79. Constructor Create;
  80. Destructor Destroy;override;
  81. Published
  82. Property ObjField: TObject read FObj write FObj;
  83. Property BooleanField : Boolean Read FBoolean Write FBoolean;
  84. Property ByteField : Byte Read FByte Write FByte;
  85. Property CharField : Char Read FChar Write FChar;
  86. Property WordField : Word Read FWord Write FWord;
  87. Property IntegerField : Integer Read FInteger Write FInteger;
  88. Property LongintField : Longint Read FLongint Write FLongint;
  89. Property CardinalField : Cardinal Read FCardinal Write FCardinal;
  90. Property RealField : Real Read FReal Write FReal;
  91. Property ExtendedField : Extended Read FExtended Write FExtended;
  92. Property AnsiStringField : AnsiString Read FAnsiString Write FAnsiString;
  93. Property MyEnumField : TMyEnum Read FMyEnum Write FMyEnum;
  94. Property BooleanMethod : Boolean Read GetBoolean Write SetBoolean;
  95. Property ByteMethod : Byte Read GetByte Write SetByte;
  96. Property CharMethod : Char Read GetChar Write SetChar;
  97. Property WordMethod : Word Read GetWord Write SetWord;
  98. Property IntegerMethod : Integer Read GetInteger Write SetInteger;
  99. Property LongintMethod : Longint Read GetLongint Write SetLongint;
  100. Property CardinalMethod : Cardinal Read GetCardinal Write SetCardinal;
  101. Property RealMethod : Real Read GetReal Write SetReal;
  102. Property ExtendedMethod : Extended Read GetExtended Write SetExtended;
  103. Property AnsiStringMethod : AnsiString Read GetAnsiString Write SetAnsiString;
  104. Property MyEnumMethod : TMyEnum Read GetMyEnum Write SetMyEnum;
  105. Property BooleanVirtualMethod : Boolean Read GetVirtualBoolean Write SetVirtualBoolean;
  106. Property ByteVirtualMethod : Byte Read GetVirtualByte Write SetVirtualByte;
  107. Property CharVirtualMethod : Char Read GetVirtualChar Write SetVirtualChar;
  108. Property WordVirtualMethod : Word Read GetVirtualWord Write SetVirtualWord;
  109. Property IntegerVirtualMethod : Integer Read GetVirtualInteger Write SetVirtualInteger;
  110. Property LongintVirtualMethod : Longint Read GetVirtualLongint Write SetVirtualLongint;
  111. Property CardinalVirtualMethod : Cardinal Read GetVirtualCardinal Write SetVirtualCardinal;
  112. Property RealVirtualMethod : Real Read GetVirtualReal Write SetVirtualReal;
  113. Property ExtendedVirtualMethod : Extended Read GetVirtualExtended Write SetVirtualExtended;
  114. Property AnsiStringVirtualMethod : AnsiString Read GetVirtualAnsiString Write SetVirtualAnsiString;
  115. Property MyEnumVirtualMethod : TMyEnum Read GetVirtualMyEnum Write SetVirtualMyEnum;
  116. Property StoredIntegerConstFalse : Longint Read FLongint Stored False;
  117. Property StoredIntegerConstTrue : Longint Read FLongint Stored True;
  118. Property StoredIntegerField : Longint Read FLongint Stored FStored;
  119. Property StoredIntegerMethod : Longint Read Flongint Stored GetStaticStored;
  120. Property StoredIntegerVirtualMethod : Longint Read Flongint Stored GetVirtualStored;
  121. end;
  122. Constructor TMyTestObject.Create;
  123. begin
  124. FBoolean:=true;
  125. FByte:=1; { : Byte;}
  126. FChar:='B'; { : Char; }
  127. FWord:=3; {: Word; }
  128. FInteger:=4; {: Integer; }
  129. Flongint:=5; { : Longint; }
  130. FCardinal:=6; {: Cardinal; }
  131. FReal:=7.0; { : Real;}
  132. FExtended :=8.0; { Extended;}
  133. FMyEnum:=methird; { TMyEnum;}
  134. FAnsiString:='this is an AnsiString';
  135. end;
  136. Destructor TMyTestObject.Destroy;
  137. begin
  138. Inherited Destroy;
  139. end;
  140. Function TMyTestObject.GetBoolean : boolean;
  141. begin
  142. Result:=FBoolean;
  143. end;
  144. Function TMyTestObject.GetByte : Byte;
  145. begin
  146. Result:=FByte;
  147. end;
  148. Function TMyTestObject.GetChar : Char;
  149. begin
  150. Result:=FChar;
  151. end;
  152. Function TMyTestObject.GetWord : Word;
  153. begin
  154. Result:=FWord;
  155. end;
  156. Function TMyTestObject.GetInteger : Integer;
  157. begin
  158. Result:=FInteger;
  159. end;
  160. Function TMyTestObject.GetLongint : Longint;
  161. begin
  162. Result:=FLongint;
  163. end;
  164. Function TMyTestObject.GetCardinal : Cardinal;
  165. begin
  166. Result:=FCardinal;
  167. end;
  168. Function TMyTestObject.GetReal : Real;
  169. begin
  170. Result:=FReal;
  171. end;
  172. Function TMyTestObject.GetExtended : Extended;
  173. begin
  174. Result:=FExtended;
  175. end;
  176. Function TMyTestObject.GetAnsiString : AnsiString;
  177. begin
  178. Result:=FAnsiString;
  179. end;
  180. Function TMyTestObject.GetMyEnum : TMyEnum;
  181. begin
  182. Result:=FMyEnum;
  183. end;
  184. Procedure TMyTestObject.Setboolean ( Value : boolean );
  185. begin
  186. Fboolean:=Value;
  187. end;
  188. Procedure TMyTestObject.SetByte ( Value : Byte );
  189. begin
  190. FByte:=Value;
  191. end;
  192. Procedure TMyTestObject.SetChar ( Value : Char );
  193. begin
  194. FChar:=Value;
  195. end;
  196. Procedure TMyTestObject.SetWord ( Value : Word );
  197. begin
  198. FWord:=Value;
  199. end;
  200. Procedure TMyTestObject.SetInteger ( Value : Integer );
  201. begin
  202. FInteger:=Value;
  203. end;
  204. Procedure TMyTestObject.SetLongint ( Value : Longint );
  205. begin
  206. FLongint:=Value;
  207. end;
  208. Procedure TMyTestObject.SetCardinal ( Value : Cardinal );
  209. begin
  210. FCardinal:=Value;
  211. end;
  212. Procedure TMyTestObject.SetReal ( Value : Real );
  213. begin
  214. FReal:=Value;
  215. end;
  216. Procedure TMyTestObject.SetExtended ( Value : Extended );
  217. begin
  218. FExtended:=Value;
  219. end;
  220. Procedure TMyTestObject.SetAnsiString ( Value : AnsiString );
  221. begin
  222. FAnsiString:=Value;
  223. end;
  224. Procedure TMyTestObject.SetMyEnum ( Value : TMyEnum );
  225. begin
  226. FMyEnum:=Value;
  227. end;
  228. Function TMyTestObject.GetVirtualBoolean : boolean;
  229. begin
  230. Result:=FBoolean;
  231. end;
  232. Function TMyTestObject.GetVirtualByte : Byte;
  233. begin
  234. Result:=FByte;
  235. end;
  236. Function TMyTestObject.GetVirtualChar : Char;
  237. begin
  238. Result:=FChar;
  239. end;
  240. Function TMyTestObject.GetVirtualWord : Word;
  241. begin
  242. Result:=FWord;
  243. end;
  244. Function TMyTestObject.GetVirtualInteger : Integer;
  245. begin
  246. Result:=FInteger;
  247. end;
  248. Function TMyTestObject.GetVirtualLongint : Longint;
  249. begin
  250. Result:=FLongint;
  251. end;
  252. Function TMyTestObject.GetVirtualCardinal : Cardinal;
  253. begin
  254. Result:=FCardinal;
  255. end;
  256. Function TMyTestObject.GetVirtualReal : Real;
  257. begin
  258. Result:=FReal;
  259. end;
  260. Function TMyTestObject.GetVirtualExtended : Extended;
  261. begin
  262. Result:=FExtended;
  263. end;
  264. Function TMyTestObject.GetVirtualAnsiString : AnsiString;
  265. begin
  266. Result:=FAnsiString;
  267. end;
  268. Function TMyTestObject.GetVirtualMyEnum : TMyEnum;
  269. begin
  270. Result:=FMyEnum;
  271. end;
  272. Procedure TMyTestObject.SetVirtualboolean ( Value : boolean );
  273. begin
  274. Fboolean:=Value;
  275. end;
  276. Procedure TMyTestObject.SetVirtualByte ( Value : Byte );
  277. begin
  278. FByte:=Value;
  279. end;
  280. Procedure TMyTestObject.SetVirtualChar ( Value : Char );
  281. begin
  282. FChar:=Value;
  283. end;
  284. Procedure TMyTestObject.SetVirtualWord ( Value : Word );
  285. begin
  286. FWord:=Value;
  287. end;
  288. Procedure TMyTestObject.SetVirtualInteger ( Value : Integer );
  289. begin
  290. FInteger:=Value;
  291. end;
  292. Procedure TMyTestObject.SetVirtualLongint ( Value : Longint );
  293. begin
  294. FLongint:=Value;
  295. end;
  296. Procedure TMyTestObject.SetVirtualCardinal ( Value : Cardinal );
  297. begin
  298. FCardinal:=Value;
  299. end;
  300. Procedure TMyTestObject.SetVirtualReal ( Value : Real );
  301. begin
  302. FReal:=Value;
  303. end;
  304. Procedure TMyTestObject.SetVirtualExtended ( Value : Extended );
  305. begin
  306. FExtended:=Value;
  307. end;
  308. Procedure TMyTestObject.SetVirtualAnsiString ( Value : AnsiString );
  309. begin
  310. FAnsiString:=Value;
  311. end;
  312. Procedure TMyTestObject.SetVirtualMyEnum ( Value : TMyEnum );
  313. begin
  314. FMyEnum:=Value;
  315. end;
  316. Function TMyTestObject.GetStaticStored : Boolean;
  317. begin
  318. Result:=False;
  319. end;
  320. Function TMyTestObject.GetVirtualStored : Boolean;
  321. begin
  322. Result:=False;
  323. end;
  324. Procedure DumpMem ( PL : PByte );
  325. Var I,j : longint;
  326. begin
  327. For I:=1 to 16 do
  328. begin
  329. Write ((I-1)*16:3,' :');
  330. For J:=1 to 10 do
  331. begin
  332. If (PL^>31) and (PL^<129) then
  333. Write(' ',CHar(PL^))
  334. else
  335. Write (PL^:3);
  336. Write (' ');
  337. inc(pl);
  338. end;
  339. writeln;
  340. end;
  341. end;
  342. Function ProcType (PP : Byte) : String;
  343. begin
  344. Case PP and 3 of
  345. ptfield : Result:='from Field';
  346. ptstatic : Result:='with static method';
  347. ptVirtual : Result:='with virtual method';
  348. ptconst : Result:='with Const';
  349. end;
  350. end;
  351. Procedure DumpTypeInfo (O : TMyTestObject);
  352. Var
  353. PT : PTypeData;
  354. PI : PTypeInfo;
  355. I,J : Longint;
  356. PP : PPropList;
  357. begin
  358. PI:=O.ClassInfo;
  359. Writeln ('Type kind : ',TypeNames[PI^.Kind]);
  360. Writeln ('Type name : ',PI^.Name);
  361. PT:=GetTypeData(PI);
  362. //DumpMem(PByte(PI));
  363. If PT^.ParentInfo=Nil then
  364. Writeln ('Object has no parent info')
  365. else
  366. Writeln ('Object has parent info');
  367. Writeln ('Property Count : ',PT^.PropCount);
  368. Writeln ('Unit name : ',PT^.UnitName);
  369. GetMem (PP,PT^.PropCount*SizeOf(Pointer));
  370. GetPropInfos(PI,PP);
  371. For I:=0 to PT^.PropCount-1 do
  372. If PP^[i]<>Nil then
  373. With PP^[I]^ do
  374. begin
  375. Writeln ('Property name : ',Name);
  376. Writeln (' Type kind: ',TypeNames[PropType^.Kind]);
  377. Writeln (' Type Name: ',PropType^.Name);
  378. If GetProc=Nil then Write ('No');
  379. Writeln (' Getproc available');
  380. If SetProc=Nil then Write ('No');
  381. Writeln (' Setproc available');
  382. If StoredProc=Nil then Write ('No');
  383. Writeln (' Storedproc available');
  384. Writeln (' Get property ',proctype(Propprocs));
  385. Writeln (' Set Property ',proctype(propprocs shr 2));
  386. Writeln (' Stored Property ',proctype(propprocs shr 4));
  387. Writeln (' Default : ',Default,' Index : ',Index);
  388. Writeln (' NameIndex : ',NameIndex);
  389. end;
  390. end;
  391. Procedure PrintObject ( Obj: TMyTestObject);
  392. begin
  393. With Obj do
  394. begin
  395. Writeln ('Field properties :');
  396. Writeln ('Property booleanField : ',booleanField);
  397. Writeln ('Property ByteField : ',ByteField);
  398. Writeln ('Property CharField : ',CharField);
  399. Writeln ('Property WordField : ',WordField);
  400. Writeln ('Property IntegerField : ',IntegerField);
  401. Writeln ('Property LongintField : ',LongintField);
  402. Writeln ('Property CardinalField : ',CardinalField);
  403. Writeln ('Property RealField : ',RealField);
  404. Writeln ('Property ExtendedField : ',ExtendedFIeld);
  405. Writeln ('Property AnsiStringField : ',AnsiStringField);
  406. Writeln ('Property MyEnumField : ',ord(MyEnumField));
  407. Writeln ('Method properties :');
  408. Writeln ('Property booleanMethod : ',BooleanMethod);
  409. Writeln ('Property ByteMethod : ',ByteMethod);
  410. Writeln ('Property CharMethod : ',CharMethod);
  411. Writeln ('Property WordMethod : ',WordMethod);
  412. Writeln ('Property IntegerMethod : ',IntegerMethod);
  413. Writeln ('Property LongintMethod : ',LongintMethod);
  414. Writeln ('Property CardinalMethod : ',CardinalMethod);
  415. Writeln ('Property RealMethod : ',RealMethod);
  416. Writeln ('Property ExtendedMethod : ',ExtendedMethod);
  417. Writeln ('Property AnsiStringMethod : ',AnsiStringMethod);
  418. Writeln ('Property MyEnumMethod : ',ord(MyEnumMethod));
  419. Writeln ('VirtualMethod properties :');
  420. Writeln ('Property booleanVirtualMethod : ',BooleanVirtualMethod);
  421. Writeln ('Property ByteVirtualMethod : ',ByteVirtualMethod);
  422. Writeln ('Property CharVirtualMethod : ',CharVirtualMethod);
  423. Writeln ('Property WordVirtualMethod : ',WordVirtualMethod);
  424. Writeln ('Property IntegerVirtualMethod : ',IntegerVirtualMethod);
  425. Writeln ('Property LongintVirtualMethod : ',LongintVirtualMethod);
  426. Writeln ('Property CardinalVirtualMethod : ',CardinalVirtualMethod);
  427. Writeln ('Property RealVirtualMethod : ',RealVirtualMethod);
  428. Writeln ('Property ExtendedVirtualMethod : ',ExtendedVirtualMethod);
  429. Writeln ('Property AnsiStringVirtualMethod : ',AnsiStringVirtualMethod);
  430. Writeln ('Property MyEnumVirtualMethod : ',ord(MyEnumVirtualMethod));
  431. end;
  432. end;
  433. Procedure TestGet (O : TMyTestObject);
  434. Var
  435. PT : PTypeData;
  436. PI : PTypeInfo;
  437. I,J : Longint;
  438. PP : PPropList;
  439. prI : PPropInfo;
  440. begin
  441. PI:=O.ClassInfo;
  442. Writeln ('Type kind : ',TypeNames[PI^.Kind]);
  443. Writeln ('Type name : ',PI^.Name);
  444. PT:=GetTypeData(PI);
  445. If PT^.ParentInfo=Nil then
  446. Writeln ('Object has no parent info')
  447. else
  448. Writeln ('Object has parent info');
  449. Writeln ('Property Count : ',PT^.PropCount);
  450. Writeln ('Unit name : ',PT^.UnitName);
  451. GetMem (PP,PT^.PropCount*SizeOf(Pointer));
  452. GetPropInfos(PI,PP);
  453. For I:=0 to PT^.PropCount-1 do
  454. begin
  455. pri:=PP^[i];
  456. With Pri^ do
  457. begin
  458. Write ('(Examining ',name,' : Type : ',TypeNames[PropType^.Kind],', ');
  459. If (Proptype^.kind in Ordinaltypes) Then
  460. begin
  461. J:=GetOrdProp(O,pri);
  462. Write ('Value : ',j);
  463. If PropType^.Kind=tkenumeration then
  464. Write ('(=',GetEnumName(Proptype,J),')')
  465. end
  466. else
  467. Case pri^.proptype^.kind of
  468. tkfloat : begin
  469. Write ('Value : ');
  470. Flush(output);
  471. Write(GetFloatProp(O,pri))
  472. end;
  473. tkAstring : begin
  474. Write ('value : ');
  475. flush (output);
  476. Write(GetStrProp(O,Pri));
  477. end;
  478. else
  479. Write ('Untested type:',ord(pri^.proptype^.kind));
  480. end;
  481. Writeln (')');
  482. end;
  483. end;
  484. end;
  485. procedure testserial(O : TComponent);
  486. Var W : TTextwriter;
  487. S : TStream;
  488. begin
  489. Writeln(stderr,'Creating stream');
  490. S:=TIOstream.Create(iosOutput);
  491. Writeln(stderr,'Creating TTextWriter');
  492. W:=TTextWriter.Create(S);
  493. Writeln(stderr,'Writing component TTextWriter');
  494. W.WriteComponent(O);
  495. Writeln(stderr,'Destroying stream');
  496. S.Free;
  497. Writeln(stderr,'Destroying Writer');
  498. W.Free;
  499. end;
  500. Var O : TMyTestObject;
  501. begin
  502. O:=TMyTestObject.Create;
  503. (*
  504. DumpTypeInfo(O);
  505. PrintObject(O);
  506. testget(o);
  507. *)
  508. testSerial(o);
  509. end.
  510. $Log$
  511. Revision 1.2 2000-07-13 11:33:05 michael
  512. + removed logs
  513. }