Z3SA

Untitled

May 5th, 2019
802
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.12 KB | None | 0 0
  1. library project_dll;
  2.  
  3. { Important note about DLL memory management: ShareMem must be the
  4. first unit in your library's USES clause AND your project's (select
  5. Project-View Source) USES clause if your DLL exports any procedures or
  6. functions that pass strings as parameters or function results. This
  7. applies to all strings passed to and from your DLL--even those that
  8. are nested in records and classes. ShareMem is the interface unit to
  9. the BORLNDMM.DLL shared memory manager, which must be deployed along
  10. with your DLL. To avoid using BORLNDMM.DLL, pass string information
  11. using PChar or ShortString parameters. }
  12.  
  13. uses
  14. SysUtils,
  15. Classes;
  16.  
  17. {$R *.res}
  18.  
  19. function Execute(const data: WideString): WideString; stdcall; export;
  20. var
  21. des: array of string;
  22. vars: array of string;
  23. nums: array of array of integer;
  24. weight: array of integer;
  25. i,j,k,pos1,pos2,pos3:integer;
  26. s:string;
  27. b:boolean;
  28. begin
  29.  
  30. b:=false;
  31. pos1:=1;
  32.  
  33. for i:=1 to length(data) do begin
  34. if ((ord(data[i])=13) or (ord(data[i])=10)) then begin
  35. if b=false then begin
  36. b:=true;
  37.  
  38. setlength(des,length(des)+1);
  39. des[length(des)-1]:=copy(data,pos1,i-pos1);
  40. end;
  41. end
  42.  
  43. else begin
  44. if b=true then begin
  45. b:=false;
  46. pos1:=i;
  47. end;
  48. end;
  49. end;
  50.  
  51. setlength(weight,length(des));
  52. for i:=0 to length(des)-1 do begin
  53. j:=pos('=',des[i]);
  54. weight[i]:=strtoint(copy(des[i], j+1, length(des[i])-j));
  55. delete(des[i], j, length(des[i]));
  56. end;
  57.  
  58. s:=des[0];
  59. while(length(s)>0) do begin
  60. j:=lastdelimiter('-~',s);
  61. setlength(vars,length(vars)+1);
  62. vars[length(vars)-1]:=copy(s,j+1,length(s)-j);
  63. if j=0 then j:=1;
  64. delete(s,j,length(s));
  65. end;
  66.  
  67. setlength(nums,length(vars),length(vars));
  68. for i:=0 to length(vars)-1 do
  69. for j:=i+1 to length(vars)-1 do begin
  70. for k:=0 to length(des)-1 do begin
  71. pos1:=pos(vars[i],des[k]);
  72. pos2:=pos(vars[j],des[k]);
  73. if pos1>pos2 then begin
  74. s:=copy(des[k],pos2,pos1-pos2);
  75. pos3:=pos('-',s)+pos2-1;
  76. if pos3>0 then nums[j,i]:=nums[j,i]+weight[k];
  77. end
  78. else begin
  79. s:=copy(des[k],pos1,pos2-pos1);
  80. pos3:=pos('-',s)+pos1-1;
  81. if pos3>0 then nums[i,j]:=nums[i,j]+weight[k];
  82. end;
  83. end;
  84. end;
  85.  
  86. for i:=0 to length(vars)-1 do begin
  87. b:=true;
  88. for j:=0 to length(vars)-1 do begin
  89. if i=j then continue;
  90. if nums[i,j]<nums[j,i] then begin
  91. b:=false;
  92. break;
  93. end;
  94. end;
  95. if b=true then begin
  96. Result:='Ëó÷øèé âàðèàíò: '+vars[i];
  97. break;
  98. end;
  99. end;
  100.  
  101. pos2:=-1;
  102. if b=false then begin
  103. Result:='Îáíàðóæåí ïàðàäîêñ Êîíäîðñå';
  104. for i:=0 to length(vars)-1 do begin
  105. pos1:=0;
  106. for j:=0 to length(vars)-1 do pos1:=pos1+nums[i,j];
  107. if pos1>pos2 then begin
  108. s:=vars[i];
  109. pos2:=pos1;
  110. end
  111. else if pos1=pos2 then s:=s+', '+vars[i];
  112. end;
  113. Result:=Result+'Ëó÷øèè âàðèàíò: '+s;
  114. end;
  115. end;
  116.  
  117. function About: WideString; stdcall; export;
  118. begin
  119. Result:='10 Ëàá | Áóêèí Í. | Êîíäîðñå';
  120. end;
  121.  
  122. exports Execute, About;
  123.  
  124. begin
  125. end.
Advertisement
Add Comment
Please, Sign In to add comment