home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 November / Chip_2002-11_cd1.bin / zkuste / delphi / kompon / d567 / DIMPAS.ZIP / Dim.pas next >
Encoding:
Pascal/Delphi Source File  |  2002-09-05  |  182.3 KB  |  6,783 lines
  1. {*********************************************************}
  2. {* Borland Delphi 5.0 - 7.0 Runtime Library              *}
  3. {* Copyright ⌐ 1992-2002 by Dimka Maslov                 *}
  4. {*  E-mail:   mainbox@endimus.com                        *}
  5. {*  Web-site: http://endimus.com                         *}
  6. {*                                                       *}
  7. {****         Licensed for free distribution          ****}
  8. {*                                                       *}
  9. {* Last Update: Sep. 05, 2002 (Release ID: 02.9)         *}
  10. {*********************************************************}
  11.  
  12. unit Dim;
  13.  
  14. interface
  15.  
  16. uses Windows, SysUtils, ActiveX, ShlObj, Classes, ShellAPI;
  17.  
  18. const
  19. // Useful constants declaration
  20.   Nul                 = 0;
  21.   MaxWord             = $FFFF;
  22.   MaxInteger          = $7FFFFFFF;
  23.   MaxFloat            = 1.7e308;
  24.   MinFloat            = 5.0e-324;
  25.   MaxExtended         = 1.1e4932;
  26.   MinExtended         = 9.99e-4933;
  27.   HalfCycle           = Pi;
  28.   FullCycle           = 2*Pi;
  29.   Quadrant            = Pi/2;
  30.  
  31.   chNull              = #0;
  32.   chBackspace         = #8;
  33.   chTab               = #9;
  34.   chShiftTab          = #15;
  35.   chEnter             = #13;
  36.   chEsc               = #27;
  37.   chSpace             = #32;
  38.   chComma             = ',';
  39.   chPoint             = '.';
  40.   chQuote             = '''';
  41.   chDoubleQuote       = '"';
  42.   chColon             = ':';
  43.   chEqual             = '=';
  44.   chMore              = '>';
  45.   chLess              = '<';
  46.   chLast              = #255;
  47.   chPlus              = '+';
  48.   chMinus             = '-';
  49.  
  50.   nTrue               = Integer(True);
  51.   nFalse              = Integer(False);
  52.   uTrue               = cardinal(True);
  53.   uFalse              = cardinal(False);
  54.   lTrue               = -1;
  55.   lFalse              = 0;
  56.  
  57. // comparison result constants
  58.   nMore               = 1;
  59.   nLess               = -1;
  60.   nEqual              = 0;
  61.  
  62. // virtual-key codes aliases;
  63.   VK_Enter            = VK_Return;
  64.   VK_Alt              = VK_Menu;
  65.   VK_PageUp           = VK_Prior;
  66.   VK_PageDown         = VK_Next;
  67.   VK_PrintScreen      = VK_SnapShot;
  68.   VK_Ctrl             = VK_Control;
  69.  
  70.   achCR               : array [0..1] of AnsiChar = #13#10;
  71.   wCR                 = $0A0D;
  72.  
  73. // html colors
  74.   clAliceBlue              = $FFF8F0;
  75.   clAntiqueWhite           = $D7EBFA;
  76.   clAqua                   = $FFFF00;
  77.   clAquamarine             = $D4FF7F;
  78.   clAzure                  = $FFFFF0;
  79.   clBeige                  = $DCF5F5;
  80.   clBisque                 = $C4E4FF;
  81.   clBlack                  = $000000;
  82.   clBlanchedAlmond         = $CDEBFF;
  83.   clBlue                   = $FF0000;
  84.   clBlueViolet             = $E22B8A;
  85.   clBrown                  = $2A2AA5;
  86.   clBurlyWood              = $87B8DE;
  87.   clCadetBlue              = $A09E5F;
  88.   clChartreuse             = $00FF7F;
  89.   clChocolate              = $1E6902;
  90.   clCoral                  = $507FFF;
  91.   clCornflowerBlue         = $ED9564;
  92.   clCornSilk               = $DCF8FF;
  93.   clCrimson                = $3C14DC;
  94.   clCyan                   = $FFFF00;
  95.   clDarkBlue               = $8B0000;
  96.   clDarkCyan               = $8B8B00;
  97.   clDarkGoldenrod          = $0B86B8;
  98.   clDarkGray               = $A9A9A9;
  99.   clDarkGreen              = $006400;
  100.   clDarkKhaki              = $6BB7BD;
  101.   clDarkMagenta            = $8B008B;
  102.   clDarkOliveGreen         = $2F6B55;
  103.   clDarkOrange             = $008CFF;
  104.   clDarkOrchid             = $CC3299;
  105.   clDarkRed                = $000088;
  106.   clDarkSalmon             = $7A96E9;
  107.   clDarkSeaGreen           = $8FBC8F;
  108.   clDarkSlateBlue          = $8B3D48;
  109.   clDarkSlateGray          = $4F4F2F;
  110.   clDarkTurquoise          = $D1CE00;
  111.   clDarkViolet             = $030094;
  112.   clDeepPink               = $9314FF;
  113.   clDeepSkyBlue            = $FFBF00;
  114.   clDimGray                = $696969;
  115.   clDodgerBlue             = $FF901E;
  116.   clFireBrick              = $2222B2;
  117.   clFloralWhite            = $F0FAFF;
  118.   clForestGreen            = $228B22;
  119.   clFuchsia                = $FF00FF;
  120.   clGhostWhite             = $FFF8F8;
  121.   clGainsboro              = $DCDCDC;
  122.   clGold                   = $00D7FF;
  123.   clGoldenrod              = $20A5DA;
  124.   clGray                   = $808080;
  125.   clGreen                  = $008000;
  126.   clGreenYellow            = $2FFFAD;
  127.   clHoneyDew               = $F0FFF0;
  128.   clHotPink                = $B469FF;
  129.   clIndianRed              = $5C5CCD;
  130.   clIndigo                 = $82004B;
  131.   clIvory                  = $F0FFFF;
  132.   clKhaki                  = $8CE6F0;
  133.   clLavender               = $FAE6E6;
  134.   clLavenderBlush          = $F5F0FF;
  135.   clLawnGreen              = $00FC7C;
  136.   clLemonChiffon           = $CDFAFF;
  137.   clLightBlue              = $E6D8AD;
  138.   clLightCoral             = $8080F0;
  139.   clLightCyan              = $FFFFE0;
  140.   clLightGoldenrodYellow   = $D2FAFA;
  141.   clLightGreen             = $90EE90;
  142.   clLightGrey              = $D3D3D3;
  143.   clLightPink              = $C1B6FF;
  144.   clLightSalmon            = $7AA0FF;
  145.   clLightSeaGreen          = $AAB220;
  146.   clLightSkyBlue           = $FACE87;
  147.   clLightSlateGray         = $998877;
  148.   clLightSteelBlue         = $DEC4B0;
  149.   clLightYellow            = $E0FFFF;
  150.   clLime                   = $00FF00;
  151.   clLimeGreen              = $32CD32;
  152.   clLinen                  = $E6F0FA;
  153.   clMagenta                = $FF00FF;
  154.   clMaroon                 = $000080;
  155.   clMediumAquamarine       = $AACD66;
  156.   clMediumBlue             = $CD0000;
  157.   clMediumOrchid           = $D355BA;
  158.   clMediumPurple           = $DB7093;
  159.   clMediumSeaGreen         = $71B33C;
  160.   clMediumSlateBlue        = $EE687B;
  161.   clMediumSpringGreen      = $9AFA00;
  162.   clMediumTurquoise        = $CCD148;
  163.   clMediumVioletRed        = $851507;
  164.   clMidnightBlue           = $701919;
  165.   clMintCream              = $FAFFF5;
  166.   clMistyRose              = $E1E4FF;
  167.   clMoccasin               = $B5E4FF;
  168.   clNavajoWhite            = $ADDEFF;
  169.   clNavy                   = $800000;
  170.   clOldLace                = $E6F5FD;
  171.   clOlive                  = $008080;
  172.   clOliveDrab              = $238E6B;
  173.   clOrange                 = $00A5FF;
  174.   clOrangered              = $0045FF;
  175.   clOrchid                 = $D670DA;
  176.   clPaleGoldenrod          = $AAE8EE;
  177.   clPaleGreen              = $98FB98;
  178.   clPaleTurquoise          = $EEEEAF;
  179.   clPaleVioletRed          = $9370DB;
  180.   clPapayaWhip             = $D5EFFF;
  181.   clPeachPuff              = $B9DAFF;
  182.   clPeru                   = $3F85CD;
  183.   clPink                   = $CBC0FF;
  184.   clPlum                   = $DDA0DD;
  185.   clPowderBlue             = $E6E0B0;
  186.   clPurple                 = $800080;
  187.   clRed                    = $0000FF;
  188.   clRosyBrown              = $8F8FBC;
  189.   clRoyalBlue              = $E16941;
  190.   clSaddleBrown            = $13458B;
  191.   clSalmon                 = $7280FA;
  192.   clSandyBrown             = $60A4F4;
  193.   clSeaGreen               = $578B2E;
  194.   clSeaShell               = $EEF5FF;
  195.   clSienna                 = $2D52A0;
  196.   clSilver                 = $C0C0C0;
  197.   clSkyBlue                = $EBCE87;
  198.   clSlateBlue              = $CD5A6A;
  199.   clSlateGray              = $908070;
  200.   clSnow                   = $FAFAFF;
  201.   clSpringGreen            = $7FFF00;
  202.   clSteelBlue              = $B48246;
  203.   clTan                    = $8CB4D2;
  204.   clTeal                   = $808000;
  205.   clThistle                = $D8BFD8;
  206.   clTomato                 = $4763FF;
  207.   clTurquoise              = $D0E040;
  208.   clViolet                 = $EE82EE;
  209.   clWheat                  = $B3DEF5;
  210.   clWhite                  = $FFFFFF;
  211.   clWhiteSmoke             = $F5F5F5;
  212.   clYellow                 = $00FFFF;
  213.   clYellowGreen            = $32CD9A;
  214.  
  215.   clDimGreen               = $3C8000;
  216.  
  217.  
  218. type
  219.   PString=^TString;
  220.   TString=type AnsiString;
  221.  
  222.   PAnsiStr=^TAnsiStr;
  223.   TAnsiStr=array[0..259] of AnsiChar;
  224.  
  225.   PWideStr=^TWideStr;
  226.   TWideStr=array[0..259] of WideChar;
  227.  
  228.   PShortStr=^TShortStr;
  229.   TShortStr=type ShortString;
  230.  
  231.   PSetChar=^TSetChar;
  232.   TSetChar=set of AnsiChar;
  233.  
  234.   PWideInt=^TWideInt;
  235.   TWideInt=type Int64;
  236.  
  237.   TColorChannel = (ccRed, ccGreen, ccBlue, ccAlpha);
  238.   TColorChannels = set of TColorChannel;
  239.  
  240.   PBoolean = ^Boolean;
  241.  
  242. { The Hole function prevents allocating some variables
  243.   inside CPU registers due an optimization }
  244. function Hole(var A):Integer;
  245.  
  246. { The Sync procedure prevents flickering while repainting windows.
  247.  Provided for backward compatibility.
  248.  Use TWinControl.DoubleBuffered property instead calling this procedure.
  249.  This function has no action under Windows NT }
  250. procedure Sync;
  251.  
  252. { The KeyPressed function returns True if specified as VKey key is being pressed or
  253.  False otherwise.  Use VK_xxx constants to specify required key }
  254. function KeyPressed(VKey: Integer): LongBool;
  255.  
  256. { The ScanCode function returns the scan code of a pressed or released key.
  257.  lKeyData parameters must contain the LParam parameter of received WM_KEYDOWN or
  258.  WM_KEYUP messages }
  259. function ScanCode(lKeyData: Integer): Byte;
  260.  
  261. { The RightKey function returns TRUE if received WM_KEYDOWN or WM_KEYUP messages
  262.  caused by pressing RightShift or RightControl keys, or FALSE otherwise }
  263. function RightKey(lKeyData: Integer): Boolean;
  264.  
  265. { The EmulateKey procedure posts messages to a control to emulate a keystroke.
  266.   The Wnd parameter specifies the window handle to a control.
  267.   The VKey paremeter specifies a virtual key code (see VK_xxx constants)}
  268. procedure EmulateKey(Wnd: HWND; VKey: Integer);
  269.  
  270. { The Perspective procedure calculates 2D on-picture coordinates of a point.
  271.  3D coordinates of a point must be specified as the X, Y and Z parameters.
  272.  The HEIGHT parameter specifies the altitude of "observer".
  273.  The BASIS parameter specifies the distance between "observer" and "picture".
  274.  The result values will be placed at the YP and ZP coordinates }
  275. procedure Perspective(const X, Y, Z, Height, Basis: Extended; var XP, YP: Extended);
  276.  
  277. { The Interpolate function returns value of the linear function passing through the points
  278.  (X1, Y1) and (X2, Y2) at the X coordinate }
  279. function Interpolate(const X1, Y1, X2, Y2, X: Extended): Extended;
  280.  
  281. { The Det function returns the determinant of a matrix described as
  282.  a11 a12 a13
  283.  a21 a22 a23
  284.  a31 a32 a33 }
  285. function Det(a11, a12, a13, a21, a22, a23, a31, a32, a33: Double): Double;
  286.  
  287. { The SinCos procedure places values of sine and cosine functions of the THETA angle
  288.  expressed in radians at the Sin and Cos variables respectively}
  289. procedure SinCos(Theta: Extended; var Sin, Cos: Extended);
  290.  
  291. { The Tan function returns tangent of an angle ALPHA }
  292. function Tan(Alpha: Extended): Extended;
  293.  
  294. { The GetLineEqn procedure places the equation parameters (A*y+B*z+C=0) of a line
  295.  passing through the points (Y1, Z1) and (Y2, Z2) at the A, B and C variables }
  296. procedure GetLineEqn(Y1, Z1, Y2, Z2: Extended; var A, B, C: Extended);
  297.  
  298. { The LinesIntersection functions return TRUE if specified lines have the intersection
  299.  point and places values of that point coordinates at Y and Z variables. If specified
  300.  lines are parallel these functions return FALSE.
  301.   The first of two functions described below receives equations of two lines specified
  302.  as A1*y+B1*z+C1=0 and A2*y+B2*z+C2=0. The second function receives coordinates of
  303.  points (Y1, Z1) and (Y2, Z2) where the first line passing through and coordinates
  304.  of points (Y3, Z3) and (Y4, Z4) which belong to the second line }
  305. function LinesIntersection(A1, B1, C1, A2, B2, C2: Extended; var Y, Z: Extended): Boolean; overload;
  306. function LinesIntersection(Y1, Z1, Y2, Z2, Y3, Z3, Y4, Z4: Extended; var Y, Z: Extended): Boolean; overload;
  307.  
  308. { The SegmentLength function returns the lengths of a segment passing through
  309.  the (X1, Y1) and (X2, Y2) points. The value returned by this function
  310.  calculated by the Pythagorean proposition }
  311. function SegmentLength(const X1, Y1, X2, Y2: Extended): Extended;
  312.  
  313. { The Rotate procedure calculates the coordinates of the point (X, Y) in
  314.  cartesian coordinate system with the origin in the (X0, Y0) point
  315.  and turned at the Alpha angle about initial coordinate system. This procedure
  316.  places calculated values at the X1 and Y1 variables}
  317. procedure Rotate(X, Y, X0, Y0, Alpha: Extended; var X1, Y1: Extended);
  318.  
  319. {  The GetAngle function returns the clockwise angle between the up direction and
  320.   the vector sum of two vectors. The Num parameter specifies the vertical coordinate
  321.   of the end of the first vector. The Den parameter specifies the horizontal coordinate
  322.   of the end of the second vector }
  323. function GetAngle(Num, Den: Double): Double;
  324.  
  325. { The GetAlpha function returns the clockwise angle between two vectors in a right-hand
  326.  cartesian coordinate system. The Y axis of that coordinate system is directed to up
  327.  and the Z axis is directed to left.
  328.   Both of two vectors have the common origin in the point (Y2, Z2). The first vector
  329.  is directed to the point (Y1, Z1) and the second vector to the point (Y3, Z3) }
  330. function GetAlpha(Y1, Z1, Y2, Z2, Y3, Z3: Double): Double;
  331.  
  332. { The GetAlphaScr function returns the counterclockwise angle between two vectors in
  333.  a left-hand cartesian coordinate system. The X axis of yhat coodinate system is
  334.  directed to left and the Y axis is directed to bottom.
  335.   Both of two vectors have the common origin in the point (X2, Y2). The first vector
  336.  is directed to the point (X1, Y1) and the second vector to the point (X3, Y3) }
  337. function GetAlphaScr(X1, Y1, X2, Y2, X3, Y3: Double): Double;
  338.  
  339. { The RebuildRect procedure verifies that both of
  340.  coodinates in the TopLeft field in the Rect variable are less than
  341.  the corresponding coordinates in the BottomRight field, i.e. the
  342.  TopLeft field really signs at the Top Left point of a rectangle }
  343. procedure RebuildRect(var Rect: TRect);
  344.  
  345. { The MoveRect procedure adds to the fields Left and Right of the
  346.  Rect variable the value of DeltaX parameter and to the fields
  347.  Top and Bottom the value of the DeltaY }
  348. procedure MoveRect(var Rect: TRect; DeltaX, DeltaY: Integer);
  349.  
  350. { The CopyRect procedure assigns to the fields of the Dest variable
  351.  the values of the Source parameter }
  352. procedure CopyRect(const Source: TRect; var Dest: TRect);
  353.  
  354. { The DeltaRect procedure increases bounds of the Rect variable
  355.   by the value of the Delta parameter, i.e. adds the Delta
  356.   value to the Right and Bottom fields and subtracts that value
  357.   from the Left and Top fields of a rectangle }
  358. procedure DeltaRect(var Rect: TRect; Delta: Integer);
  359.  
  360. { The IsEmptyRect function returns TRUE if each field of the
  361.  Rect parameter has the zero value or FALSE otherwise }
  362. function IsEmptyRect(const Rect: TRect): LongBool;
  363.  
  364. { The RectInterscetion function calculates and returns bounds
  365.  of the rectangle that consists of the area which belongs to
  366.  both of Rect1 and Rect2 rectangles. If these rectangles have
  367.  no common area this function places zero values to each field
  368.  of its result }
  369. function RectIntersection(const Rect1, Rect2: TRect): TRect;
  370.  
  371. { The SamePoint function returns TRUE if the coordinates of the
  372.  Point1 parameter are both equally to the coordinates of the
  373.  Point2 parameter, or FALSE otherwise }
  374. function SamePoint(const Point1, Point2: TPoint): LongBool;
  375.  
  376. { The IsNullPoint function returns TRUE if both of coordinates of
  377.  the Point1 have the zero value, or FALSE otherwise }
  378. function IsNullPoint(const Point: TPoint): LongBool;
  379.  
  380. { The ComparePointX function compares the coordinates of two
  381.  points described in the Point1 and Point2 parameters. The
  382.  X coordinates of those points have the advantage during the
  383.  comparison.
  384.   The function returns:
  385.    the nLess constant value in the following cases:
  386.     1: Point1.X < Point2.X
  387.     2: (Point1.X = Point2.X) and (Point1.Y < Point2.Y);
  388.    the nMore constant value in the subsequent cases:
  389.     1: Point1.X > Point2.X
  390.     2: (Point1.X = Point2.X) and (Point2.Y > Point2.Y);
  391.    the nEqual constant value in case of each coordinate of
  392.    Point1 are equal to the corresponding cooordinates of Point2 }
  393. function ComparePointX(const Point1, Point2: TPoint): Integer;
  394.  
  395. { The ComparePointY function compares the coordinates of two
  396.  points described in the Point1 and Point2 parameters. The
  397.  Y coordinates of those points have the advantage during the
  398.  comparison.
  399.   The function returns:
  400.    the nLess constant value in the following cases:
  401.     1: Point1.Y < Point2.Y
  402.     2: (Point1.Y = Point2.Y) and (Point1.X < Point2.X);
  403.    the nMore constant value in the subsequent cases:
  404.     1: Point1.Y > Point2.Y
  405.     2: (Point1.Y = Point2.Y) and (Point2.X > Point2.X);
  406.    the nEqual constant value in case of each coordinate of
  407.    Point1 are equal to the corresponding cooordinates of Point2 }
  408. function ComparePointY(const Point1, Point2: TPoint): Integer;
  409.  
  410. { The MovePoint procedure adds the values of the DispX and DispY parameters
  411.  respectively to the X and Y fields of the Point variable }
  412. procedure MovePoint(var Point: TPoint; DispX, DispY: Integer);
  413.  
  414. { The CloseTo function returns TRUE if the coordinates of the Point2 differ
  415.   from the corresponding coordinates of the Point1 on no more than the Distance
  416.   parameter, or FALSE otherwise }
  417. function CloseTo(const Point1, Point2: TPoint; Distance: Integer): LongBool;
  418.  
  419. { The CenterPoint function returns the coordinates of the central point of a rectangle}
  420. function CenterPoint(const Rect: TRect): TPoint;
  421.  
  422. { The Max function has several overloaded versions. Each of these function returns
  423.  the greater value of the two parameters but receives parameters of different types}
  424. function Max(const R1, R2: Integer): Integer; overload;
  425. function Max(const R1, R2: Extended):Extended; overload;
  426.  
  427. { Unlike two functions Max this overloaded version receives additional optional
  428.  parameter that specifies the function to compare coordinates of two points.
  429.   If the CompareY parameter is FALSE (default value) comparison use ComparePointX
  430.  function or ComparePointY function otherwise }
  431. function Max(const P1, P2: TPoint; CompareY: LongBool = False): TPoint; overload;
  432.  
  433. { The Min function has several overloaded version. Each of these function returns
  434.  the smaller value of the two parameters but receives parameters of different types}
  435. function Min(const R1, R2: Integer): Integer; overload;
  436. function Min(const R1, R2: Extended):Extended; overload;
  437.  
  438. { Unlike two functions Min this overloaded version receives additional optional
  439.  parameter that specifies the function to compare coordinates of two points.
  440.   If the CompareY parameter is FALSE (default value) comparison use ComparePointX
  441.  function or ComparePointY function otherwise }
  442. function Min(const P1, P2: TPoint; CompareY: LongBool = False): TPoint; overload;
  443.  
  444. { The ArrangeMin procedure exchanges values of two parameters if the second parameter
  445.  is smaller than the first }
  446. procedure ArrangeMin(var R1, R2: Integer);
  447.  
  448. { The ArrangeMax procedure exchanges value of two parameters if the second parameter
  449.  is greater than the first}
  450. procedure ArrangeMax(var R1, R2: Integer);
  451.  
  452. { The Sign functions return -1 if the Value parameter is negative,
  453.  1 if the parameter is positive and 0 if the parameter is equal to zero}
  454. function Sign(const Value: Integer): Integer; overload;
  455. function Sign(const Value: Extended): Extended; overload;
  456.  
  457. { The Swap procedures exchange values of two parameters specified as R1 and R2}
  458. procedure Swap(var R1, R2: Integer); overload;
  459. procedure Swap(var R1, R2: Extended); overload;
  460. procedure Swap(var R1, R2: Double); overload;
  461. procedure Swap(var R1, R2: TString); overload;
  462.  
  463. { The Inside functions return TRUE if the Value parameter is situated
  464.  between the values of Down and Up parameters, or FALSE otherwise }
  465. function Inside(Value, Down, Up: Integer): LongBool; overload;
  466. function Inside(Value, Down, Up: Extended): LongBool; overload;
  467.  
  468. { The Inside function (third version) returns TRUE if a point lies inside
  469.  a rectangle. The coordinates of a point are specified in the Point parameter
  470.  and a rectangle is defined in the Rect parameter }
  471. function Inside(const Point: TPoint; const Rect: TRect): LongBool; overload;
  472.  
  473. { The Center function returns the coordinate where it is needed to place the origin of a
  474.  line segment to superpose its center with the center of another line segment.
  475.   The Value parameter specifies the length of the first line segment.
  476.   The HiValue parameter specifies the finish coordinate of the second segment.
  477.   The LoValue optional parameter specifies the origin coordinate of the second segment }
  478. function Center(Value: Integer; HiValue: Integer; LoValue: Integer = 0): Integer;
  479.  
  480. { The IncPtr function returns the pointer that is greater than the initial pointer P
  481.   by the Delta value }
  482. function IncPtr(P: Pointer; Delta: Integer = 1): Pointer;
  483.  
  484. { The DecPtr function returns the pointer that is smaller than the initial pointer P
  485.   by the Delta value }
  486. function DecPtr(P: Pointer; Delta: Integer = 1): Pointer;
  487.  
  488. { The Join function places the LoWord value at the low-order word of a 32-bit integer
  489.  number and the HiWord value at the high-order word of that number }
  490. function Join(const LoWord, HiWord: Word): Integer; overload;
  491.  
  492. { The SetValue procedure places the integer Value at specified address if the P parameter
  493.  is not nil }
  494. procedure SetValue(P: Pointer; Value: Integer);
  495.  
  496. { The SetIntValue procedure has the same action as the previous procedure }
  497. procedure SetIntValue(P: Pointer; Value: Integer);
  498.  
  499. { The SetWordValue procedure places the word (16-bit) Value at specified address if
  500.  the P parameter is not nil }
  501. procedure SetWordValue(P: Pointer; Value: Word);
  502.  
  503. { The SetByteValue procedure places the byte (8-bit) Value at specified address if
  504.  the P parameter is not nil }
  505. procedure SetByteValue(P: Pointer; Value: Byte);
  506.  
  507. { The DecInt procedure decreases the N variable by the Delta parameter in case
  508.  of N is not smaller or equal to the Lowest parameter }
  509. procedure DecInt(var N: Integer; Delta: Integer = 1; Lowest: Integer = 0);
  510.  
  511. { The IncInt procedure increases the N variable by the Delta parameter in case
  512.  of N is not greater or equal to the Highest parameter }
  513. procedure IncInt(var N: Integer; Delta: Integer = 1; Highest: Integer = MaxInt);
  514.  
  515. { The RoundPrev function returns the greatest multiple of Divider that is
  516.  smaller or equal than Value }
  517. function RoundPrev(Value, Divider: Integer): Integer;
  518.  
  519. { The RoundNext function returns the smallest multiple of Divider that is
  520.  greater than Value }
  521. function RoundNext(Value, Divider: Integer): Integer;
  522.  
  523. { The BoolToSign function returns 1 if B is FALSE or -1 if B is TRUE }
  524. function BoolToSign(B: LongBool): Integer;
  525.  
  526. { The Among function returns TRUE if the N parameter is equal to
  527.  one of Value array elements }
  528. function Among(N: Integer; const Values: array of Integer): LongBool;
  529.  
  530. { The Incr function increases the N value by one and returns the value
  531.  assigned to the N variable }
  532. function Incr(var N: Integer): Integer;
  533.  
  534. { The Decr function decreaeses the N value by one adn returns the value
  535.  assigned to the N variable }
  536. function Decr(var N: Integer): Integer;
  537.  
  538. { The HiLong function returns the highest long word of the N parameter
  539.  of TWideInt (Int64) type }
  540. function HiLong(const N: TWideInt): LongInt;
  541.  
  542. { The LoLong function returns the lowest long word of the N parameter
  543.  of TWideInt (Int64) type }
  544. function LoLong(const N: TWideInt): LongInt;
  545.  
  546. { The HiWord function returns the highest word of the integer N parameter}
  547. function HiWord(N: Integer): word;
  548.  
  549. { The LoWord function returns the lowest word of the integer N parameter}
  550. function LoWord(N: Integer): word;
  551.  
  552. { The HiByte function returns the highest byte of the word N parameter}
  553. function HiByte(W: Word): Byte;
  554.  
  555. { The LoByte function returns the lowest byte of the word N parameter}
  556. function LoByte(W: Word): Byte;
  557.  
  558. { The AbsSub function return the absolute value of the difference between
  559.   values of the N1 and N2 parameters}
  560. function AbsSub(N1, N2: Integer): Integer;
  561.  
  562. { The Bit function returns True in case of the Value parameter bit with number defined as
  563.  Index parameter is 1, or FALSE otherwise }
  564. function Bit(Value, Index: Integer): Boolean;
  565.  
  566. { The SwapWords function exchanges high order word with the low order
  567.   word of a 32-bit integer value}
  568. function SwapWords(Value: Integer): Integer;
  569.  
  570. { The AbsInt function returns the absolute value of an integer}
  571. function AbsInt(Value: Integer): Integer;
  572.  
  573. { The FmtString function returns a formatted string based on a template string
  574.   specified as the Str parameter and an open array of TString specified as the
  575.   Value parameter. A template string should contain several occurences of
  576.    %1, %2 etc. Each occurence of %n would be replaced with the corresponding item
  577.    of the Values array }
  578. function FmtString(const Str: TString; const Values: array of TString): TString;
  579.  
  580. { The FindChars function searches a character from the Chars set inside a Source
  581.   string. The CurrentPosition parameter specifies the originating position to search
  582.   a character and the Direction parameter specifies the search direction. If Direction
  583.   is less than zero, the function searches toward the first char, or toward the end of
  584.   a string otherwise. This function returns the index of a found character }
  585. function FindChars(const Source: TString; const Chars: TSetChar;
  586.                    CurrentPosition: Integer = 1; Direction: Integer = 1): Integer;
  587.  
  588. { The FindLastChar function returns the position of the last occurence of a character
  589.   Ch in a string S }
  590. function FindLastChar(const S: TString; Ch: Char = chSpace): Integer;
  591.  
  592. { The LeftTrim function trims all characters from the first char of a string
  593.   Str until the first character that is not equal to a character Chr}
  594. function LeftTrim(const Str: TString; const Chr: Char = chSpace): TString; overload;
  595.  
  596. { The LeftTrim function trims all characters from the first char of a string
  597.   Str until the first character that is not an item of Chrs char set}
  598. function LeftTrim(const Str: TString; const Chrs: TSetChar): TString; overload;
  599.  
  600. { The RightTrim function trims all characters from the end of a string Str
  601.   until the last character that is not equal to a character Chr}
  602. function RightTrim(const Str: TString; const Chr: Char = chSpace): TString; overload;
  603.  
  604. { The RightTrim function trims all characters from the end of a string Str
  605.    until the last character that is not an item of Chrs char set}
  606. function RightTrim(const Str: TString; const Chrs: TSetChar): TString; overload;
  607.  
  608. { The LeftExpand function places Count characters Chr into the origin of
  609.   a string Str}
  610. function LeftExpand(const Str:TString; Count: Integer;
  611.                     const Chr: Char = chSpace): TString;
  612. { The RightExpand function places Count characters Chr into the end of
  613.   a string Str}
  614. function RightExpand(const Str:TString; Count: Integer;
  615.                      const Chr: Char = chSpace): TString;
  616.  
  617. { The TrimStr function trims all characters that is equal to a character
  618.   Chr from both ends of a string Str }
  619. function TrimStr(const Str: TString; const Chr: Char = chSpace): TString;
  620.  
  621. { The LeadTrim function trims Count characters from a string Str origin }
  622. function LeadTrim(const Str: TString; Count: Integer = 1): TString;
  623.  
  624. { The TrailTrim function trims Count characters form a string Str end }
  625. function TrailTrim(const Str: TString; Count: Integer = 1): TString;
  626.  
  627. { The GetSubStr function returns the substring that is
  628.   delimited by N-1 and N occurences of the Separator character in
  629.   a string Str }
  630. function GetSubStr(const Str: TString; N: Byte; Separator: Char = chSpace): TString;
  631.  
  632. { The ExtractStr function returns the substring that is delimited by
  633.   N-1 and N occurences of several space characters}
  634. function ExtractStr(const Str: TString; N : Byte): TString;
  635.  
  636. { The ExtractStrings procedure places into a List all substrings those are delimited
  637.   by occurences of the Separator character }
  638. procedure ExtractStrings(Str: TString; List: TStrings; Separator: Char = chSpace);
  639.  
  640. { The RemoveChars function removes all characters that belongs to a Chars set from
  641.   a string Str }
  642. function RemoveChars(const Str: TString; const Chars: TSetChar = [chSpace]): TString;
  643.  
  644. { The ReplaceChar function replaces all characters OldChar with a NewChar in
  645.   a string Str }
  646. function ReplaceChar(const Str: TString; OldChar, NewChar: Char): TString;
  647.  
  648.  
  649. { The ReplaceStr function replaces the first occurence of a substring OldSubStr with
  650.   a NewSubStr in a string Str }
  651. function ReplaceStr(const Str: TString; const OldSubStr, NewSubStr: TString): TString;
  652.  
  653.  
  654. { The ReplaceStrAll function replaces all occurences of a substring OldSubStr with
  655.  a NewSubStr in a string Str }
  656. function ReplaceStrAll(const Str: TString; const OldSubStr, NewSubStr: TString): TString;
  657.  
  658.  
  659. { The CleanUp procedure trims all the characters behind the first zero character in a
  660.   string Str }
  661. procedure CleanUp(var Str: TString); overload;
  662.  
  663. { The CleanUp procedure trims all the characters behind the first zero character in
  664.   a string Str and deletes all the space characters from the both ends of the
  665.   resulting string if the DoTrim parameters is True}
  666. procedure CleanUp(var Str: TString; DoTrim: LongBool);overload;
  667.  
  668. { The FillString function makes a string that consist of Count characters Chr }
  669. function FillString(Chr: Char; Count: Integer): TString;
  670.  
  671. { The UpString function converts all the characters of a string Str to uppercase}
  672. function UpString(const Str: TString): TString;
  673.  
  674. { The DnString function converts all the characters of a string Str to small letters}
  675. function DnString(const Str: TString): TString;
  676.  
  677. { The UpChar function converts a character to uppercase}
  678. function UpChar(Ch: Char): Char;
  679.  
  680. { The DnChar function converts a character to small letter}
  681. function DnChar(Ch: Char): Char;
  682.  
  683. { The GetChar function returns the character with Position index from a string
  684.   Str. Unlike Str[Position] call this function verifies that a string is not
  685.   empty and raises no exception}
  686. function GetChar(const Str:TString; Position: Integer = 1): Char;
  687.  
  688. { The ReadChar function returns the character that is placed in the process
  689.   memory at Offset bytes from a pointer Ptr }
  690. function ReadChar(Ptr: Pointer; Offset: Integer): Char;
  691.  
  692. { The ReflectStr function returns a 'mirror reflection' of a specified string}
  693. function ReflectStr(const Str: TString): TString;
  694.  
  695. { The ReadSubStr function returns the substring from a string Str that
  696.   is placed between characters with indices Head and Tail}
  697. function ReadSubStr(const Str: TString; Head, Tail: Integer): TString;
  698.  
  699. { The StrToFlt function converts a string Str to a number calling the Val procedure.
  700.   This function places to the Code variable the index of the first offending
  701.   character if it is unable to covert string, or 0 otherwise. The decimal separator
  702.   in a string must always be the dot sign }
  703. function StrToFlt(const Str: TString; var Code: Integer): Extended; overload;
  704.  
  705. { The StrToFlt function converts a string Str to a number with no error finding. The
  706.   decimal separator in a string must always be the dot sign }
  707. function StrToFlt(const Str: TString): Extended; overload;
  708.  
  709. { The FltToStr function converts a Value number into a string. The Precision
  710.   parameter specifies the number of significant decimal digits in the resulting
  711.   string. This function always use the dot character as a decimal separator }
  712. function FltToStr(const Value: Extended; Precision: Integer = 5): TString;
  713.  
  714. { The ValidInt function verifies that a string Value may be converted to an
  715.   integer number }
  716. function ValidInt(const Value: TString): LongBool;
  717.  
  718. { The ValidFloat function verifies that a string Value may be converted to
  719.   a double real number }
  720. function ValidFloat(const Value: TString): LongBool;
  721.  
  722. { The ValidFloatINF function verifies that a string Value may be converted to
  723.  a double real number and resulting number does not exceed the range of that type}
  724. function ValidFloatINF(const Value: TString): LongBool;
  725.  
  726. { The ValidateFloat function changes the regional decimal separator to the
  727.   dot sign in a string Value. This function returns the resulting string that
  728.   may be converted to a double real value or empty string if not}
  729. function ValidateFloat(const Value: TString): TString;
  730.  
  731. { The Join function concatenates two strings }
  732. function Join(const Str1, Str2: TString): TString; overload;
  733.  
  734. { The AddString procedure adds a string Value to the variable Str }
  735. procedure AddString(var Str: TString; const Value: TString);
  736.  
  737. { The BreakStr function breaks a string Str (inserting CR-LF pairs) to several lines.
  738.   Each line has only whole words and no more than Len value length. Each word in a
  739.   line is delimited by space signs. If a word in a line has too many characters, the
  740.   AltChar character would be used to delimit words }
  741. function BreakStr(const Str: TString; Len:Integer = 64; AltChar: Char = '\'): TString;
  742.  
  743. { The LastChar function returns the last char of a string Str }
  744. function LastChar(const Str: TString): Char;
  745.  
  746. { The NextChar function returns the character of a string Str, that stands
  747.   after position specifed as Pos and is not equal to a character Passed }
  748. function NextChar(const Str: TString; Pos: Integer;
  749.                   Passed: Char = chSpace): Char; overload;
  750.  
  751. { The PrevChar function returns the character of a string Str, that stands
  752.   before position specified as Pos and is not equal to a character Passed }
  753. function PrevChar(const Str: TString; Pos: Integer;
  754.                   Passed: Char = chSpace): Char; overload;
  755.  
  756. { The NextChar function returns the character of a string Str, that stands
  757.   after position specified as Pos and is not equal to a character that
  758.   belongs to a set Passed }
  759. function NextChar(const Str: TString; Pos: Integer; Passed: TSetChar): Char; overload;
  760.  
  761. { The PrevChar function returns the character of a string Str, that stands
  762.   before position specified as Pos and is not equal to a character that
  763.   belongs to a set Passed }
  764. function PrevChar(const Str: TString; Pos: Integer; Passed: TSetChar): Char; overload;
  765.  
  766. { The AdjustLength function verifies that a string Str is not less than Len
  767.   characters long.  This function fills the deficiency of characters inserting
  768.   several characters Chr before the string first character }
  769. function AdjustLength(Str: TString; Len: Integer; Ch: Char = chSpace): TString;
  770.  
  771. { The CharCount function returns the count of characters Ch in a string Str }
  772. function CharCount(const Str: TString; Ch: Char): Integer;
  773.  
  774. { The CopyToBuf procedure copies a string Source to a buffer Buf. The Size
  775.   parameter specifies the length of a buffer. If s string length exceeds Size
  776.   this function writes a null character to a buffer and returns False, otherwise
  777.   this function copies a string and returns True}
  778. function CopyToBuf(const Source: TString; Buf: PChar; Size: Integer): LongBool;
  779.  
  780.  
  781. { The MatchString function compares a string Str with items of an array Values.
  782.   This function returns the index of the array item that is equal to Str or zero
  783.   if there is no equal items. The optional CaseSensitive parameter specifies the
  784.   comparison style }
  785. function MatchString(const Str: TString; const Values: array of TString;
  786.                             CaseSensitive: LongBool = False): Integer;
  787.  
  788. { The MatchStringEx function works like the MatchString function but receives
  789.   an array as the address of the first array item (Values parameter) and the
  790.   count of array items (Count parameter) }
  791. function MatchStringEx(const Str: TString; const Values: Pointer; Count: Integer;
  792.                             CaseSensitive: LongBool = False): Integer;
  793.  
  794. { The GetLength function returns the length between the first character in
  795.   a string Str and then first null character}
  796. function GetLength(const Str: TString): Integer;
  797.  
  798. { The GetStrLen function returns assigned length of a string Str. This function
  799.   works like the standard Length function }
  800. function GetStrLen(const Str: TString): Integer;
  801.  
  802. { The IsEmptyStr function returns True if a string Str is empty or False otherwise}
  803. function IsEmptyStr(const Str: TString): LongBool;
  804.  
  805. { The CharEntryPos function returns the position of an occurence of
  806.   a character Ch in a string Str. The Entry parameter specifies the
  807.   number of occurence }
  808. function CharEntryPos(const Str: TString; Ch: Char; Entry: Integer): Integer;
  809.  
  810. { The ReplaceText procedure removes a substring of Len characters long
  811.   starting the Pos position and inserts the SubStr there }
  812. procedure ReplaceText(const SubStr:TString;var Str: TString; Pos, Len: Integer);
  813.  
  814. { The EqualText function compares two strings without case sensitivity }
  815. function EqualText(const S1, S2: TString): LongBool;
  816.  
  817. { The EqualStr function compares two strings with case sensitivity }
  818. function EqualStr(const S1, S2: TString): LongBool;
  819.  
  820. { The IntToStrLen function converts an integer N to a string and verifies
  821.   that resulting string is not not less than Len characters long.
  822.   This function fills the deficiency of characters inserting
  823.   several '0' characters  before the result first character }
  824. function IntToStrLen(N: Integer; Len: Integer = 0): TString;
  825.  
  826.  
  827. { The GetPos function returns the index value of the first character in a specified
  828.  substring that occurs in a given string. The optional CaseSencitive parameter
  829.  specifies the substring seacrhing style }
  830. function GetPos(const SubStr, Str: TString; CaseSensitive: LongBool = True): Integer;
  831.  
  832.  
  833. { The HexToInt function converts a string with hexadecimal digits to an integer.
  834.   This function places to the Code variable the index of the first offending
  835.   character if it is unable to covert string, or 0 otherwise }
  836. function HexToInt(const Hex: TString; var Code: Integer): Integer;
  837.  
  838.  
  839. { The UrlEncode function returns a string in which all alphanumeric characters
  840.   and '_' sign have been unchanged, all spaces have been replaced with '+' and
  841.   all others (unprintable) characters have been replaced with a percent '%'
  842.   sign followed by two hex digits. This function is useful to make an http
  843.   query using some national characters}
  844. function UrlEncode(Str: TString): TString;
  845.  
  846.  
  847. { The UrlDecode function have the opposite action to the UrlEncode function.
  848.   This function returns a string in which all '%HH' substrings (HH are two
  849.   hexadecimal digits) have been decoded to the corresponding characters }
  850. function UrlDecode(Str: TString): TString;
  851.  
  852.  
  853.  
  854. { The UniteLists procedure adds to List1 all the items of List2 those are not
  855.   equal to each item of List1}
  856. procedure UniteLists(List1, List2: TStrings);
  857.  
  858. function Year: Word;         // returns the current year
  859. function Month: Word;        // returns the current month
  860. function Day: Word;          // returns the current day
  861. function DayOfWeek: Word;    // returns the current day of the week;
  862.                              // Sunday = 0, Monday = 1, etc.
  863. function Hour: Word;         // returns the current hour
  864. function Minute: Word;       // returns the current minute
  865. function Second: Word;       // returns the current second
  866. function Milliseconds: Word; // returns the current milliseonds
  867. function Timer: Integer;     // returns the count of milliseconds passed since the last midnight
  868. function LeapYear(Year: Word): Boolean; // returns TRUE if a specified Year is leap
  869.                                         // or FALSE otherwise
  870.  
  871. function MonthLength(Month, Year: Word): Word; overload;// returns length of a Month of a Year
  872.                                                // using the Gregorian calendar
  873. function MonthLength: Word;  overload;// returns the length of a current Month
  874.  
  875.  
  876. { The GUIDToString function converts a GUID to a string }
  877. function GUIDToString(const GUID: TGUID): TString;
  878.  
  879. { The CreateGUID function creates a new GUID }
  880. function CreateGUID(out GUID: TGUID): HResult; stdcall;
  881.  
  882. { The GetLogicalDriveList procedure fills a string list specified in the List parameter
  883.   with names of all the logical drives on a computer }
  884. procedure GetLogicalDriveList(const List: TStrings);
  885.  
  886. { The GetFixedDriveList procedure fills a string list specified in the List parameter
  887.   with names of all the fixed (not removable, remote etc) drives on a computer}
  888. procedure GetFixedDriveList(const List: TStrings);
  889.  
  890.  
  891. { The ChangeLayout function changes the active keyboard layout. The LANG parameters
  892.   should be one of the LANG_xxxx constants, LANG_ENGLISH or LANG_RUSSIAN for
  893.   example. This function returns True if a desired language layout found and
  894.   activated, or False otherwise}
  895. function ChangeLayout(LANG: Integer): Boolean;
  896.  
  897. { The GetStringFileInfo function returns specified version information about a file.
  898.   The FileName parameter specifies the name of the file of interest.
  899.   The Key parameter specifies the name of a string version values. This parameter
  900.   must be one of the sfiXXXX constants described below}
  901. function GetStringFileInfo(const FileName: TString; const Key: TString): TString;
  902. const
  903.   sfiCompanyName       = 'CompanyName';
  904.   sfiFileDescription   = 'FileDescription';
  905.   sfiFileVersion       = 'FileVersion';
  906.   sfiInternalName      = 'InternalName';
  907.   sfiLegalCopyright    = 'LegalCopyright';
  908.   sfiLegalTrademark    = 'LegalTrademark';
  909.   sfiOriginalFileName  = 'OriginalFilename';
  910.   sfiProductName       = 'ProductName';
  911.   sfiProductVersion    = 'ProductVersion';
  912.   sfiComments          = 'Comments';
  913.   sfiPrivateBuild      = 'PrivateBuild';
  914.   sfiSpecialBuild      = 'SpecialBuild';
  915.   sfiLanguageName      = 'Language';
  916.   sfiLanguageID        = 'LanguageID';
  917.  
  918. { The LoadFile procedure copies data from a file into memory.
  919.   The FileName parameter specifies the name of a file to load.
  920.   This procedure returns address of the allocated memory in the Buffer variable,
  921.   and size of the memory in the Size variable. The allocated memory should be freed
  922.   exceptionally using the DeallocateMem function}
  923. procedure LoadFile(const FileName: TString; out Buffer: Pointer; out Size: Integer);
  924.  
  925. { The SaveFile procedure copies data form memory into a file.
  926.    The FileName parameter specifies the name of a file to save.
  927.    The Buffer parameter specifies address of the memory buffer.
  928.    The Size parameter specifies the size of the memory buffer in bytes}
  929. procedure SaveFile(const FileName: TString; Buffer: Pointer; Size: Integer);
  930.  
  931. { The GetShortName function returns the short path form
  932.   of a specified FileName parameter.}
  933. function GetShortName(const FileName: TString): TString;
  934.  
  935. { The GetLongName function converts the specified FileName to its long form.
  936.   If no long path is found, this function simply returns the specified name.}
  937. function GetLongName(const FileName: TString): TString;
  938.  
  939. { The GetUserName function returns the current user name}
  940. function GetUserName: TString;
  941.  
  942. { The GetComputerName function returns the system computer name}
  943. function GetComputerName: TString;
  944.  
  945. { The PathExists function returns TRUE if a directory specified by
  946.  Path parameter exists, or FALSE otherwise}
  947. function PathExists(const Path: TString): Boolean;
  948.  
  949. { The ExtractFolderName function returns the name of a folder
  950.   where a file specified by FileName parameter is located.}
  951. function ExtractFolderName(const FileName: TString): TString;
  952.  
  953. { The ChangeFileExt function returns the FileName parameter with
  954.   extension changes to the value of the NewExt parameter}
  955. function ChangeFileExt(const FileName, NewExt: TString): TString;
  956.  
  957. { The ForceDirectories function creates all the directories along a directory
  958.  path if they do not already exist. }
  959. function ForceDirectories(Dir: TString): Boolean;
  960.  
  961. { The GetDiskFreeSize function returns the total amount of free space
  962.   for a disk specified by its root directory }
  963. function GetDiskFreeSize(Dir: TString): Int64;
  964.  
  965. { The GetFileName function returns the name (without path and extension)
  966.  of a file specified by FileName parameter}
  967. function GetFileName(const FileName: TString): TString;
  968.  
  969. { The GetAbsoluteFileName evaluates the absolute file name using
  970.   directory name and relative file name. Here are examples of
  971.   values returned by this function:
  972.  
  973.   1.  CurrentDir = 'c:\Dir\SubDir'  RelativeName = 'filename.ext'
  974.             Return Value = 'c:\Dir\SubDir\filename.ext'
  975.   2.  CurrentDir = 'c:\Dir\SubDir'  RelativeName = '..\filename.ext'
  976.             Return Value = 'c:\Dir\filename.ext'
  977.   3.  CurrentDir = 'c:\Dir\SubDir'  RelativeName = '..\..\filename.ext'
  978.             Return Value = 'c:\filename.ext' }
  979. function GetAbsoluteFileName(CurrentDir, RelativeName: TString): TString;
  980.  
  981.  
  982. { The LoadTextFile function loads entire text from a file specified by
  983.   FileName parameter and places it to the Text variable. This function
  984.   returns error code (the value returned by IOResult function
  985.   after loading process completed) }
  986. function LoadTextFile(const FileName: TString; var Text: TString): Integer;
  987.  
  988. { The SaveTextFile function saves entire Text to a file specified by
  989.   FileName parameter. This function returns error code (the value
  990.   returned by IOResult function after saving process completed) }
  991. function SaveTextFile(const FileName, Text: TString): Integer;
  992.  
  993. { The LoadResStr functions return the value of a string resource
  994.   specified by the ID parameters. The First of two functions
  995.   loads resources from a module specified by the Instance parameter.
  996.   The second function loads resources from the current module (using
  997.   the global hInstance variable}
  998. function LoadResStr(Instance: THandle; ID: Cardinal): TString; overload;
  999. function LoadResStr(ID: Cardinal): TString; overload;
  1000.  
  1001. { The GetTempDirectory function returns the path of the directory
  1002.   designated for temporary files.}
  1003. function GetTempDirectory: TString;
  1004.  
  1005. { The GetTempFile function creates the name and the path of a temporary file.
  1006.   The initial three chars of the Prefix parametes specify prefix for the filename}
  1007. function GetTempFile(const Prefix: TString): TString;
  1008.  
  1009. { The Parameters function returns the command line parameters passed to
  1010.   the current application }
  1011. function Parameters: TString;
  1012.  
  1013. { The CheckAutomation function returns TRUE if an application is launched
  1014.   as an automation server, or FALSE otherwise }
  1015. function CheckAutomation: Boolean;
  1016.  
  1017. { The ExeName function returns the file name of the current application }
  1018. function ExeName: TString;
  1019.  
  1020. { The ExePath function returns the path to the current application }
  1021. function ExePath: TString;
  1022.  
  1023. { The InstanceName function returns the file name of the current module (EXE or DLL)}
  1024. function InstanceName: TString;
  1025.  
  1026. { The InstancePath function returns the path to the current module (EXE or DLL)}
  1027. function InstancePath: TString;
  1028.  
  1029. { The ExeVersion function returns the version of the current application}
  1030. function ExeVersion: TString;
  1031.  
  1032. { The IsDebug function returns TRUE if an executable file specified
  1033.  by the FileName perameter exists and has the Debug Build flag
  1034.  selected in project options or FALSE otherwise }
  1035. function IsDebug(const FileName:  TString): LongBool; overload;
  1036.  
  1037. { The IsDebug function returns TRUE if an application has the Debug Build
  1038.  flag specified in project options or FALSE otherwise }
  1039. function IsDebug: LongBool; overload;
  1040.  
  1041. { The GetWindowSize procedure calculated size of a window specified
  1042.   by its handle and places result at the Size variable }
  1043. procedure GetWindowSize(Handle: HWND; var Size: TSize);
  1044.  
  1045. { The GetWindowCenter procedure places values of the center of a window
  1046.  specified by its Handle at addresses specified by CenterX and CenterY
  1047.  parameters. If an address is NIL this function does not place corresponding
  1048.  value }
  1049. procedure GetWindowCenter(Handle: HWND; CenterX, CenterY: PInteger);
  1050.  
  1051. { The PressKey procedure emulates a keystroke specified
  1052.  by the VKey parameter that must contain value of a VK_xxx constant}
  1053. procedure PressKey(VKey: Byte);
  1054.  
  1055. { The GetAddress function returns a pointer to a place in program code
  1056.   where from this function has been called }
  1057. function GetAddress: Pointer;
  1058.  
  1059. type // File version record type
  1060.   PFileVersion = ^TFileVersion;
  1061.   TFileVersion = record
  1062.     HiVersion : Integer; // Major version number
  1063.     LoVersion : Integer; // Minor version number
  1064.     Release   : Integer;
  1065.     Build     : Integer;
  1066.   end;
  1067.  
  1068. { The FileVersion function returns the version of an executable file
  1069.  specified by the FileName parameter }
  1070. function FileVersion(const FileName: TString = ''): TFileVersion;
  1071.  
  1072. { The StringToVersion function converts a string with HiVersion.LoVersion.Release.Build
  1073.   format to a structure of TFileVersion record }
  1074. function StringToVersion(const Str: TString): TFileVersion;
  1075.  
  1076. { The VersionToString function converts a structure of TFileVersion
  1077.  record to a string with HiVersion.LoVersion.Release.Build format. }
  1078. function VersionToString(const Ver: TFileVersion): TString;
  1079.  
  1080. { The Version function creates a structure of TFileVersion record
  1081.   using corresponding parameters}
  1082. function Version(HiVersion, LoVersion: Integer;
  1083.   Release: Integer = 0; Build: Integer = 0): TFileVersion;
  1084.  
  1085. { The CompareVersion function compares two parameters of the TFileVersion type.
  1086.   This function returns following values:
  1087.    nLess  : Version1 is older than Version2
  1088.    nEqual : Version1 is equal to Version2
  1089.    nMore  : Version1 is later than Version2 }
  1090. function CompareVersion(const Version1, Version2: TFileVersion): Integer;
  1091.  
  1092. { The ComCtlVersion function returns the version of
  1093.  the COMCTL32.DLL currently used in a system }
  1094. function ComCtlVersion: TFileVersion;
  1095.  
  1096. { The LoadDLL function calls the LoadLibrary API function }
  1097. function LoadDLL(const Path: TString):THandle;
  1098.  
  1099. { The GetDLLProc function calls the GetProcAddress API function }
  1100. function GetDLLProc(Handle: THandle; const ProcName: TString):Pointer;
  1101.  
  1102. { The WinNT function returns TRUE if a program runs under Windows NT or
  1103.   FALSE otherwise. }
  1104. function WinNT: Boolean;
  1105.  
  1106. { The Win2K function returns TRUE if a program runs under Windows 2000 or
  1107.   FALSE otherwise. }
  1108. function Win2K: Boolean;
  1109.  
  1110. { The WinME function returns TRUE if a program runs under Windows Millenium Edition or
  1111.   FALSE otherwise. }
  1112. function WinME: Boolean;
  1113.  
  1114. { The WinXP function returns TRUE if a program runs under Windows XP or
  1115.   FALSE otherwise. }
  1116. function WinXP: Boolean;
  1117.  
  1118. type
  1119.   TOperatingSystem = (UndefinedWindows, Windows3x, Windows95, Windows98, WindowsME,
  1120.                   WindowsNT, Windows2000, WindowsXP);
  1121.  
  1122. { The GetOperatingSystem function returns the type of the operating system
  1123.   an application runs under}
  1124. function GetOperatingSystem: TOperatingSystem;
  1125.  
  1126. { The Sound procedure plays a tone with Frequency and Duration as
  1127.   specified in corresponding parameters. }
  1128. procedure Sound(Frequency, Duration: Integer);
  1129.  
  1130. { The OpenCD procedure opens a CD-ROM door }
  1131. procedure OpenCD;
  1132.  
  1133. { The CloseCD procedure closes a CD-ROM door }
  1134. procedure CloseCD;
  1135.  
  1136. { The GetNCFontHandle function creates a system defined font specified in the NCFont
  1137.   parameter:
  1138.    popup hint font (SmCaptionFont parameter),
  1139.    form caption font (CaptionFont parameter),
  1140.    menu font (MenuFont parameter),
  1141.    message box text font (MessageFont parameter),
  1142.    status bar font (StatusFont parameter).
  1143.    This function returns a handle to the created font }
  1144. type
  1145.   TNCFont = (CaptionFont, MenuFont, MessageFont, SmCaptionFont, StatusFont);
  1146. function GetNCFontHandle(const NCFont: TNCFont):THandle;
  1147.  
  1148. { The TrayWnd function returns the handle to Shell Tray Window }
  1149. function TrayWnd: HWND;
  1150.  
  1151. { The LangIDToCharset function returns the char code page
  1152.  for specified language identifier. If the LangID parameter is
  1153.  not specified the function uses the default system language identifier.}
  1154. function LangIDToCharset(LangID: Integer = 0): Byte;
  1155.  
  1156. { The OpenShortcut function reads information about shortcut object
  1157.  from .LNK file specified by the FileName variable and places
  1158.  object name at the same variable. If FileName variable does
  1159.  not contain a .LNK file name or this file is corrupted this
  1160.  function does not change the passed variable.}
  1161. procedure OpenShortcut(var FileName: TString);
  1162.  
  1163. { The GetLocale function returns the system locale identifier}
  1164. function GetLocale: Integer;
  1165.  
  1166. { The ExitWindows function calls the ExitWindowsEx API function.
  1167.  Under NT this function enabled required privileges to shut down or reboot a system. }
  1168. function ExitWindows(uFlags: UINT): BOOL;
  1169.  
  1170. { The RemoveDirectories procedure deletes all empty folders since a folder
  1171.  specified by the Path parameter}
  1172. procedure RemoveDirectories(const Path: TString);
  1173.  
  1174. { The CreateInstance function calls the CoCreateInstance function
  1175.  to create an inproc-server object. This function calls a procedure with
  1176.  address specified by the CannotCreateInstance variable
  1177.  if CoCreateInstance function fails}
  1178. function CreateInstance(CLSID, IID: TGUID; out Instance): HResult;
  1179. type
  1180.  TCannotCreateInstanceProc = procedure (CLSID: TGUID);
  1181. var
  1182.  CannotCreateInstance : TCannotCreateInstanceProc = nil;
  1183.  
  1184. { The Recycle function removes a file specified by the Name parameter to recycle bin.
  1185.  The optional Wnd parameter specifies the handle to the dialog box owning window.
  1186.  This function returns TRUE if a file is successfully deleted or FALSE otherwise.}
  1187. function Recycle(const Name: TString; Wnd: HWND = 0): Boolean;
  1188.  
  1189. { The MapNetworkDrive function displays the Map Network Drive dialog box.
  1190.  The optional Wnd parameter specifies the handle to the dialog box owning window.
  1191.  See WNetConnectionDialog function to find information about return values}
  1192. function MapNetworkDrive(Wnd: HWND = 0): DWORD;
  1193.  
  1194. { The DisconnectNetworkDrive function displays the Disconnect Network Drive dialog box.
  1195.  The optional Wnd parameter specifies the handle to the dialog box owning window.
  1196.  See WNetDisconnectDialog function to find information about return values}
  1197. function DisconnectNetworkDrive(Wnd: HWND = 0): DWORD;
  1198.  
  1199. { The BitsPerPixel function returns the number of bits per a screen pixel }
  1200. function BitsPerPixel: Integer;
  1201.  
  1202. { The RegWriteStr function writes a string value to the system registry. This function
  1203.  receives following parameters:
  1204.   RootKey - Handle to a currently open key or one of the predefined values
  1205.             (See HKEY_XXX constants);
  1206.   Key - a string specifying the name of a registry subkey;
  1207.   Name - a string containg the name of the value to set. If a value withh this name
  1208.          is not exist, the function creates it;
  1209.   Value - a string value to store it into the registry;
  1210.  
  1211.   This function returns TRUE if a value has been successfully written, or
  1212.    FALSE otherwise}
  1213. function RegWriteStr(RootKey: HKEY; Key, Name, Value: TString): Boolean;
  1214.  
  1215. { The RegQueryStr function reads a string value from the system registry. This function
  1216.  receives following parameters:
  1217.   RootKey - Handle to a currently open key or one of the predefined values
  1218.             (See HKEY_XXX constants);
  1219.   Key - a string specifying the name of a registry subkey;
  1220.  
  1221.   Success - an optional parameter specifying the address of a boolean variable. If the
  1222.             function succeeds, the variable at specified address receives TRUE or FALSE
  1223.             otherwise.}
  1224. function RegQueryStr(RootKey: HKEY; Key, Name: TString; Success: PBoolean = nil): TString;
  1225.  
  1226. { The RunApplication function runs a specified application.
  1227.    The Path parameter specifies the full file name of an application.
  1228.    The CmdLine parameter specifies the command line parameters for an application.
  1229.    The Dir parameter specifies the working directory for an application.
  1230.    The Wait parameter specifies the need to stop program flow until an application
  1231.     terminates.
  1232.  
  1233.    This function returns zero if it is unable to run an application. If succeed,
  1234.    function returns the handle to an application process, when Wait = False, or
  1235.    1 otherwise.
  1236.  
  1237.    This function does not work with 16-bit DOS applications }
  1238. function RunApplication(Path, CmdLine, Dir: TString; Wait: Boolean = False): Cardinal;
  1239.  
  1240. { The following three constants may be used as the shorter aliases of HKEY_XXX constants}
  1241. const
  1242.  HCR = HKEY_CLASSES_ROOT;
  1243.  HCU = HKEY_CURRENT_USER;
  1244.  HLM = HKEY_LOCAL_MACHINE;
  1245.  
  1246. // for unknown reason this function is not presented in WINDOWS.PAS
  1247. function LocalHandle(pMem: pointer): HLOCAL stdcall;
  1248.  
  1249. { The AllocateMem function allocates a memory block from the heap. This function
  1250.   calculates the size of a block through the product of Count and RecSize}
  1251. function AllocateMem(Count: Integer; RecSize: Integer = 1): Pointer;
  1252.  
  1253. { The DeallocateMem procedure frees a memory block allocated by the AllocateMem
  1254.   function}
  1255. procedure DeallocateMem(var Pointer);
  1256.  
  1257. { The ReallocateMem procedure changes the size of a block allocated by
  1258.   the AllocateMem function. The new size of a block is calculated as
  1259.   in the AllocateMem function }
  1260. procedure ReallocateMem(var Pointer; Count: Integer; RecSize: Integer = 1);
  1261.  
  1262. { The MemSize function returns the size of a memory block allocated by
  1263.   the AllocateMem function}
  1264. function MemSize(P: Pointer): Integer;
  1265.  
  1266. { The MoveMem procedure copies Count bytes from Source variable into Dest.
  1267.   This function works fully like the Move function. }
  1268. procedure MoveMem(const Source; var Dest; Count: Integer);
  1269.  
  1270. { The InvertMem procedure performs the NOT boolean operation for
  1271.   each byte originating the X variable. The Size parameter specifies
  1272.   the count of bytes to perfrom operation}
  1273. procedure InvertMem(var X; Size:Integer=1);
  1274.  
  1275. { The XorMem procedure performs the XOR boolean operation for
  1276.   each byte originating the X variable. The Size parameters specifies
  1277.   the count of bytes to perform operation. The Value parameter
  1278.   specifies the second operand to the operation }
  1279. procedure XorMem(var X; Size: Integer; Value: Byte);
  1280.  
  1281. { The XorMemW procedure performs the XOR boolean operation for
  1282.   each word originating the X variable. The Size parameters specifies
  1283.   the count of words (should be 'SizeOf(V) shr 1') to perform operation.
  1284.   The Value parameter specifies the second operand to the operation }
  1285. procedure XorMemW(var X; Count: Integer; Value: Word);
  1286.  
  1287. { The XorMemL procedure performs the XOR boolean operation for
  1288.   each double word originating the X variable. The Size parameters specifies
  1289.   the count of double words (should be 'SizeOf(V) shr 2') to perform operation.
  1290.   The Value parameter specifies the second operand to the operation }
  1291. procedure XorMemL(var X; Count: Integer; Value: LongInt);
  1292.  
  1293. { The FillMem procedure assigns the byte Value to each byte originating
  1294.   the X variable. The Size parameters specifies
  1295.   the count of bytes to perform operation. The Value parameter
  1296.   specifies the second operand to the operation }
  1297. procedure FillMem(var X; Size: Integer; Value: Byte = 0);
  1298.  
  1299. { The FillMemW procedure assigns the word Value to each word originating
  1300.   the X variable. The Size parameters specifies the count of words
  1301.   should be 'SizeOf(V) shr 1') to perform operation. The Value parameter
  1302.   specifies the second operand to the operation }
  1303. procedure FillMemW(var X; Count: Integer; Value: Word = 0);
  1304.  
  1305. { The FillMemL procedure assigns the double word Value to each double
  1306.   word originating the X variable.  The Size parameters specifies
  1307.   the count of double words (should be 'SizeOf(V) shr 2') to perform operation.
  1308.   The Value parameter specifies the second operand to the operation }
  1309. procedure FillMemL(var X; Count: Integer; Value: LongInt = 0);
  1310.  
  1311. { The ClearMem procedure fills the Size bytes originating the X
  1312.   variable with Zero values}
  1313. procedure ClearMem(var X; Size: Integer);
  1314.  
  1315.  
  1316. { The GetColor function translates a system color constant (clXXXX)
  1317.   into its color value }
  1318. function GetColor(Color: Integer): Integer; overload;
  1319.  
  1320. { The GetColor value returns the color with the
  1321.   corresponding Red, Green and Blue values }
  1322. function GetColor(Red, Green, Blue: Integer): Integer; overload;
  1323.  
  1324. { The IndexToRGB procedure places the Red, Green and Blue values
  1325.   from a color}
  1326. procedure IndexToRGB(Color: Integer; R, G, B : PByte);
  1327.  
  1328. { The Line procedure draws a line in a display context specified
  1329.   with its handle (DC parameter) from point (X1, Y1) to point (X2, Y2) }
  1330. procedure Line(DC: HDC; X1, Y1, X2, Y2: Integer);
  1331.  
  1332. { The clGradientActiveCaption function returns the color of the
  1333.   second color of window captions in Win98 and Win2K }
  1334. function clGradientActiveCaption: Integer;
  1335.  
  1336. type
  1337.   PIdentMapItem=^TIdentMapItem;
  1338.   TIdentMapItem=record
  1339.     Value             : Integer;
  1340.     Name              : TString;
  1341.   end;
  1342.  
  1343. { The ValueToName function scans the Map array of TIdentMapItem to find specified
  1344.   Value and returns the corresponding Name field of the array item in which the
  1345.   Value is found, or Default otherwise. }
  1346. function ValueToName(Value: Integer; Map: array of TIdentMapItem;
  1347.                      Default: TString = ''): TString;
  1348.  
  1349. { The NameToValue function scans the Map array of TIdentMapItem to find specified
  1350.   Name and returns the corresponding Value field of the array item in which the
  1351.   name is found, or Default otherwise. }
  1352. function NameToValue(Name: TString; Map: array of TIdentMapItem;
  1353.                      Default: Integer = 0): Integer;
  1354.  
  1355. { The Arctan2 function returns the arctangent angle of a number specified
  1356.   as X/Y. The signs of X and Y parameters specify quadrant of an angle}
  1357. function Arctan2(X, Y: Extended): Extended;
  1358.  
  1359. { The Int function returns the integral part of a number specified in
  1360.   the R parameter }
  1361. function Int(R: Extended): Extended;
  1362.  
  1363. { The Frac function returns the fractional part of a number specified in
  1364.   the R parameter }
  1365. function Frac(R: Extended): Extended;
  1366.  
  1367. { The Trunc function truncates an extended number into an integer}
  1368. function Trunc(R: Extended): Integer;
  1369.  
  1370. {The Round function rounds an extended number to a nearest integer value}
  1371. function Round(R: Extended): Integer;
  1372.  
  1373. { The Floor function rounds a number toward the negative infinity}
  1374. function Floor(R: Extended): Extended;
  1375.  
  1376. { The Ceil function rounds a number toward the positive infinity}
  1377. function Ceil(R: Extended): Extended;
  1378.  
  1379. { The ClearFPUEx procedure clears the FPU exception flag }
  1380. procedure ClearFPUEx;
  1381.  
  1382. { The Infinity function checks a number for an infinity value. This function returns
  1383.   -1 when R = -INF; 1 when R = +INF; 0 when R is a valid number }
  1384. function Infinity(R: Extended): Integer;
  1385.  
  1386. { The NonAtNumber function returns True if the specified parameter is not a valid
  1387.   number and not an infinity }
  1388. function NonAtNumber(R: Extended): Boolean;
  1389.  
  1390.  
  1391. function LetterToNumber(const Letter: TString): Integer;
  1392. function NumberToLetter(Number: Integer): TString;
  1393. procedure SplitAlphanumericName(const Name: TString; var Alpha: TString;
  1394.  var Num: Integer; const AdditionalChars: TSetChar = []);
  1395.  
  1396. type
  1397.  
  1398. { The TUnknown class is an implementation of the IUnknown interface. Unlike the
  1399.   TInterfacedObject class instances, objects of this class do not destroy
  1400.   themselves after RefCount falls to zero in the _Release method }
  1401.   TUnknown = class (TObject, IUnknown)
  1402.   protected
  1403.     FRefCount: Integer;
  1404.     function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
  1405.     function _AddRef: Integer; virtual; stdcall;
  1406.     function _Release: Integer; virtual; stdcall;
  1407.   public
  1408.     function Unknown: IUnknown; overload;
  1409.     procedure Unknown(out Obj); overload;
  1410.   end;
  1411.  
  1412.   TObjectX = TUnknown;
  1413.  
  1414. type
  1415.  
  1416. { TShellLink class encapsulates functions those work with shell link objects}
  1417.   EShellLinkError = class (Exception);
  1418.  
  1419.   TShellLink = class(TUnknown)
  1420.   private
  1421.     FResult: HRESULT;
  1422.     FShellLink: IShellLink;
  1423.     FPersistFile : IPersistFile;
  1424.     FTemp: WideString;
  1425.     FDesktopFolder: TString;
  1426.     FProgramsFolder: TString;
  1427.     FStartMenuFolder: TString;
  1428.     FStartUpFolder: TString;
  1429.     FMyDocsFolder: TString;
  1430.     function GetArguments: TString;
  1431.     function GetDescription: TString;
  1432.     function GetHotKey: word;
  1433.     function GetIconIndex: Integer;
  1434.     function GetIconLoc: TString;
  1435.     function GetPath: TString;
  1436.     function GetPIDL: PItemIDList;
  1437.     function GetShowCmd: Integer;
  1438.     function GetWorkDir: TString;
  1439.     procedure SetArguments(const Value: TString);
  1440.     procedure SetDescription(const Value: TString);
  1441.     procedure SetHotKey(const Value: word);
  1442.     procedure SetIconIndex(const Value: Integer);
  1443.     procedure SetIconLoc(const Value: TString);
  1444.     procedure SetPath(const Value: TString);
  1445.     procedure SetPIDL(const Value: PItemIDList);
  1446.     procedure SetShowCmd(const Value: Integer);
  1447.     procedure SetWorkDir(const Value: TString);
  1448.     procedure RunError(const Msg: TString; const Args: TString = '');
  1449.     function ResolveFileName(FileName: TString): PWideChar;
  1450.     function DesktopFolder: TString;
  1451.     function ProgramsFolder: TString;
  1452.     function StartMenuFolder: TString;
  1453.     function StartUpFolder: TString;
  1454.     function MyDocsFolder: TString;
  1455.   public
  1456.     property Path:TString read GetPath write SetPath;
  1457.       // path to the shell link reference object (i.e file or folder)
  1458.     property Description:TString read GetDescription write SetDescription;
  1459.       // description of a shell link object
  1460.     property WorkingDirectory:TString read GetWorkDir write SetWorkDir;
  1461.       // the working directory for the shell link reference object
  1462.     property Arguments:TString read GetArguments write SetArguments;
  1463.       // the command line arguments to launch the shell link reference object
  1464.     property IconLocation:TString read GetIconLoc write SetIconLoc;
  1465.       // the icon location path for the shell link reference object
  1466.     property IconIndex:Integer read GetIconIndex write SetIconIndex;
  1467.       // the icon index for the shell link reference object
  1468.     property HotKey:word read GetHotKey write SetHotKey;
  1469.       // the hot key to open shell link reference object in Windows Explorer
  1470.     property ShowCmd:Integer read GetShowCmd write SetShowCmd;
  1471.       // the show command (SW_SHOWNORMAL for example) to open the object
  1472.     property PIDL:PItemIDList read GetPIDL write SetPIDL;
  1473.       // the PIDL to the shell link refernce object
  1474.  
  1475.     { The LoadFromFile function reads information from a .lnk file }
  1476.     function LoadFromFile(FileName: TString): Boolean; virtual;
  1477.  
  1478.     { The SaveToFile function writes information to a .lnk file }
  1479.     function SaveToFile(FileName: TString): Boolean; virtual;
  1480.  
  1481.     (*******************************************************************
  1482.       The FileName string passed to LoadFromFile or SaveToFile functions
  1483.       may begin with a special folder alias that will be replaced with
  1484.       a special folder location. These are folder aliases:
  1485.  
  1486.         {$Desktop} - a shortcut on the Desktop is implied
  1487.         {$StartMenu} - a shortcut in the Start Menu
  1488.         {$Programs} - a shortcut in the Start Menu\Programs submenu
  1489.         {$StartUp} - a shortcut in the Start Menu\Programs\Startup submenu
  1490.         {$MyDocs} - a shortcut in the My Documents folder
  1491.  
  1492.       All these aliases are not case sensitive. For example, the following
  1493.       expression places a shortcut on the Desktop:
  1494.  
  1495.       SaveToFile('{$desktop}\MyShortcut.lnk');
  1496.  
  1497.       Note that the backslash placed after an alias is optional.
  1498.      *********************************************************************)
  1499.  
  1500.  
  1501.     { The SpecialFolder function returns location of a system folder. One
  1502.      of fidXXX constans should be used to specify system folder (see below).
  1503.      Except that, any ShlObj.CSIDL_xxx constant may used as the FolderID parameter}
  1504.     class function SpecialFolder(FolderID:Integer):TString;
  1505.  
  1506.     constructor Create;
  1507.     destructor Destroy;override;
  1508.   end;
  1509.  
  1510. const
  1511.  fidDesktop     = CSIDL_DESKTOP;
  1512.  fidFonts       = CSIDL_FONTS;
  1513.  fidNetHood     = CSIDL_NETHOOD;
  1514.  fidPersonal    = CSIDL_PERSONAL;
  1515.  fidPrograms    = CSIDL_PROGRAMS;
  1516.  fidRecent      = CSIDL_RECENT;
  1517.  fidSendTo      = CSIDL_SENDTO;
  1518.  fidStartUp     = CSIDL_STARTUP;
  1519.  fidTemplates   = CSIDL_TEMPLATES;
  1520.  
  1521. type
  1522.  
  1523. { The TDynamicArray class encapsulates the dynamic arrays support }
  1524.   TForEachFunc = function (Tag: Integer; Index: Integer; var Item): Integer; register;
  1525.   EDynArray = class (Exception);
  1526.  
  1527.   TDynamicArray = class (TObjectX)
  1528.   private
  1529.     FHandle: hLocal;
  1530.     FData: Pointer;
  1531.     FItemSize: Cardinal;
  1532.     FCount: Cardinal;
  1533.     function AllocMem(ACount: Cardinal; var Handle: hLocal): pointer;
  1534.     procedure FreeMem(var Handle: hLocal);
  1535.     procedure _SetCount(const Value: Cardinal);
  1536.     procedure DoSizeChanged;
  1537.   protected
  1538. { The GetFirstItem function returns the address of the first item of an array }
  1539.     function  GetFirstItem: Pointer;
  1540.  
  1541. { The PutItem procedure places an item to an array }
  1542.     procedure PutItem(Index: Integer; const Item);
  1543.  
  1544. { The GetItem procedure reads an item from an array }
  1545.     procedure GetItem(Index: Integer; out Item);
  1546.  
  1547. { The Error function raises an exception when an index passed to one of methods
  1548.   exceeds range of items }
  1549.     procedure Error(Index: Integer);
  1550.  
  1551. { Methods call the SizeChanged procedure when they changes the count of items }
  1552.     procedure SizeChanged; virtual;
  1553.  
  1554. { The SetCount procedure sets the count of an array items }
  1555.     procedure SetCount(const Value: Cardinal); virtual;
  1556.   public
  1557.  
  1558. { Use the Count property to set and get count of an array items }
  1559.     property Count: Cardinal read FCount write _SetCount;
  1560.  
  1561. { Use the ItemSize property to determine the size of each array items }
  1562.     property ItemSize: Cardinal read FItemSize;
  1563.  
  1564. { Use the FirstItem property to determine the address of the first array item }
  1565.     property FirstItem: Pointer read FData;
  1566.  
  1567. { The Add function includes an item to an array and returns the index of included item }
  1568.     function Add: Integer; virtual;
  1569.  
  1570. { The AddItem function includes an item to an array and assigns the item content }
  1571.     function AddItem(const Item): Integer; virtual;
  1572.  
  1573. { The Insert procedure inserts an item to an array at specified position }
  1574.     procedure Insert(Index: Integer); virtual;
  1575.  
  1576. { The InsertItem procedure inserts an item to an array at specified position
  1577.   and assigns the item content }
  1578.     procedure InsertItem(Index: Integer; const Item); virtual;
  1579.  
  1580. { The Delete procedure deletes an item at specified position }
  1581.     procedure Delete(Index: Integer); virtual;
  1582.  
  1583. { The DeleteItem procedure copies the content of an array item to the Item variable
  1584.   and deletes an item at specified position }
  1585.     procedure DeleteItem(Index: Integer; out Item); virtual;
  1586.  
  1587. { The Extend procedure adds Count items to an array }
  1588.     procedure Extend(Count: Cardinal = 1); virtual;
  1589.  
  1590. { The Trim procedure deletes Count items from the end of an array }
  1591.     procedure Trim(Count: Cardinal = 1); virtual;
  1592.  
  1593. { The Swap procedure exchanges content of two array items }
  1594.     procedure Swap(Index1, Index2: Cardinal); virtual;
  1595.  
  1596. { The ForEach function is used to perform some operation for each array item.
  1597.   The Tag parameter specified a user defined number that will be passed to a
  1598.   ForEachFunc function that does peform desired operation. This function
  1599.   continues processing until ForEachFunc function calls return zero. When a
  1600.   ForEachFunc call returns non zero this function stops processing and returns
  1601.   received value. If no ForEachFunc call returns non zero this function returns
  1602.   zero }
  1603.     function ForEach(Tag: Integer; ForEachFunc: TForEachFunc): Integer; virtual;
  1604.  
  1605. { The GetItemPtr function returns the address of an array item }
  1606.     function GetItemPtr(Index: Integer): Pointer;
  1607.  
  1608. { The Create constructor creates an array and assigns initial count of items and
  1609.   an item size }
  1610.     constructor Create(ACount, AItemSize: Cardinal);
  1611.     destructor Destroy; override;
  1612.   end;
  1613.  
  1614.   TDynamicArrayClass = class of TDynamicArray;
  1615.  
  1616. type
  1617.  
  1618.   TFileStatus = (fsReading, fsWriting);
  1619.  
  1620.   EFileError = class (Exception);
  1621.  
  1622. const
  1623.   faReadOnly             = $00000001;
  1624.   faHidden               = $00000002;
  1625.   faSystem               = $00000004;
  1626.   faDirectory            = $00000010;
  1627.   faArchive              = $00000020;
  1628.   faEncrypted            = $00000040;
  1629.   faNormal               = $00000080;
  1630.   faTemporary            = $00000100;
  1631.   faSparceFile           = $00000200;
  1632.   faReparsePoint         = $00000400;
  1633.   faCompressed           = $00000800;
  1634.   faOffline              = $00001000;
  1635.   faNotContentIndexed    = $00002000;
  1636.  
  1637. type
  1638.  
  1639. { The TFile class encapsulates a file input output operations }
  1640.   TFile = class (TObjectX)
  1641.   private
  1642.     FFileName: TString;
  1643.     FHandle: HFile;
  1644.     FStatus: TFileStatus;
  1645.     FDummy: LongWord;
  1646.     procedure CreateBackup;
  1647.     function GetSize: Integer;
  1648.     function GetCreationTime: TFileTime;
  1649.     function GetLastAccessTime: TFileTime;
  1650.     function GetLastWriteTime: TFileTime;
  1651.     procedure SetCreationTime(const Value: TFileTime);
  1652.     procedure SetLastAccessTime(const Value: TFileTime);
  1653.     procedure SetLastWriteTime(const Value: TFileTime);
  1654.     function GetAttributes: LongInt;
  1655.     procedure SetAttributes(const Value: LongInt);
  1656.   protected
  1657. { The Error procedure raises an exception with specified error code }
  1658.     procedure Error(Code: Integer); dynamic;
  1659.  
  1660. { The GetErrorMessage function is used to obtain error message for specified
  1661.   error code }
  1662.     function GetErrorMessage(Code: Integer): TString; dynamic;
  1663.   public
  1664.     property FileName: TString read FFileName;
  1665.              // the name of a file
  1666.     property Status: TFileStatus read FStatus;
  1667.              // the status of a file (reading or writing)
  1668.     property Handle: HFile read FHandle;
  1669.              // the handle to a file
  1670.     property Size: Integer read GetSize;
  1671.              // the size of a file
  1672.     property CreationTime: TFileTime read GetCreationTime write SetCreationTime;
  1673.              // a file creation time
  1674.     property LastAccessTime: TFileTime read GetLastAccessTime write SetLastAccessTime;
  1675.              // a file last access time
  1676.     property LastWriteTime: TFileTime read GetLastWriteTime write SetLastWriteTime;
  1677.              // a file last write time
  1678.     property Attributes: LongInt read GetAttributes write SetAttributes;
  1679.              // a file attributes
  1680.  
  1681. { The Create constructor creates a new instance of this class and a new file to write
  1682.   data. If the Backup parameter is True and a file with specified file name already
  1683.   exist the old file will be renamed adding a ~ sign to its extension }
  1684.     constructor Create(AFileName: TString; Backup: Boolean);
  1685.  
  1686. { The Write procedure writes data to a file }
  1687.     procedure Write(const Buffer; Size: Integer);
  1688.  
  1689. { The Open constructor creates a new instance of this class and opens an existing file
  1690.   to read data }
  1691.     constructor Open(AFileName: TString);
  1692.  
  1693. { The Read procedure reads data from a file }
  1694.     procedure Read(var Buffer; Size: Integer);
  1695.  
  1696. { The Seek procedure sets the file pointer to desired position from the origin
  1697.   of a file }
  1698.     procedure Seek(Position: Integer);
  1699.  
  1700. { The Close procedure closes a file and destroys an instance }
  1701.     procedure Close;
  1702.  
  1703.     destructor Destroy; override;
  1704.  
  1705. { The DecodeDateTime procedure is used to obtain numerical date and time values from
  1706.   a value that is returned by CreateTime, LastAccessTime and LastWriteTime properties }
  1707.     class procedure DecodeDateTime(const DateTime: TFileTime;
  1708.      Year, Month, Day, Hour, Min, Sec: PWord);
  1709.  
  1710. { The EncodeDateTime procedure is used to make a value to assign it to
  1711.   CreateTime, LastAccessTime and LastWriteTime properties }
  1712.     class function EncodeDateTime(Year, Month, Day, Hour, Min, Sec: Word): TFileTime;
  1713.  
  1714.  
  1715. { The UserError procedure calls the protected Error method}
  1716.     procedure UserError(Code: Integer);
  1717.   end;
  1718.  
  1719.  
  1720. { The TFileStrm class has the same destination as TFile class but inherited from
  1721.   TStream class for compatibility with descendants of that class}
  1722.   TFileStrm = class (TStream)
  1723.   private
  1724.     FHandle: HFile;
  1725.     FStatus: TFileStatus;
  1726.     FFileName: TString;
  1727.     procedure CreateBackup;
  1728.     function GetAttributes: LongInt;
  1729.     function GetCreationTime: TFileTime;
  1730.     function GetLastAccessTime: TFileTime;
  1731.     function GetLastWriteTime: TFileTime;
  1732.     procedure SetAttributes(const Value: LongInt);
  1733.     procedure SetCreationTime(const Value: TFileTime);
  1734.     procedure SetLastAccessTime(const Value: TFileTime);
  1735.     procedure SetLastWriteTime(const Value: TFileTime);
  1736.   protected
  1737.     procedure SetSize(NewSize: LongInt); override;
  1738.     procedure Error(Code: Integer); dynamic;
  1739.     function GetErrorMessage(Code: Integer): TString; dynamic;
  1740.   public
  1741.     property FileName: TString read FFileName;
  1742.     property Status: TFileStatus read FStatus;
  1743.     property Handle: HFile read FHandle;
  1744.     property CreationTime: TFileTime read GetCreationTime write SetCreationTime;
  1745.     property LastAccessTime: TFileTime read GetLastAccessTime write SetLastAccessTime;
  1746.     property LastWriteTime: TFileTime read GetLastWriteTime write SetLastWriteTime;
  1747.     property Attributes: LongInt read GetAttributes write SetAttributes;
  1748.     constructor Create(AFileName: TString; Backup: Boolean);
  1749.     constructor Open(AFileName: TString);
  1750.     function Write(const Buffer; Count: LongInt): LongInt; override;
  1751.     function Read(var Buffer; Count: LongInt): LongInt; override;
  1752.     function Seek(Offset: LongInt; Origin: Word): LongInt; override;
  1753.     procedure Close;
  1754.     destructor Destroy; override;
  1755.  
  1756.     class procedure DecodeDateTime(const DateTime: TFileTime;
  1757.      Year, Month, Day, Hour, Min, Sec: PWord);
  1758.     class function EncodeDateTime(Year, Month, Day, Hout, Min, Sec: Word): TFileTime;
  1759.     procedure UserError(Code: Integer);
  1760.   end;
  1761.  
  1762. { 2D dynamic array class declaration }
  1763.   EMatrixError = class (Exception);
  1764.   TMatrix = class;
  1765.  
  1766.   PMatrixRow = ^TMatrixRow;
  1767.   TMatrixRow = class (TDynamicArray)
  1768.   private
  1769.     FMatrix: TMatrix;
  1770.   public
  1771.     property Matrix: TMatrix read FMatrix;
  1772.     constructor Create(AColCount: Integer; AMatrix: TMatrix);
  1773.   end;
  1774.  
  1775.   TMatrixRows = class (TDynamicArray)
  1776.   private
  1777.     FWidth: Integer;
  1778.     FColIndex: Integer;
  1779.     function GetRow(Index: Integer): TMatrixRow;
  1780.     procedure SetRow(Index: Integer; const Value: TMatrixRow);
  1781.     procedure SetWidth(const Value: Integer);
  1782.     function SetWidthFunc(Index: Integer; var Row: TMatrixRow): Integer;
  1783.     function InsertColFunc(Index: Integer; var Row: TMatrixRow): Integer;
  1784.     function DeleteColFunc(Index: Integer; var Row: TMatrixRow): Integer;
  1785.   public
  1786.     property Width: Integer read FWidth write SetWidth;
  1787.     property Row[Index: Integer]: TMatrixRow read GetRow write SetRow; default;
  1788.     procedure InsertCol(Index: Integer);
  1789.     procedure DeleteCol(Index: Integer);
  1790.     constructor Create(AMatrix: TMatrix);
  1791.   end;
  1792.  
  1793.   TMatrix = class (TUnknown)
  1794.   private
  1795.     FItemSize : Cardinal;
  1796.     FRows: TMatrixRows;
  1797.     function GetColCount: Integer;
  1798.     function GetRowCount: Integer;
  1799.     procedure SetColCount(const Value: Integer);
  1800.     procedure SetRowCount(const Value: Integer);
  1801.     function GetRow(Index: Integer): TMatrixRow;
  1802.   protected
  1803.     function CreateRow: TMatrixRow; virtual;
  1804.   public
  1805.     procedure GetItem(ACol, ARow: Integer; out Item);
  1806.     procedure PutItem(ACol, ARow: Integer; const Item);
  1807.     procedure InsertRow(Index: Integer);
  1808.     procedure DeleteRow(Index: Integer);
  1809.     procedure InsertCol(Index: Integer);
  1810.     procedure DeleteCol(Index: Integer);
  1811.     function ForEachRow(Tag: Integer; ForEachRowFunc: TForEachFunc): Integer;
  1812.     property ColCount: Integer read GetColCount write SetColCount;
  1813.     property RowCount: Integer read GetRowCount write SetRowCount;
  1814.     property Row[Index: Integer]: TMatrixRow read GetRow;
  1815.     constructor Create(AColCount, ARowCount, AItemSize: Integer);
  1816.     destructor Destroy; override;
  1817.   end;
  1818.  
  1819. implementation
  1820.  
  1821. uses Consts, SysConst, DimConst;
  1822.  
  1823. type
  1824.   TLangIDItem = packed record
  1825.    LangID:  Byte;
  1826.    Charset: Byte;
  1827.   end;
  1828.  
  1829. const
  1830.   LangCount = 33;
  1831.   LangIDToCharsetInfo : array [0..LangCount] of TLangIDItem = (
  1832.    (LangID: $01; Charset: ARABIC_CHARSET),
  1833.    (LangID: $02; Charset: RUSSIAN_CHARSET),
  1834.    (LangID: $04; Charset: CHINESEBIG5_CHARSET),
  1835.    (LangID: $05; Charset: EASTEUROPE_CHARSET),
  1836.    (LangID: $06; Charset: ANSI_CHARSET),
  1837.    (LangID: $07; Charset: ANSI_CHARSET),
  1838.    (LangID: $08; Charset: GREEK_CHARSET),
  1839.    (LangID: $09; Charset: ANSI_CHARSET),
  1840.    (LangID: $0A; Charset: ANSI_CHARSET),
  1841.    (LangID: $0B; Charset: ANSI_CHARSET),
  1842.    (LangID: $0C; Charset: ANSI_CHARSET),
  1843.    (LangID: $0D; Charset: HEBREW_CHARSET),
  1844.    (LangID: $0E; Charset: EASTEUROPE_CHARSET),
  1845.    (LangID: $0F; Charset: ANSI_CHARSET),
  1846.    (LangID: $10; Charset: ANSI_CHARSET),
  1847.    (LangID: $13; Charset: ANSI_CHARSET),
  1848.    (LangID: $14; Charset: ANSI_CHARSET),
  1849.    (LangID: $15; Charset: EASTEUROPE_CHARSET),
  1850.    (LangID: $16; Charset: ANSI_CHARSET),
  1851.    (LangID: $18; Charset: EASTEUROPE_CHARSET),
  1852.    (LangID: $19; Charset: RUSSIAN_CHARSET),
  1853.    (LangID: $1A; Charset: EASTEUROPE_CHARSET),
  1854.    (LangID: $1B; Charset: EASTEUROPE_CHARSET),
  1855.    (LangID: $1C; Charset: EASTEUROPE_CHARSET),
  1856.    (LangID: $1D; Charset: ANSI_CHARSET),
  1857.    (LangID: $1E; Charset: THAI_CHARSET),
  1858.    (LangID: $1F; Charset: TURKISH_CHARSET),
  1859.    (LangID: $22; Charset: RUSSIAN_CHARSET),
  1860.    (LangID: $23; Charset: RUSSIAN_CHARSET),
  1861.    (LangID: $24; Charset: EASTEUROPE_CHARSET),
  1862.    (LangID: $25; Charset: BALTIC_CHARSET),
  1863.    (LangID: $26; Charset: BALTIC_CHARSET),
  1864.    (LangID: $27; Charset: BALTIC_CHARSET),
  1865.    (LangID: $2a; Charset: VIETNAMESE_CHARSET));
  1866.  
  1867. function Hole(var A):Integer;
  1868. asm
  1869. end;
  1870.  
  1871. procedure Sync;
  1872. asm
  1873.    call WinNT
  1874.    test eax, 1
  1875.    jz   @@10
  1876.    ret
  1877. @@10:
  1878.    mov   dx,3dah
  1879. @@wait:
  1880.    in    al,dx
  1881.    test  al,8
  1882.    jz    @@wait
  1883. end;
  1884.  
  1885. function KeyPressed(VKey: Integer): LongBool;
  1886. asm
  1887.    push  eax
  1888.    call  GetKeyState
  1889.    and   eax, 0080h
  1890.    shr   al, 7
  1891. end;
  1892.  
  1893. function ScanCode(lKeyData: Integer): Byte;
  1894. asm
  1895.    shr   eax, 16
  1896.    and   ax, 00FFh
  1897. end;
  1898.  
  1899. function RightKey(lKeyData: Integer): Boolean;
  1900. asm
  1901.    shr   eax, 24
  1902.    and   ax, 0001h
  1903. end;
  1904.  
  1905. procedure EmulateKey(Wnd: HWND; VKey: Integer);
  1906. asm
  1907.    push   0
  1908.    push   edx
  1909.    push   0101H  //WM_KEYUP
  1910.    push   eax
  1911.    push   0
  1912.    push   edx
  1913.    push   0100H  //WM_KEYDOWN
  1914.    push   eax
  1915.    call   PostMessage
  1916.    call   PostMessage
  1917. end;
  1918.  
  1919.  
  1920. procedure Perspective(const X, Y, Z, Height, Basis: Extended; var XP, YP: Extended);
  1921. var
  1922.  Den: Extended;
  1923. begin
  1924.  Den:=Y+Basis;
  1925.  if Abs(Den)<1e-100 then Den:=1e-100;
  1926.  XP:=Basis*X/Den;
  1927.  YP:=(Basis*Z+Height*Y)/Den;
  1928. end;
  1929.  
  1930. function Interpolate(const X1, Y1, X2, Y2, X: Extended): Extended;
  1931. begin
  1932.  if X1=X2 then Result:=(Y1+Y2)/2 else Result:=(Y1*(X2-X)+Y2*(X-X1))/(X2-X1);
  1933. end;
  1934.  
  1935. function Det(a11, a12, a13, a21, a22, a23, a31, a32, a33: Double): Double;
  1936. begin
  1937.  Result:=a11*a22*a33-a11*a23*a32+
  1938.          a12*a23*a31-a12*a21*a33+
  1939.          a13*a21*a32-a13*a22*a31;
  1940. end;
  1941.  
  1942. procedure SinCos(Theta: Extended; var Sin, Cos: Extended);
  1943. asm
  1944.    fld     Theta
  1945.    fsincos
  1946.    fstp    tbyte ptr [edx]
  1947.    fstp    tbyte ptr [eax]
  1948.    fwait
  1949. end;
  1950.  
  1951. function Tan(Alpha: Extended): Extended;
  1952. asm
  1953.    fld   Alpha
  1954.    fptan
  1955.    fstp  st(0)
  1956.    fwait
  1957. end;
  1958.  
  1959. procedure GetLineEqn(Y1, Z1, Y2, Z2: Extended; var A, B, C: Extended);
  1960. var
  1961.  DY, DZ: Extended;
  1962. const
  1963.  Eps = 1e-20;
  1964. begin
  1965.  DY:=Abs(Y1-Y2); DZ:=Abs(Z1-Z2);
  1966.  if DY <= eps then begin
  1967.   A:=1; B:=0; C:=-Y1;
  1968.   Exit;
  1969.  end;
  1970.  if DZ <= eps then begin
  1971.   A := 0; B := 1; C := -Z1;
  1972.   Exit;
  1973.  end;
  1974.  if (DY > DZ) then begin
  1975.   A:=1;
  1976.   B:=(Y2 - Y1)/(Z1 - Z2);
  1977.  end else begin
  1978.   B:=1;
  1979.   A:=(Z2 - Z1)/(Y1 - Y2);
  1980.  end;
  1981.  C:=-A*Y1-B*Z1;
  1982. end;
  1983.  
  1984. function LinesIntersection(A1, B1, C1, A2, B2, C2: Extended; var Y, Z: Extended): Boolean;
  1985. var
  1986.  Det: Extended;
  1987. begin
  1988.  Det:=A1*B2-A2*B1;
  1989.  Result:=Abs(Det)>1e-20;
  1990.  if Result then begin
  1991.   Y := (c2*b1-c1*b2)/det;
  1992.   Z := (a2*c1-a1*c2)/det;
  1993.  end;
  1994. end;
  1995.  
  1996. function SegmentLength(const X1, Y1, X2, Y2: Extended): Extended;
  1997. asm
  1998.    fld   X1
  1999.    fld   X2
  2000.    fsub
  2001.    fld   st(0)
  2002.    fmul
  2003.    fld   Y1
  2004.    fld   Y2
  2005.    fsub
  2006.    fld   st(0)
  2007.    fmul
  2008.    fadd
  2009.    fsqrt
  2010.    fwait
  2011. end;
  2012.  
  2013. procedure Rotate(X, Y, X0, Y0, Alpha: Extended; var X1, Y1: Extended);
  2014. var
  2015.  Sin, Cos: Extended;
  2016.  DX, DY: Extended;
  2017. begin
  2018.  SinCos(Alpha, Sin, Cos);
  2019.  DX:=(X-X0); DY:=(Y-Y0);
  2020.  X1:=DX*Cos+DY*Sin+X0;
  2021.  Y1:=DY*Cos-DX*Sin+Y0;
  2022. end;
  2023.  
  2024. function LinesIntersection(Y1, Z1, Y2, Z2, Y3, Z3, Y4, Z4: Extended; var Y, Z: Extended): Boolean; overload;
  2025. var
  2026.  A1, B1, C1, A2, B2, C2: Extended;
  2027. begin
  2028.  GetLineEqn(Y1, Z1, Y2, Z2, A1, B1, C1);
  2029.  GetLineEqn(Y3, Z3, Y4, Z4, A2, B2, C2);
  2030.  Result:=LinesIntersection(A1, B1, C1, A2, B2, C2, Y, Z);
  2031. end;
  2032.  
  2033. procedure RebuildRect(var Rect:TRect);
  2034. asm
  2035.    push  esi
  2036.    push  edx
  2037.    mov   esi, eax
  2038.    mov   eax, [esi]
  2039.    mov   edx, [esi+8]
  2040.    cmp   eax, edx
  2041.    jl    @@10
  2042.    mov   [esi+8], eax
  2043.    mov   [esi], edx
  2044. @@10:
  2045.    mov   eax, [esi+4]
  2046.    mov   edx, [esi+12]
  2047.    cmp   eax, edx
  2048.    jl    @@20
  2049.    mov   [esi+12], eax
  2050.    mov   [esi+4], edx
  2051. @@20:
  2052.    mov   eax, esi
  2053.    pop   edx
  2054.    pop   esi
  2055. end;
  2056.  
  2057. procedure MoveRect(var Rect: TRect; DeltaX, DeltaY: Integer);
  2058. asm
  2059.    add   [eax], edx
  2060.    add   [eax+8], edx
  2061.    add   [eax+4], ecx
  2062.    add   [eax+12], ecx
  2063. end;
  2064.  
  2065.  
  2066. procedure CopyRect(const Source: TRect; var Dest: TRect);
  2067. asm
  2068.    mov   ecx, 16
  2069.    call  MoveMem
  2070. end;
  2071.  
  2072. procedure DeltaRect(var Rect: TRect; Delta: Integer);
  2073. asm
  2074.    call  RebuildRect
  2075.    add   [eax].TRect.Right, edx
  2076.    add   [eax].TRect.Bottom, edx
  2077.    sub   [eax].TRect.Top, edx
  2078.    sub   [eax].TRect.Left, edx
  2079. end;
  2080.  
  2081. function IsEmptyRect(const Rect: TRect): LongBool;
  2082. asm
  2083.    push  esi
  2084.    push  edx
  2085.    mov   esi, eax
  2086.    xor   eax, eax
  2087.    mov   edx, [esi]
  2088.    test  edx, edx
  2089.    jnz   @@10
  2090.    mov   edx, [esi+4]
  2091.    test  edx, edx
  2092.    jnz   @@10
  2093.    mov   edx, [esi+8]
  2094.    test  edx, edx
  2095.    jnz   @@10
  2096.    mov   edx, [esi+12]
  2097.    test  edx, edx
  2098.    jnz   @@10
  2099.    not   eax
  2100. @@10:
  2101.    pop   edx
  2102.    pop   esi
  2103. end;
  2104.  
  2105. function RectIntersection(const Rect1, Rect2: TRect): TRect;
  2106. begin
  2107.  RebuildRect(PRect(@Rect1)^);
  2108.  RebuildRect(PRect(@Rect2)^);
  2109.  if Inside(Rect2.TopLeft, Rect1) then begin
  2110.   if Inside(Rect2.BottomRight, Rect1) then begin
  2111.    Result:=Rect2;
  2112.    Exit;
  2113.   end else begin
  2114.    Result.TopLeft:=Rect2.TopLeft;
  2115.    Result.BottomRight:=Rect1.BottomRight;
  2116.    Exit;
  2117.   end;
  2118.  end;
  2119.  if Inside(Rect2.BottomRight, Rect1) then begin
  2120.   if Inside(Rect2.TopLeft,Rect1) then begin
  2121.    Result:=Rect2;
  2122.    Exit;
  2123.   end else begin
  2124.    Result.TopLeft:=Rect1.TopLeft;
  2125.    Result.BottomRight:=Rect2.BottomRight;
  2126.    Exit;
  2127.   end;
  2128.  end;
  2129.  if Inside(Rect1.TopLeft, Rect2) then begin
  2130.   if Inside(Rect1.BottomRight, Rect2) then begin
  2131.    Result:=Rect1;
  2132.    Exit;
  2133.   end else begin
  2134.    Result.TopLeft:=Rect1.TopLeft;
  2135.    Result.BottomRight:=Rect2.BottomRight;
  2136.    Exit;
  2137.   end;
  2138.  end;
  2139.  if Inside(Rect1.BottomRight, Rect2) then begin
  2140.   if Inside(Rect1.TopLeft, Rect2) then begin
  2141.    Result:=Rect1;
  2142.    Exit;
  2143.   end else begin
  2144.    Result.TopLeft:=Rect2.TopLeft;
  2145.    Result.BottomRight:=Rect1.BottomRight;
  2146.    Exit;
  2147.   end;
  2148.  end;
  2149.  ClearMem(Result, SizeOf(Result));
  2150. end;
  2151.  
  2152. function SamePoint(const Point1,Point2: TPoint):LongBool;
  2153. begin
  2154.  Result:=TWideInt(Point1)=TWideInt(Point2);
  2155. end;
  2156.  
  2157. function IsNullPoint(const Point: TPoint): LongBool;
  2158. begin
  2159.  Result:=not LongBool(TWideInt(Point));
  2160. end;
  2161.  
  2162. function ComparePointX(const Point1, Point2: TPoint): Integer;
  2163. asm
  2164.    push  esi
  2165.    push  edi
  2166.    mov   esi, eax
  2167.    mov   edi, edx
  2168.    mov   eax, [esi]
  2169.    mov   edx, [edi]
  2170.    cmp   eax, edx
  2171.    jle   @@10
  2172.    mov   eax, nMore
  2173.    jmp   @@50
  2174. @@10:
  2175.    je    @@20
  2176.    mov   eax, nLess
  2177.    jmp   @@50
  2178. @@20:
  2179.    mov   eax, [esi+4]
  2180.    mov   edx, [edi+4]
  2181.    cmp   eax, edx
  2182.    jle   @@30
  2183.    mov   eax, nMore
  2184.    jmp   @@50
  2185. @@30:
  2186.    je    @@40
  2187.    mov   eax, nLess
  2188.    jmp   @@50
  2189. @@40:
  2190.    mov   eax, nEqual
  2191. @@50:
  2192.    pop   edi
  2193.    pop   esi
  2194. end;
  2195.  
  2196. function ComparePointY(const Point1, Point2: TPoint): Integer;
  2197. asm
  2198.    push  esi
  2199.    push  edi
  2200.    mov   esi, eax
  2201.    mov   edi, edx
  2202.    mov   eax, [esi+4]
  2203.    mov   edx, [edi+4]
  2204.    cmp   eax, edx
  2205.    jle   @@10
  2206.    mov   eax, nMore
  2207.    jmp   @@50
  2208. @@10:
  2209.    je    @@20
  2210.    mov   eax, nLess
  2211.    jmp   @@50
  2212. @@20:
  2213.    mov   eax, [esi]
  2214.    mov   edx, [edi]
  2215.    cmp   eax, edx
  2216.    jle   @@30
  2217.    mov   eax, nMore
  2218.    jmp   @@50
  2219. @@30:
  2220.    je    @@40
  2221.    mov   eax, nLess
  2222.    jmp   @@50
  2223. @@40:
  2224.    mov   eax, nEqual
  2225. @@50:
  2226.    pop   edi
  2227.    pop   esi
  2228. end;
  2229.  
  2230. procedure MovePoint(var Point: TPoint; DispX, DispY: Integer);
  2231. asm
  2232.    add    [eax], edx
  2233.    add    [eax+4], ecx
  2234. end;
  2235.  
  2236. function CloseTo(const Point1, Point2: TPoint; Distance: Integer): LongBool;
  2237. begin
  2238.  Result:=Inside(Point2, Rect(Point1.X-Distance, Point1.Y-Distance,
  2239.                              Point1.X+Distance, Point1.Y+Distance));
  2240. end;
  2241.  
  2242. function GetAngle(Num, Den:Double):Double;
  2243. begin
  2244.  if Den<>0 then begin
  2245.   Result:=arctan(Num/Den);
  2246.   if Den<0 then Result:=HalfCycle+Result else if Num<0 then Result:=FullCycle+Result;
  2247.  end else begin
  2248.   if Num>0 then Result:=Quadrant else Result:=3*Quadrant;
  2249.  end;
  2250. end;
  2251.  
  2252. function GetAlpha(Y1, Z1, Y2, Z2, Y3, Z3:Double):Double;
  2253. var A1, A2:Double;
  2254. begin
  2255.  A1:=GetAngle(Z1-Z2,Y2-Y1);
  2256.  A2:=GetAngle(Z3-Z2,Y2-Y3);
  2257.  if A2<A1 then A2:=FullCycle+A2;
  2258.  Result:=A2-A1;
  2259. end;
  2260.  
  2261. function GetAlphaScr(X1, Y1, X2, Y2, X3, Y3:Double):Double;
  2262. var A1, A2:Double;
  2263. begin
  2264.  A1:=GetAngle(X2-X1,Y1-Y2);
  2265.  A2:=GetAngle(X2-X3,Y3-Y2);
  2266.  if A2<A1 then A2:=FullCycle+A2;
  2267.  Result:=A2-A1;
  2268. end;
  2269.  
  2270. function CenterPoint(const Rect: TRect): TPoint;
  2271. asm
  2272.    push  esi
  2273.    mov   esi, eax
  2274.    mov   eax, [esi]
  2275.    add   eax, [esi+8]
  2276.    shr   eax, 1
  2277.    mov   [edx].TPoint.x, eax
  2278.    mov   eax, [esi+4]
  2279.    add   eax, [esi+12]
  2280.    shr   eax, 1
  2281.    mov   [edx].TPoint.y, eax
  2282.    pop   esi
  2283. end;
  2284.  
  2285. function Max(const R1,R2:Integer):Integer;overload;
  2286. asm
  2287.    cmp eax, edx
  2288.    jng @@10
  2289.    ret
  2290. @@10:
  2291.    mov eax, edx
  2292. end;
  2293.  
  2294. function Max(const R1,R2:Extended):Extended;overload;
  2295. begin
  2296.  if R1>R2 then Result:=R1 else Result:=R2;
  2297. end;
  2298.  
  2299. function Max(const P1, P2: TPoint; CompareY: LongBool=False): TPoint; overload;
  2300. var
  2301.  F: function (const Point1, Point2: TPoint): Integer;
  2302. begin
  2303.  if CompareY then F:=ComparePointY else F:=ComparePointX;
  2304.  if F(P1, P2) = nMore then Result:=P1 else Result:=P1;
  2305. end;
  2306.  
  2307. function Min(const R1,R2:Integer):Integer;overload;
  2308. asm
  2309.   cmp eax, edx
  2310.   jnl @@10
  2311.   ret
  2312. @@10:
  2313.   mov eax, edx
  2314. end;
  2315.  
  2316. function Min(const R1,R2:Extended):Extended;overload;
  2317. begin
  2318.  if R1<R2 then Result:=R1 else Result:=R2;
  2319. end;
  2320.  
  2321. function Min(const P1, P2: TPoint; CompareY: LongBool = False): TPoint;
  2322. var
  2323.  F: function (const Point1, Point2: TPoint): Integer;
  2324. begin
  2325.  if CompareY then F:=ComparePointY else F:=ComparePointX;
  2326.  if F(P1, P2) = nLess then Result:=P1 else Result:=P2;
  2327. end;
  2328.  
  2329. procedure ArrangeMin(var R1, R2: Integer);
  2330. asm
  2331.    mov   ecx, [eax]
  2332.    cmp   ecx, [edx]
  2333.    jl    @@10
  2334.    xchg  ecx, [edx]
  2335.    mov   [eax], ecx
  2336. @@10:
  2337. end;
  2338.  
  2339. procedure ArrangeMax(var R1, R2: Integer);
  2340. asm
  2341.    mov   ecx, [eax]
  2342.    cmp   ecx, [edx]
  2343.    jg    @@10
  2344.    xchg  ecx, [edx]
  2345.    mov   [eax], ecx
  2346. @@10:
  2347. end;
  2348.  
  2349. function Sign(const Value:Integer):Integer;overload;
  2350. asm
  2351.    test eax, eax
  2352.    jl   @@10
  2353.    jg   @@20
  2354.    ret
  2355. @@10:
  2356.    mov  eax, -1
  2357.    ret
  2358. @@20:
  2359.    mov  eax, 1
  2360. end;
  2361.  
  2362. function Sign(const Value:Extended):Extended;overload;
  2363. begin
  2364.  if Value<0 then Result:=-1.0 else
  2365.   if Value>0 then Result:=1.0 else Result:=0.0;
  2366. end;
  2367.  
  2368. procedure Swap(var R1, R2: Integer);overload;
  2369. asm
  2370.    mov  ecx, [eax]
  2371.    xchg ecx, [edx]
  2372.    mov  [eax], ecx
  2373. end;
  2374.  
  2375. procedure Swap(var R1, R2:Extended);overload;
  2376. var Temp:Extended;
  2377. begin
  2378.  Temp:=R1;
  2379.  R1:=R2;
  2380.  R2:=Temp;
  2381. end;
  2382.  
  2383. procedure Swap(var R1,R2:Double);overload;
  2384. var Temp:Double;
  2385. begin
  2386.  Temp:=R1;
  2387.  R1:=R2;
  2388.  R2:=Temp;
  2389. end;
  2390.  
  2391. procedure Swap(var R1,R2:TString);overload;
  2392. var Temp:TString;
  2393. begin
  2394.  Temp:=R1;
  2395.  R1:=R2;
  2396.  R2:=Temp;
  2397. end;
  2398.  
  2399. function Inside(Value,Down,Up:Integer):LongBool;overload;
  2400. asm
  2401.    cmp   edx, ecx
  2402.    jl    @@10
  2403.    xchg  ecx, edx
  2404. @@10:
  2405.    cmp   eax, edx
  2406.    jnl   @@20
  2407.    xor   eax, eax
  2408.    ret
  2409. @@20:
  2410.    cmp   eax, ecx
  2411.    setng al
  2412.    and   eax, 0FFH
  2413. end;
  2414.  
  2415. function Inside(Value,Down,Up:Extended):LongBool;overload;
  2416. var
  2417.  Mx,Mn:Extended;
  2418. begin
  2419.  Mx:=Max(Down,Up);
  2420.  Mn:=Min(Down,Up);
  2421.  Result:=(Value>=Mn) and (Value<=Mx);
  2422. end;
  2423.  
  2424. function Inside(const Point:TPoint;const Rect:TRect):LongBool;overload;
  2425. asm
  2426.    push  esi
  2427.    push  edi
  2428.    push  ebx
  2429.    mov   esi, eax
  2430.    mov   edi, edx
  2431.    mov   eax, [esi]
  2432.    mov   edx, [edi]
  2433.    mov   ecx, [edi+8]
  2434.    call  Inside
  2435.    mov   ebx, eax
  2436.    mov   eax, [esi+4]
  2437.    mov   edx, [edi+4]
  2438.    mov   ecx, [edi+12]
  2439.    call  Inside
  2440.    and   eax, ebx
  2441.    pop   ebx
  2442.    pop   edi
  2443.    pop   esi
  2444. end;
  2445.  
  2446. function Center(Value:Integer;HiValue:Integer;LoValue:Integer=0):Integer;
  2447. asm
  2448.    sub edx, ecx
  2449.    sub edx, eax
  2450.    shr edx, 1
  2451.    add ecx, edx
  2452.    mov eax, ecx
  2453. end;
  2454.  
  2455. function IncPtr(P:Pointer;Delta:Integer=1):Pointer;register;
  2456. asm
  2457.    add   eax, edx
  2458. end;
  2459.  
  2460. function DecPtr(P:Pointer;Delta:Integer=1):Pointer;register;
  2461. asm
  2462.    sub eax, edx
  2463. end;
  2464.  
  2465. function Join(const LoWord, HiWord:word):Integer;
  2466. asm
  2467.    shl   edx, 16
  2468.    and   eax, 0FFFFh
  2469.    or    eax, edx
  2470. end;
  2471.  
  2472. procedure SetValue(P: Pointer; Value: Integer); register;
  2473. asm
  2474.    test eax, eax
  2475.    jz   @@10
  2476.    mov  [eax], edx
  2477. @@10:
  2478. end;
  2479.  
  2480. procedure SetIntValue(P: Pointer; Value: Integer);
  2481. asm
  2482.    test eax, eax
  2483.    jz   @@10
  2484.    mov  [eax], edx
  2485. @@10:
  2486. end;
  2487.  
  2488. procedure SetWordValue(P: Pointer; Value: word);
  2489. asm
  2490.    test eax, eax
  2491.    jz   @@10
  2492.    mov  [eax], dx
  2493. @@10:
  2494. end;
  2495.  
  2496. procedure SetByteValue(P: Pointer; Value: byte);
  2497. asm
  2498.    test eax, eax
  2499.    jz   @@10
  2500.    mov  [eax], dl
  2501. @@10:
  2502. end;
  2503.  
  2504. procedure DecInt(var N: Integer; Delta: Integer = 1; Lowest: Integer = 0);
  2505. asm
  2506.    push   ebx
  2507.    mov    ebx, [eax]
  2508.    sub    ebx, edx
  2509.    cmp    ebx, ecx
  2510.    jl     @@10
  2511.    mov    [eax], ebx
  2512.    pop    ebx
  2513.    ret
  2514. @@10:
  2515.    mov    [eax], ecx
  2516.    pop    ebx
  2517. end;
  2518.  
  2519. procedure IncInt(var N: Integer; Delta: Integer = 1; Highest: Integer = MaxInt);
  2520. asm
  2521.    push   ebx
  2522.    mov    ebx, [eax]
  2523.    add    ebx, edx
  2524.    cmp    ebx, ecx
  2525.    jg     @@10
  2526.    mov    [eax], ebx
  2527.    pop    ebx
  2528.    ret
  2529. @@10:
  2530.    mov    [eax], ecx
  2531.    pop    ebx
  2532. end;
  2533.  
  2534. function RoundPrev(Value, Divider: Integer): Integer;
  2535. {begin
  2536.  Result:=(Value div Divider) * Divider;}
  2537. asm
  2538.    mov  ecx, edx
  2539.    cdq
  2540.    idiv ecx
  2541.    imul ecx
  2542. end;
  2543.  
  2544. function RoundNext(Value, Divider: Integer): Integer;
  2545. asm
  2546.    mov   ecx, edx
  2547.    cdq
  2548.    idiv  ecx
  2549.    imul  ecx
  2550.    add   eax, ecx
  2551. end;
  2552.  
  2553. function BoolToSign(B: LongBool): Integer;
  2554. asm
  2555.    test  eax, eax
  2556.    jz    @@10
  2557.    xor   eax, eax
  2558.    dec   eax
  2559.    ret
  2560. @@10:
  2561.    inc   eax
  2562. end;
  2563.  
  2564. function FmtString(const Str:TString;const Values:array of TString):TString;
  2565. var
  2566.  i:Integer;
  2567. begin
  2568.  Result:=Str;
  2569.  for i:=High(Values) downto Low(Values) do
  2570.    Result:=ReplaceStrAll(Result, '%'+IntToStr(i+1), Values[i]);
  2571. end;
  2572.  
  2573. function FindChars(const Source:TString;const Chars:TSetChar;CurrentPosition:Integer=1;Direction:Integer=1):Integer;
  2574. var
  2575.  i,len:Integer;
  2576.  Delta:Integer;
  2577. begin
  2578.  Result:=0;
  2579.  if Direction<0 then Delta:=-1 else Delta:=1;
  2580.  i:=CurrentPosition;
  2581.  len:=Length(Source);
  2582.  if Len=0 then Exit;
  2583.  repeat
  2584.   if Source[i] in Chars then begin
  2585.    Result:=i;
  2586.    Break;
  2587.   end;
  2588.   i:=i+Delta;
  2589.   if (i<1) or (i>len) then Break;
  2590.  until false;
  2591. end;
  2592.  
  2593. function FindLastChar(const S: TString; Ch: Char = chSpace): Integer;
  2594. asm
  2595.    test  eax, eax
  2596.    jz    @@30
  2597.    mov   ecx, [eax - 4]
  2598.    test  ecx, ecx
  2599. @@10:
  2600.    jz    @@30
  2601.    mov   dh, [eax + ecx]
  2602.    cmp   dl, dh
  2603.    jne   @@20
  2604.    mov   eax, ecx
  2605.    inc   eax
  2606.    ret
  2607. @@20:
  2608.    dec   ecx
  2609.    jmp   @@10
  2610. @@30:
  2611.    xor   eax, eax
  2612.    dec   eax
  2613. end;
  2614.  
  2615. function LeftTrim(const Str:TString;const Chr:Char=chSpace):TString;
  2616. var
  2617.  Count:Integer;
  2618. begin
  2619.  Result:=Str;
  2620.  Count:=0;
  2621.  while Length(Result)>0 do begin
  2622.   if Result[Count+1]=Chr then Inc(Count) else Break;
  2623.  end;
  2624.  if Count<>0 then Delete(Result,1,Count);
  2625. end;
  2626.  
  2627. function LeftTrim(const Str: TString; const Chrs: TSetChar): TString; overload;
  2628. var
  2629.  Count:Integer;
  2630. begin
  2631.  Result:=Str;
  2632.  Count:=0;
  2633.  while Length(Result)>0 do begin
  2634.   if Result[Count+1] in Chrs then Inc(Count) else Break;
  2635.  end;
  2636.  if Count<>0 then Delete(Result,1,Count);
  2637. end;
  2638.  
  2639.  
  2640. function RightTrim(const Str:TString;const Chr:Char=chSpace):TString;
  2641. var Count:Integer;
  2642. begin
  2643.  Result:=Str;
  2644.  Count:=0;
  2645.  while Length(Result)>0 do begin
  2646.   if Result[Length(Result)-Count]=Chr then Inc(Count) else Break;
  2647.  end;
  2648.  if Count<>0 then SetLength(Result,Length(Result)-Count);
  2649. end;
  2650.  
  2651.  
  2652. function RightTrim(const Str: TString; const Chrs: TSetChar): TString; overload;
  2653. var Count:Integer;
  2654. begin
  2655.  Result:=Str;
  2656.  Count:=0;
  2657.  while Length(Result)>0 do begin
  2658.   if Result[Length(Result)-Count] in Chrs then Inc(Count) else Break;
  2659.  end;
  2660.  if Count<>0 then SetLength(Result,Length(Result)-Count);
  2661. end;
  2662.  
  2663. function LeftExpand(const Str:TString; Count: Integer; const Chr:Char=chSpace): TString;
  2664. var
  2665.  i:Integer;
  2666.  PS, PD: PChar;
  2667. begin
  2668.  if Count<0 then Count:=0;
  2669.  SetString(Result, nil, Length(Str)+Count);
  2670.  PS:=@Str[1];
  2671.  PD:=@Result[Count+1];
  2672.  for i:=1 to Count do Result[i]:=Chr;
  2673.  Move(PS^, PD^, Length(Str));
  2674. end;
  2675.  
  2676. function RightExpand(const Str:TString; Count: Integer; const Chr:Char=chSpace): TString;
  2677. var
  2678.  L: Integer;
  2679. begin
  2680.  if Count<0 then Count:=0;
  2681.  L:=GetLength(Str);
  2682.  SetString(Result, nil, L+Count);
  2683.  MoveMem(PChar(Str)^, PChar(Result)^, L);
  2684.  FillMem(PChar(@Result[L+1])^, Count, Byte(Chr));
  2685. end;
  2686.  
  2687. function TrimStr(const Str:TString;const Chr:Char=chSpace):TString;
  2688. begin
  2689.  if Str='' then Result:='' else Result:=LeftTrim(RightTrim(Str,Chr),Chr);
  2690. end;
  2691.  
  2692. function LeadTrim(const Str:TString; Count:Integer=1):TString;
  2693. begin
  2694.  if Count<0 then Count:=0;
  2695.  SetString(Result, PChar(IncPtr(PChar(Str), Count)), Length(Str)-Count);
  2696. end;
  2697.  
  2698. function TrailTrim(const Str:TString; Count:Integer=1):TString;
  2699. begin
  2700.  if Count<0 then Count:=0;
  2701.  SetString(Result, PChar(Str), Length(Str)-Count);
  2702. end;
  2703.  
  2704. function GetSubStr(const Str:TString;N:byte;Separator:Char=chSpace):TString;
  2705. var
  2706.  S: PChar;
  2707.  P1, P2: Integer;
  2708. begin
  2709.  P1:=CharEntryPos(Str, Separator, N-1);
  2710.  Inc(P1);
  2711.  S:=@Str[P1];
  2712.  P2:=CharEntryPos(S, Separator, 1);
  2713.  if P2=0 then P2:=Length(Str) else P2:=P1+P2-1;
  2714.  Result:=TrimStr(ReadSubStr(Str, P1, P2), Separator);
  2715.  if Result=Separator then Result:='';
  2716. end;
  2717.  
  2718. function ExtractStr(const Str:TString;N:byte):TString;
  2719. var
  2720.  P,I:Integer;
  2721.  S:TString;
  2722. begin
  2723.  S:=Str;
  2724.  for i:=1 to n-1 do begin
  2725.   P:=Pos(chSpace,S);
  2726.   S:=Copy(S,Succ(P),Length(S)-P);
  2727.   S:=LeftTrim(S);
  2728.  end;
  2729.  P:=Pos(chSpace,S);
  2730.  if P<>0 then Result:=Copy(S,1,Pred(P))
  2731.          else Result:=S;
  2732. end;
  2733.  
  2734. procedure ExtractStrings(Str: TString; List: TStrings; Separator: Char);
  2735. var
  2736.  P1, P2: PChar;
  2737. begin
  2738.  List.BeginUpdate;
  2739.  try
  2740.   List.Clear;
  2741.   P1:=PChar(Str);
  2742.   repeat
  2743.    P2:=StrScan(P1, Separator);
  2744.    SetByteValue(P2, 0);
  2745.    List.Add(P1);
  2746.    P1:=P2;
  2747.    Inc(P1);
  2748.   until P2 = nil;
  2749.  finally
  2750.   List.EndUpdate;
  2751.  end;
  2752. end;
  2753.  
  2754. function RemoveChars(const Str:TString;const Chars:TSetChar):TString;
  2755. var i:Integer;
  2756. begin
  2757.  Result:='';
  2758.  for i:=1 to Length(Str) do if not (Str[i] in Chars) then Result:=Result+Str[i];
  2759. end;
  2760.  
  2761. function ReplaceChar(const Str:TString;OldChar,NewChar:Char):TString;
  2762. var
  2763.  i:Integer;
  2764. begin
  2765.  Result:=Str;
  2766.  for i:=1 to Length(Result) do if Result[i]=OldChar then Result[i]:=NewChar;
  2767. end;
  2768.  
  2769. function ReplaceStr(const Str:TString;const OldSubStr,NewSubStr:TString):TString;
  2770. var
  2771.  P:Integer;
  2772. begin
  2773.  Result:=Str;
  2774.  P:=Pos(OldSubStr,Result);
  2775.  if P<>0 then begin
  2776.   Delete(Result,P,Length(OldSubStr));
  2777.   Insert(NewSubStr,Result,P);
  2778.  end;
  2779. end;
  2780.  
  2781. function __pos(SubStr, Str: TString; var P: Integer): Integer;
  2782. begin
  2783.  P:=Pos(SubStr, Str);
  2784.  Result:=P;
  2785. end;
  2786.  
  2787. function ReplaceStrAll(const Str: TString; const OldSubStr, NewSubStr: TString): TString;
  2788. var
  2789.  P: Integer;
  2790.  Len: Integer;
  2791. begin
  2792.  Result:=Str;
  2793.  Len:=Length(OldSubStr);
  2794.  while __pos(OldSubStr, Result, P)<>0 do begin
  2795.    Delete(Result, P, Len);
  2796.    Insert(NewSubStr, Result, P);
  2797.  end;
  2798. end;
  2799.  
  2800. procedure CleanUp(var Str: TString);
  2801. asm
  2802.    mov   eax, [eax]
  2803.    test  eax, eax
  2804.    jz    @@10
  2805.    push  eax
  2806.    call  GetLength
  2807.    mov   edx, eax
  2808.    pop   eax
  2809.    mov   [eax-4], edx
  2810. @@10:
  2811. end;
  2812.  
  2813. procedure CleanUp(var Str:TString; DoTrim: LongBool);
  2814. begin
  2815. // SetLength(Str,GetLength(Str));
  2816.  CleanUp(Str);
  2817.  if DoTrim then Str:=TrimStr(Str);
  2818. end;
  2819.  
  2820. function FillString(Chr:Char;Count:Integer):TString;
  2821. begin
  2822.  SetString(Result, nil, Count);
  2823.  FillChar(Pointer(Result)^, Count, Chr);
  2824. end;
  2825.  
  2826. function UpString(const Str:TString):TString;
  2827. begin
  2828.  Result:=Str;
  2829.  CharUpper(@Result[1]);
  2830. end;
  2831.  
  2832. function DnString(const Str:TString):TString;
  2833. begin
  2834.  Result:=Str;
  2835.  CharLower(@Result[1]);
  2836. end;
  2837.  
  2838. function GetChar(const Str:TString; Position:Integer=1):Char; register;
  2839. asm
  2840.    push  edi
  2841.    push  esi
  2842.    mov   edi, edx
  2843.    mov   esi, eax
  2844.    call  GetLength
  2845.    test  eax, eax
  2846.    jnz   @@10
  2847.    jmp   @@30
  2848. @@10:
  2849.    cmp   eax, edi
  2850.    jnb   @@20
  2851.    xor   eax, eax
  2852.    jmp   @@30
  2853. @@20:
  2854.    mov   eax, esi
  2855.    mov   edx, edi
  2856.    dec   edx
  2857.    call  ReadChar
  2858. @@30:
  2859.    pop   esi
  2860.    pop   edi
  2861. end;
  2862.  
  2863. function ReadChar(Ptr:Pointer;Offset:Integer):Char; register;
  2864. asm
  2865.    add   eax, edx
  2866.    mov   al, [eax]
  2867. end;
  2868.  
  2869. function UpChar(Ch:Char):Char; register;
  2870. asm
  2871.    and   eax, 000000FFh
  2872.    push  eax
  2873.    call  CharUpper
  2874. end;
  2875.  
  2876. function DnChar(Ch:Char):Char; register;
  2877. asm
  2878.    and   eax, 000000FFh
  2879.    push  eax
  2880.    call  CharLower
  2881. end;
  2882.  
  2883. function ReflectStr(const Str:TString):TString;
  2884. var
  2885.  i:Integer;
  2886.  len:Integer;
  2887. begin
  2888.  Len:=GetLength(Str);
  2889.  SetLength(Result,len);
  2890.  for i:=1 to Len do Result[i]:=Str[Len-i+1];
  2891. end;
  2892.  
  2893. function ReadSubStr(const Str:TString; Head, Tail:Integer):TString;
  2894. begin
  2895.  Result:=Copy(Str, Head, Tail-Head+1);
  2896. end;
  2897.  
  2898. function StrToFlt(const Str:TString;var Code:Integer):Extended;overload;
  2899. begin
  2900.  Val(PChar(Str), Result, Code);
  2901. end;
  2902.  
  2903. function StrToFlt(const Str:TString):Extended;overload;
  2904. var
  2905.  i:Integer;
  2906. begin
  2907.  Result:=StrToFlt(Str, i);
  2908.  if i<>0 then Result:=0;
  2909. end;
  2910.  
  2911. function FltToStr(const Value:Extended;Precision:Integer=5):TString;
  2912. var
  2913.  P:Integer;
  2914. begin
  2915.  Result:=FloatToStrF(Value,ffGeneral,Precision,0);
  2916.  P:=Pos(',',Result);
  2917.  if P<>0 then Result[P]:=chPoint;
  2918.  P:=Pos(DecimalSeparator,Result);
  2919.  if P<>0 then Result[P]:=chPoint;
  2920. end;
  2921.  
  2922. function BreakStr(const Str:TString;Len:Integer=64;AltChar:Char='\'):TString;
  2923. var
  2924.  i,j:Integer;
  2925.  Alt:Boolean;
  2926. begin
  2927.  if Length(Str)<=Len then begin
  2928.   Result:=Str;
  2929.   Exit;
  2930.  end;
  2931.  Result:='';
  2932.  i:=0;
  2933.  repeat
  2934.   j:=i+Len;
  2935.   if j>Length(Str) then begin
  2936.    j:=Length(Str);
  2937.    Result:=Result+Copy(Str,i+1,j-i);
  2938.    Exit;
  2939.   end;
  2940.   Alt:=False;
  2941.   while Str[j]<>chSpace do begin
  2942.    Dec(j);
  2943.    if j=i then begin
  2944.     Alt:=True;
  2945.     Break;
  2946.    end;
  2947.   end;
  2948.   if Alt then begin
  2949.    j:=i+Len;
  2950.    if j>Length(Str) then begin
  2951.     j:=Length(Str);
  2952.     Result:=Result+Copy(Str,i+1,j-i);
  2953.     Exit;
  2954.    end;
  2955.    while Str[j]<>AltChar do begin
  2956.     Dec(j);
  2957.     if j=i then begin
  2958.      j:=i+Len;
  2959.      Break;
  2960.     end;
  2961.    end;
  2962.   end;
  2963.   Result:=Result+Copy(Str,i+1,j-i)+#13#10;
  2964.   i:=j;
  2965.  until i>=Length(Str);
  2966. end;
  2967.  
  2968. function ValidInt(const Value:TString):LongBool;
  2969. var
  2970.  i,Code:Integer;
  2971. begin
  2972.  Val(Value,i,Code);
  2973.  Hole(i);
  2974.  Result:=Code=0;
  2975. end;
  2976.  
  2977. function ValidFloat(const Value:TString):LongBool;
  2978. var
  2979.  i:Double;
  2980.  Code:Integer;
  2981. begin
  2982.  Val(Value,i,Code);
  2983.  Hole(i);
  2984.  Result:=Code=0;
  2985. end;
  2986.  
  2987. function ValidFloatINF(const Value:TString): LongBool;
  2988. var
  2989.  R: Double;
  2990.  Code:Integer;
  2991. begin
  2992.  Val(Value, R, Code);
  2993.  Hole(Code);
  2994.  Result:=Infinity(R)=0;
  2995. end;
  2996.  
  2997.  
  2998. function ValidateFloat(const Value:TString):TString;
  2999. var
  3000.  P:Integer;
  3001. begin
  3002.  Result:=Value;
  3003.  P:=Pos(DecimalSeparator,Result);
  3004.  if P<>0 then Result[P]:=chPoint;
  3005.  P:=Pos(chComma,Result);
  3006.  if P<>0 then Result[p]:=chPoint;
  3007.  if not ValidFloat(Result) then Result:='';
  3008. end;
  3009.  
  3010. function Join(const Str1, Str2: TString): TString;
  3011. begin
  3012.  Result:='';
  3013.  if not IsEmptyStr(Str1) then Result:=PChar(@Str1[1]);
  3014.  if not IsEmptyStr(Str2) then Result:=Result+PChar(@Str2[1]);
  3015. end;
  3016.  
  3017. function LastChar(const Str:TString):Char;
  3018. begin
  3019.  if Str='' then Result:=chNull else Result:=Str[Length(Str)];
  3020. end;
  3021.  
  3022. function NextChar(const Str:TString;Pos:Integer;Passed:Char=chSpace):Char;
  3023. begin
  3024.  Result:=NextChar(Str,Pos,[Passed]);
  3025. end;
  3026.  
  3027. function PrevChar(const Str:TString;Pos:Integer;Passed:Char=chSpace):Char;
  3028. begin
  3029.  Result:=PrevChar(Str,Pos,[Passed]);
  3030. end;
  3031.  
  3032. function NextChar(const Str:TString;Pos:Integer;Passed:TSetChar):Char;overload;
  3033. var i:Integer;
  3034. begin
  3035.  Result:=#0;
  3036.  for i:=Pos+1 to Length(Str) do if not (Str[i] in Passed) then begin
  3037.   Result:=Str[i];
  3038.   Break;
  3039.  end;
  3040. end;
  3041.  
  3042. function PrevChar(const Str:TString;Pos:Integer;Passed:TSetChar):Char;overload;
  3043. var i:Integer;
  3044. begin
  3045.  Result:=#0;
  3046.  for i:=Pos-1 downto 1 do if not (Str[i] in Passed) then begin
  3047.   Result:=Str[i];
  3048.   Break;
  3049.  end;
  3050. end;
  3051.  
  3052. procedure AddString(var Str:TString; const Value:TString);
  3053. begin
  3054.  CleanUp(Str);
  3055.  Str:=Str+Value;
  3056. end;
  3057.  
  3058. function AdjustLength(Str: TString; Len: Integer; Ch: Char = chSpace): TString;
  3059. var
  3060.  L, N: Integer;
  3061.  S1: TString;
  3062. begin
  3063.  L:=GetStrLen(Str);
  3064.  if L<Len then begin
  3065.   N:=Len - L;
  3066.   SetString(S1, nil, N);
  3067.   FillMem(PChar(S1)^, N, Ord(Ch));
  3068.   Result:=Str+S1;
  3069.  end else Result:=Str;
  3070. end;
  3071.  
  3072. function CharCount(const Str:TString;Ch:Char):Integer; register;
  3073. asm
  3074.    push  edi
  3075.    test  eax, eax
  3076.    jnz   @@10
  3077.    xor   eax, eax
  3078.    jmp   @@40
  3079. @@10:
  3080.    mov   edi, eax
  3081.    xor   eax, eax
  3082.    dec   edi
  3083. @@20:
  3084.    inc   edi
  3085.    mov   dh, [edi]
  3086.    cmp   dh, dl
  3087.    jne   @@30
  3088.    inc   eax
  3089. @@30:
  3090.    test  dh, dh
  3091.    jnz   @@20
  3092. @@40:
  3093.    pop   edi
  3094. end;
  3095.  
  3096. function CopyToBuf(const Source:TString; Buf:PChar; Size:Integer):LongBool;
  3097. var
  3098.  Len: Integer;
  3099. begin
  3100.  Len:=GetLength(Source)+1;
  3101.  if Len>Size then begin
  3102.   Result:=False;
  3103.   Buf^:=#0;
  3104.  end else begin
  3105.   if not IsEmptyStr(Source) then MoveMem(PChar(Source)^, Buf^, Len)
  3106.                             else ClearMem(Buf^, Size);
  3107.   Result:=True;
  3108.  end;
  3109. end;
  3110.  
  3111. function MatchString(const Str:TString; const Values:array of TString;
  3112.                       CaseSensitive:LongBool=False):Integer;
  3113. {var
  3114.  i:Integer;
  3115.  fnTest:function(const S1,S2:TString):LongBool;
  3116. begin
  3117.  if not CaseSensitive then fnTest:=EqualText else fnTest:=EqualStr;
  3118.  Result:=0;
  3119.  for i:=Low(Values) to High(Values) do if fnTest(Str,Values[i]) then begin
  3120.   Result:=Succ(i);
  3121.   Break;
  3122.  end;}
  3123. var
  3124.    Count: LongInt;
  3125.    NS, LS: LongInt;
  3126. asm
  3127.    push  esi
  3128.    push  edi
  3129.    push  ebx
  3130.    test  eax, eax
  3131.    jnz   @@5
  3132.    mov   NS, eax
  3133.    mov   LS, eax
  3134.    lea   eax, NS
  3135. @@5:
  3136.    mov   esi, eax
  3137.    mov   edi, edx
  3138.    xor   ebx, ebx
  3139.    mov   eax, CaseSensitive
  3140.    not   eax
  3141.    and   eax, 1
  3142.    mov   CaseSensitive, eax
  3143.    mov   Count, ecx
  3144. @@10:
  3145.    cmp   ebx, Count
  3146.    jg    @@30
  3147.    push  dword ptr [esi-4]
  3148.    push  esi
  3149.    mov   eax, [edi+ebx*4]
  3150.    test  eax, eax
  3151.    jnz   @@15
  3152.    mov   NS, eax
  3153.    mov   LS, eax
  3154.    lea   eax, NS
  3155. @@15:
  3156.    push  dword ptr [eax-4]
  3157.    push  eax
  3158.    push  CaseSensitive
  3159.    push  LOCALE_USER_DEFAULT
  3160.    call  CompareString
  3161.    cmp   eax, 2
  3162.    je    @@20
  3163.    inc   ebx
  3164.    jmp   @@10
  3165. @@20:
  3166.    mov   eax, ebx
  3167.    inc   eax
  3168.    jmp   @@40
  3169. @@30:
  3170.    xor   eax, eax
  3171. @@40:
  3172.    pop   ebx
  3173.    pop   edi
  3174.    pop   esi
  3175. end;
  3176.  
  3177. function MatchStringEx(const Str:TString; const Values:Pointer; Count:Integer;
  3178.                             CaseSensitive:LongBool=False):Integer;
  3179. asm
  3180.    push  CaseSensitive
  3181.    call  MatchString
  3182. end;
  3183.  
  3184. function Among(N: Integer; const Values: array of Integer):LongBool;
  3185. asm
  3186.    push   ebx
  3187.    xor    ebx, ebx
  3188. @@10:
  3189.    test   ecx, ecx
  3190.    jl     @@30
  3191.    cmp    eax, [edx]
  3192.    jne    @@20
  3193.    not    ebx
  3194.    jmp    @@30
  3195. @@20:
  3196.    add    edx, 4
  3197.    dec    ecx
  3198.    jmp    @@10
  3199. @@30:
  3200.    mov    eax, ebx
  3201.    pop    ebx
  3202. end;
  3203.  
  3204. function __Parameters: TString;
  3205. var
  3206.  S: PChar;
  3207.  P: Integer;
  3208. begin
  3209.  Result:=GetCommandLine;
  3210.  if Result[1] = '"' then begin
  3211.   S:=@Result[2];
  3212.   P:=Pos('"', S);
  3213.   if P<>0 then Result:=ReadSubStr(S, P+2, Length(S)) else begin
  3214.    P:=Pos(chSpace, Result);
  3215.    if P = 0 then Result:='' else Result:=ReadSubStr(Result, P+1, Length(Result));
  3216.   end;
  3217.  end else begin
  3218.   P:=Pos(chSpace, Result);
  3219.   if P = 0 then Result:='' else Result:=ReadSubStr(Result, P+1, Length(Result));
  3220.  end;
  3221. end;
  3222.  
  3223. var
  3224.  ParametersFirstCall: Boolean = True;
  3225.  ParamString: TString = '';
  3226.  
  3227. function Parameters: TString;
  3228. begin
  3229.  if ParametersFirstCall then begin
  3230.   ParamString:=__Parameters;
  3231.   ParametersFirstCall:=False;
  3232.  end;
  3233.  Result:=ParamString;
  3234. end;
  3235.  
  3236. function _GetTempDirectory: TString;
  3237. var
  3238.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  3239. begin
  3240.  GetTempPath(SizeOf(Buf), @Buf);
  3241.  Result:=IncludeTrailingBackslash(PChar(@Buf));
  3242. end;
  3243.  
  3244. var
  3245.  TmpDir: TString = '';
  3246.  GetTempDirectoryFirstCall: Boolean = True;
  3247.  
  3248. function GetTempDirectory: TString;
  3249. begin
  3250.  if GetTempDirectoryFirstCall then begin
  3251.   TmpDir:=_GetTempDirectory;
  3252.   GetTempDirectoryFirstCall:=False;
  3253.  end;
  3254.  Result:=TmpDir;
  3255. end;
  3256.  
  3257. function GetTempFile(const Prefix: TString): TString;
  3258. var
  3259.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  3260. begin
  3261.  GetTempFileName(PChar(GetTempDirectory), PChar(Prefix), 0, @Buf);
  3262.  Result:=PChar(@Buf);
  3263. end;
  3264.  
  3265. var
  3266.  Checked: Boolean = False;
  3267.  Embedded: Boolean = False;
  3268.  
  3269. function CheckAutomation: Boolean;
  3270. begin
  3271.  if not Checked then begin
  3272.   Embedded:=MatchString(Parameters, ['-EMBEDDING', '/EMBEDDING'])<>0;
  3273.   Checked:=True;
  3274.  end;
  3275.  Result:=Embedded;
  3276. end;
  3277.  
  3278. function ExeName:TString;
  3279. var
  3280.  S: PChar;
  3281.  P: Integer;
  3282. begin
  3283.  Result:=GetCommandLine;
  3284.  S:=@Result[2];
  3285.  P:=Pos('"', S);
  3286.  Result:=ReadSubStr(S, 1, P-1);
  3287. end;
  3288.  
  3289. function ExePath:TString;
  3290. begin
  3291.  Result:=ExtractFilePath(ExeName);
  3292. end;
  3293.  
  3294. function ExeVersion: TString;
  3295. begin
  3296.  Result:=VersionToString(FileVersion);
  3297. end;
  3298.  
  3299. function InstanceName:TString;
  3300. var
  3301.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  3302. begin
  3303.  GetModuleFileName(hInstance, Buf, MAX_PATH);
  3304.  Result:=Buf;
  3305. end;
  3306.  
  3307. function InstancePath:TString;
  3308. begin
  3309.  Result:=ExtractFilePath(InstanceName);
  3310. end;
  3311.  
  3312. function FileVersion(const FileName: TString = ''): TFileVersion;
  3313. var
  3314.  S: TString;
  3315.  hMem: HGLOBAL;
  3316.  Buf: pointer;
  3317.  BufSize, Len, dwHandle: DWORD;
  3318.  VerInfo: PVSFixedFileInfo;
  3319.  pszName: PAnsiChar;
  3320. begin
  3321.  FillChar(Result, SizeOf(Result), 0);
  3322.  S:=FileName;
  3323.  CleanUp(S, True);
  3324.  if IsEmptyStr(S) then S:=ParamStr(0);
  3325.  pszName:=@S[1];
  3326.  BufSize:=GetFileVersionInfoSize(pszName, dwHandle);
  3327.  if BufSize<>0 then begin
  3328.   hMem:=GlobalAlloc(GHND, BufSize);
  3329.   if hMem = 0 then OutOfMemoryError;
  3330.   Buf:=GlobalLock(hMem);
  3331.   if Buf=nil then OutOfMemoryError;
  3332.   GetFileVersionInfo(pszName, dwHandle, BufSize, Buf);
  3333.   VerQueryValue(Buf, '\', pointer(VerInfo), Len);
  3334.   with VerInfo^ do begin
  3335.    Result.HiVersion:=HiWord(dwFileVersionMS);
  3336.    Result.LoVersion:=LoWord(dwFileVersionMS);
  3337.    Result.Release:=HiWord(dwFileVersionLS);
  3338.    Result.Build:=LoWord(dwFileVersionLS);
  3339.   end;
  3340.   GlobalUnlock(hMem);
  3341.   GlobalFree(hMem);
  3342.  end else Result.HiVersion:=-1;
  3343. end;
  3344.  
  3345. function ComCtlVersion: TFileVersion;
  3346. begin
  3347.  Result:=FileVersion('COMCTL32.DLL');
  3348. end;
  3349.  
  3350. function IsDebug(const FileName:  TString): LongBool;
  3351. var
  3352.  S: TString;
  3353.  hMem: HGLOBAL;
  3354.  Buf: pointer;
  3355.  BufSize, Len, dwHandle: DWORD;
  3356.  VerInfo: PVSFixedFileInfo;
  3357.  pszName: PAnsiChar;
  3358. begin
  3359.  Result:=False;
  3360.  FillChar(Result, SizeOf(Result), 0);
  3361.  S:=FileName;
  3362.  CleanUp(S, True);
  3363.  if IsEmptyStr(S) then S:=ParamStr(0);
  3364.  pszName:=@S[1];
  3365.  BufSize:=GetFileVersionInfoSize(pszName, dwHandle);
  3366.  if BufSize<>0 then begin
  3367.   hMem:=GlobalAlloc(GHND, BufSize);
  3368.   if hMem = 0 then OutOfMemoryError;
  3369.   Buf:=GlobalLock(hMem);
  3370.   if Buf=nil then OutOfMemoryError;
  3371.   GetFileVersionInfo(pszName, dwHandle, BufSize, Buf);
  3372.   VerQueryValue(Buf, '\', pointer(VerInfo), Len);
  3373.   Result:=(VerInfo.dwFileFlags and VS_FF_DEBUG) <> 0;
  3374.   GlobalUnlock(hMem);
  3375.   GlobalFree(hMem);
  3376.  end;
  3377. end;
  3378.  
  3379. var
  3380.  IsDebugValue: Integer = Integer($8000000);
  3381.  
  3382. function IsDebug: LongBool; overload;
  3383. begin
  3384.  if IsDebugValue = Integer ($80000000) then IsDebugValue:=Integer(IsDebug(''));
  3385.  Result:=LongBool(IsDebugValue);
  3386. end;
  3387.  
  3388. procedure GetWindowSize(Handle: HWND; var Size: TSize);
  3389. var
  3390.  R: TRect;
  3391. begin
  3392.  GetWindowRect(Handle, R);
  3393.  with R, Size do begin
  3394.   cx:=Right-Left;
  3395.   cy:=Bottom-Top;
  3396.  end;
  3397. end;
  3398.  
  3399. procedure GetWindowCenter(Handle: HWND; CenterX, CenterY: PInteger);
  3400. var
  3401.  R: TRect;
  3402. asm
  3403.   push   esi
  3404.   push   edi
  3405.   mov    esi, ecx
  3406.   mov    edi, edx
  3407.   lea    ecx, R
  3408.   push   ecx
  3409.   push   eax
  3410.   call   GetWindowRect
  3411.   test   edi, edi
  3412.   jz     @@10
  3413.   mov    eax, R.Right
  3414.   sub    eax, R.Left
  3415.   shr    eax, 1
  3416.   mov    [edi], eax
  3417. @@10:
  3418.   test   esi, esi
  3419.   jz     @@20
  3420.   mov    eax, R.Bottom
  3421.   sub    eax, R.Top
  3422.   shr    eax, 1
  3423.   mov    [esi], eax
  3424. @@20:
  3425.   pop    edi
  3426.   pop    esi
  3427. end;
  3428.  
  3429. procedure PressKey(VKey: Byte);
  3430. begin
  3431.  keybd_event(VKey, 0, 0, 0);
  3432.  keybd_event(VKey, 0, KEYEVENTF_KEYUP, 0);
  3433. end;
  3434.  
  3435. function ForceDirectories(Dir: TString): Boolean;
  3436. begin
  3437.  try
  3438.   Result := True;
  3439.   if Length(Dir) = 0 then Abort;
  3440.   Dir := ExcludeTrailingBackslash(Dir);
  3441.   if (Length(Dir) < 3) or PathExists(Dir)
  3442.     or (ExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.
  3443.   Result := ForceDirectories(ExtractFilePath(Dir)) and CreateDir(Dir);
  3444.  except
  3445.   on EAbort do Result:=False;
  3446.   else raise;
  3447.  end;
  3448. end;
  3449.  
  3450. function StringToVersion(const Str: TString): TFileVersion;
  3451. var
  3452.  S, SH, SL, SR, SB: TString;
  3453.  Code: Integer;
  3454.  Count: Integer;
  3455. begin
  3456.  S:=Str;
  3457.  CleanUp(S, True);
  3458.  S:=ReplaceChar(S, ',','.');
  3459.  Count:=CharCount(S, '.')+1;
  3460.  SH:='0'; SL:='0'; SR:='0'; SB:='0';
  3461.  if Count>=1 then SH:=GetSubStr(S, 1, '.');
  3462.  if Count>=2 then SL:=GetSubStr(S, 2, '.');
  3463.  if Count>=3 then SR:=GetSubStr(S, 3, '.');
  3464.  if Count>=4 then SB:=GetSubStr(S, 4, '.');
  3465.  with Result do begin
  3466.   Val(SH, HiVersion, Code); if Code<>0 then HiVersion:=0;
  3467.   Val(SL, LoVersion, Code); if Code<>0 then LoVersion:=0;
  3468.   Val(SR, Release, Code); if Code<>0 then Release:=0;
  3469.   Val(SB, Build, Code); if Code<>0 then Build:=0;
  3470.  end;
  3471. end;
  3472.  
  3473. function VersionToString(const Ver: TFileVersion): TString;
  3474. begin
  3475.  with Ver do Result:=Format('%d.%d.%d.%d', [HiVersion, LoVersion, Release, Build]);
  3476. end;
  3477.  
  3478. function Version(HiVersion, LoVersion: Integer;
  3479.   Release: Integer = 0; Build: Integer = 0): TFileVersion; overload;
  3480. begin
  3481.  Result.HiVersion:=HiVersion;
  3482.  Result.LoVersion:=LoVersion;
  3483.  Result.Release:=Release;
  3484.  Result.Build:=Build;
  3485. end;
  3486.  
  3487. function LoadResStr(Instance:THandle;ID:Cardinal):TString;
  3488. begin
  3489.  SetLength(Result,512);
  3490.  LoadString(Instance,ID,@Result[1],512);
  3491.  CleanUp(Result);
  3492. end;
  3493.  
  3494. function LoadResStr(ID: Cardinal): TString; overload;
  3495. begin
  3496.  Result:=LoadResStr(hInstance, ID);
  3497. end;
  3498.  
  3499. function LoadDLL(const Path:TString):THandle;
  3500. begin
  3501.  Result:=LoadLibrary(PChar(Path));
  3502. end;
  3503.  
  3504. function GetDLLProc(Handle:THandle;const ProcName:TString):Pointer;
  3505. begin
  3506.  Result:=GetProcAddress(Handle,PChar(ProcName));
  3507. end;
  3508.  
  3509.  
  3510. var
  3511.   OSVersionInfo_Initialized: Boolean = False;
  3512.   OSVersionInfo: TOSVersionInfo;
  3513.  
  3514. procedure Initialize_OSVersionInfo;
  3515. begin
  3516.  if not OSVersionInfo_Initialized then begin
  3517.   ClearMem(OSVersionInfo, SizeOf(OSVersionInfo));
  3518.   OSVersionInfo.dwOSVersionInfoSize:=SizeOf(OSVersionInfo);
  3519.   GetVersionEx(OSVersionInfo);
  3520.   OSVersionInfo_Initialized:=True;
  3521.  end;
  3522. end;
  3523.  
  3524. function _Win32Platform: Integer;
  3525. begin
  3526.  Initialize_OSVersionInfo;
  3527.  Result:=OSVersionInfo.dwPlatformId;
  3528. end;
  3529.  
  3530. function _Win32MajorVersion: Integer;
  3531. begin
  3532.  Initialize_OSVersionInfo;
  3533.  Result:=OSVersionInfo.dwMajorVersion;
  3534. end;
  3535.  
  3536. function _Win32MinorVersion: Integer;
  3537. begin
  3538.  Initialize_OSVersionInfo;
  3539.  Result:=OSVersionInfo.dwMinorVersion;
  3540. end; 
  3541.  
  3542. function WinNT: Boolean;
  3543. begin
  3544.  Result:=_Win32Platform=VER_PLATFORM_WIN32_NT;
  3545. end;
  3546.  
  3547. function Win2K: Boolean;
  3548. begin
  3549.   Result := (_Win32MajorVersion > 4) and (_Win32Platform = VER_PLATFORM_WIN32_NT);
  3550. end;
  3551.  
  3552. function WinME: Boolean;
  3553. begin
  3554.   Result:=(_Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
  3555.    ((_Win32MajorVersion>4) or ((_Win32MajorVersion = 4) and (_Win32MinorVersion >= 90)));
  3556. end;
  3557.  
  3558. function WinXP: Boolean;
  3559. begin
  3560.  Result := (_Win32Platform = VER_PLATFORM_WIN32_NT) and
  3561.    ((_Win32MajorVersion)>5) or ((_Win32MajorVersion = 5) and (_Win32MinorVersion >= 1));
  3562. end;
  3563.  
  3564. var
  3565.  GetOperatingSystemFirstCall: Boolean = True;
  3566.  GetOperatingSystemResult: TOperatingSystem;
  3567.  
  3568. function GetOperatingSystem: TOperatingSystem;
  3569. begin
  3570.  if GetOperatingSystemFirstCall then begin
  3571.   GetOperatingSystemResult:=UndefinedWindows;
  3572.   case _Win32Platform of
  3573.    VER_PLATFORM_WIN32S: GetOperatingSystemResult:=Windows3x;
  3574.    VER_PLATFORM_WIN32_WINDOWS: begin
  3575.     if _Win32MajorVersion = 4 then begin
  3576.      if _Win32MinorVersion >= 0 then GetOperatingSystemResult:=Windows95;
  3577.      if _Win32MinorVersion >=10 then GetOperatingSystemResult:=Windows98;
  3578.      if _Win32MinorVersion >=90 then GetOperatingSystemResult:=WindowsME;
  3579.     end;
  3580.    end;
  3581.    VER_PLATFORM_WIN32_NT: begin
  3582.     if _Win32MajorVersion<=4 then GetOperatingSystemResult:=WindowsNT;
  3583.     if _Win32MajorVersion = 5 then begin
  3584.      if _Win32MinorVersion >= 0 then GetOperatingSystemResult:=Windows2000;
  3585.      if _Win32MinorVersion >= 1 then GetOperatingSystemResult:=WindowsXP;
  3586.     end;
  3587.    end;
  3588.   end;
  3589.   GetOperatingSystemFirstCall:=False;
  3590.  end;
  3591.  Result:=GetOperatingSystemResult;
  3592. end;
  3593.  
  3594. procedure Sound(Frequency, Duration: Integer);
  3595. asm
  3596.    push  edx
  3597.    push     eax
  3598.    call  _Win32Platform
  3599.    cmp   eax, VER_PLATFORM_WIN32_NT
  3600.    jne   @@9X
  3601.    call  Windows.Beep
  3602.    ret
  3603. @@9X:
  3604.    pop     eax
  3605.    pop     edx 
  3606.    push  ebx
  3607.    push  edx
  3608.    mov   bx,  ax
  3609.    mov   ax,  34DDh
  3610.    mov   dx,  0012h
  3611.    cmp   dx,  bx
  3612.    jnc   @@2
  3613.    div   bx
  3614.    mov   bx,  ax
  3615.    in    al,  61h
  3616.    test  al,  3
  3617.    jnz   @@1
  3618.    or    al,  3
  3619.    out   61h, al
  3620.    mov   al,  0B6h
  3621.    out   43h, al
  3622. @@1:
  3623.    mov   al,  bl
  3624.    out   42h, al
  3625.    mov   al,  bh
  3626.    out   42h, al
  3627.    call  Windows.Sleep
  3628.    in    al,  61h
  3629.    and   al,  0FCh
  3630.    out   61h, al
  3631.    jmp   @@3
  3632. @@2:
  3633.    pop   edx   
  3634. @@3:
  3635.    pop   ebx
  3636. end;
  3637.  
  3638. procedure CDDoorCmd(Cmd: TString);
  3639. var
  3640.  winmm: HINST;
  3641.  mciSendString: function (lpszCommand: PChar; lpszResturnString: PChar;
  3642.    cchReturn: UINT; hwndCallback: HWND): Integer stdcall;
  3643. begin
  3644.  winmm:=LoadLibrary('winmm.dll');
  3645.  if winmm > 32 then begin
  3646.   mciSendString:=GetProcAddress(winmm, 'mciSendStringA');
  3647.   if Assigned(mciSendString) then
  3648.    mciSendString(PChar(FmtString('SET CDAUDIO DOOR %1 WAIT', [Cmd])),
  3649.     nil, 0, 0);
  3650.   FreeLibrary(winmm);
  3651.  end;
  3652. end;
  3653.  
  3654. procedure OpenCD;
  3655. begin
  3656.  CDDoorCmd('OPEN');
  3657. end;
  3658.  
  3659. procedure CloseCD;
  3660. begin
  3661.  CDDoorCmd('CLOSED');
  3662. end;
  3663.  
  3664. function GetNCFontHandle(const NCFont:TNCFont):cardinal;
  3665. var
  3666.  NCM:TNonClientMetrics;
  3667.  LF:TLogFont;
  3668.  B:LongBool;
  3669. begin
  3670.  NCM.cbSize:=SizeOf(NCM);
  3671.  B:=SystemParametersInfo(SPI_GETNONCLIENTMETRICS,0,@NCM,0);
  3672.  if B then begin
  3673.   case NCFont of
  3674.    SmCaptionFont : LF:=NCM.lfSmCaptionFont;
  3675.    CaptionFont   : LF:=NCM.lfCaptionFont;
  3676.    MenuFont      : LF:=NCM.lfMenuFont;
  3677.    MessageFont   : LF:=NCM.lfMessageFont;
  3678.    StatusFont    : LF:=NCM.lfStatusFont;
  3679.    else            LF:=NCM.lfMessageFont;
  3680.   end;
  3681.   if WinNT then begin
  3682.    LF.lfCharset:=LangIDToCharset(0);
  3683.   end; 
  3684.  end else begin
  3685.   FillChar(LF,SizeOf(LF),0);
  3686.   LF.lfHeight:=-11;
  3687.   LF.lfWidth:=0;
  3688.   LF.lfCharSet:=DEFAULT_CHARSET;
  3689.   StrPCopy(@LF.lfFaceName[0],'MS Sans Serif');
  3690.  end;
  3691.  Result:=CreateFontIndirect(LF);
  3692. end;
  3693.  
  3694. function TrayWnd: HWND;
  3695. begin
  3696.  Result:=FindWindow('Shell_TrayWnd','');
  3697. end;
  3698.  
  3699. function _GetLocale: Integer;
  3700. var
  3701.  Translation: PWord;
  3702.  Buffer: Pointer;
  3703.  Size, Len, Handle: DWORD;
  3704.  Name: TString;
  3705. begin
  3706.  Name:=InstanceName;
  3707.  Size:=GetFileVersionInfoSize(PChar(Name), Handle);
  3708.  if Size = 0 then Result:=GetLocale else begin
  3709.   Buffer:=AllocateMem(Size);
  3710.   try
  3711.    GetFileVersionInfo(PChar(Name), Handle, Size, Buffer);
  3712.    VerQueryValue(Buffer, '\VarFileInfo\Translation', Pointer(Translation), Len);
  3713.    Result:=Translation^;
  3714.   finally
  3715.    DeallocateMem(Buffer);
  3716.   end;
  3717.  end;
  3718. end;
  3719.  
  3720. function LangIDToCharset(LangID: Integer): Byte;
  3721. var I: byte;
  3722. begin
  3723.  Result:=DEFAULT_CHARSET;
  3724.  if LangID = 0 then LangID:=_GetLocale;
  3725.  for i:=0 to LangCount do if Lo(LangID) = LangIDToCharsetInfo[i].LangID then begin
  3726.   Result:=LangIDToCharsetInfo[i].Charset;
  3727.   Break;
  3728.  end;
  3729.  if LangID = $0C1A then Result:=RUSSIAN_CHARSET;
  3730. end;
  3731.  
  3732. procedure OpenShortcut(var FileName: TString);
  3733. var
  3734.  ShellLink: TShellLink;
  3735. begin
  3736.  FileName:=TrimStr(FileName, '"');
  3737.  if EqualText(ExtractFileExt(FileName), '.LNK') then begin
  3738.   ShellLink:=TShellLink.Create;
  3739.   try
  3740.    ShellLink.LoadFromFile(FileName);
  3741.    FileName:=ShellLink.Path;
  3742.   finally
  3743.    ShellLink.Free;
  3744.   end;
  3745.  end;
  3746.  FileName:=GetLongName(FileName);
  3747. end;
  3748.  
  3749. function GetLocale: Integer;
  3750. var
  3751.  DataType: Integer;
  3752.  S: TString;
  3753.  Handle: HKEY;
  3754.  Temp: Integer;
  3755.  Size: Integer;
  3756.  Flag: Boolean;
  3757. begin
  3758.  Result:=GetSystemDefaultLCID;
  3759.  if RegOpenKeyEx(HKEY_CURRENT_USER, 'Control Panel\Desktop\ResourceLocale',
  3760.     0, KEY_READ, Handle)<>ERROR_SUCCESS then Exit;
  3761.  SetString(S, nil, 260);
  3762.  Size:=255;
  3763.  Flag:=RegQueryValueEx(Handle, '', nil, @DataType, PByte(@S[1]), @Size)=ERROR_SUCCESS;
  3764.  RegCloseKey(Handle);
  3765.  if not Flag then Exit;
  3766.  CleanUp(S, True);
  3767.  Temp:=HexToInt(S, DataType);
  3768.  if DataType<>0 then Exit;
  3769.  Result:=Temp;
  3770. end;
  3771.  
  3772. function ExitWindows(uFlags: UINT): BOOL;
  3773. var
  3774.  ProcessHandle: THandle;
  3775.  TokenHandle: THandle;
  3776.  Luid: Int64;
  3777.  Tkp: TTokenPrivileges;
  3778.  BufferNeeded: DWORD;
  3779. begin
  3780.  if WinNT then begin
  3781.   ProcessHandle:=GetCurrentProcess;
  3782.   OpenProcessToken(ProcessHandle, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, TokenHandle);
  3783.   LookupPrivilegeValue(nil, 'SeShutdownPrivilege', Luid);
  3784.   Tkp.PrivilegeCount:=1;
  3785.   Tkp.Privileges[0].Luid:=Luid;
  3786.   Tkp.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
  3787.   AdjustTokenPrivileges(TokenHandle, FALSE, Tkp, 0, nil, BufferNeeded);
  3788.  end;
  3789.  Result:=ExitWindowsEx(uFlags, $FFFF);
  3790. end;
  3791.  
  3792. procedure RemoveDirectories(const Path: TString);
  3793. var
  3794.  S: TString;
  3795.  Len, P, i: Integer;
  3796. begin
  3797.  S:=ExcludeTrailingBackslash(Path);
  3798.  repeat
  3799.   if not RemoveDirectory(PChar(S)) then Break;
  3800.   Len:=Length(S);
  3801.   P:=0;
  3802.   for i:=Len downto 0 do if S[i] = '\' then begin
  3803.    P:=i;
  3804.    Break;
  3805.   end;
  3806.   if P = 0 then Break;
  3807.   S:=TrailTrim(S, Len-P+1);
  3808.  until False;
  3809. end;
  3810.  
  3811. function LocalHandle; external kernel32 name 'LocalHandle';
  3812.  
  3813. function AllocateMem(Count: Integer; RecSize: Integer = 1): Pointer;
  3814. asm
  3815.    test  eax, eax
  3816.    jle   @@10
  3817.    test  edx, edx
  3818.    jle   @@10
  3819.    imul  edx
  3820.    push  eax
  3821.    push  LHND
  3822.    call  LocalAlloc
  3823.    push  eax
  3824.    call  LocalLock
  3825.    ret
  3826. @@10:
  3827.    xor   eax, eax
  3828. end;
  3829.  
  3830. procedure ReallocateMem(var Pointer; Count: Integer; RecSize: Integer = 1);
  3831. asm
  3832.    push  ebx
  3833.    mov   ebx, eax
  3834.    mov   eax, [ebx]
  3835.    test  eax, eax
  3836.    jnz   @@10
  3837.    mov   eax, edx
  3838.    mov   edx, ecx
  3839.    call  AllocateMem
  3840.    mov   [ebx], eax
  3841.    pop   ebx
  3842.    ret
  3843. @@10:
  3844.    push  ecx
  3845.    push  edx
  3846.    push  eax
  3847.    call  LocalHandle
  3848.    pop   edx
  3849.    pop   ecx
  3850.    test  eax, eax
  3851.    jnz   @@20
  3852.    pop   ebx
  3853.    ret
  3854. @@20:
  3855.    push  eax
  3856.    mov   eax, edx
  3857.    imul  ecx
  3858.    mov   edx, eax
  3859.    pop   eax
  3860.    push  LHND
  3861.    push  edx
  3862.    push  eax
  3863.    call  LocalRealloc
  3864.    push  eax
  3865.    call  LocalLock
  3866.    mov   [ebx], eax
  3867.    pop   ebx
  3868. end;
  3869.  
  3870. procedure DeallocateMem(var Pointer);
  3871. asm
  3872.    push  ebx
  3873.    mov   ebx, eax
  3874.    mov   eax, [ebx]
  3875.    test  eax, eax
  3876.    jz    @@10
  3877.    push  eax
  3878.    call  LocalHandle
  3879.    test  eax, eax
  3880.    jz    @@10
  3881.    push  eax
  3882.    push  eax
  3883.    call  LocalUnlock
  3884.    call  LocalFree
  3885. @@10:
  3886.    xor   eax, eax
  3887.    mov   [ebx], eax
  3888.    pop   ebx
  3889. end;
  3890.  
  3891. function MemSize(P: Pointer): Integer;
  3892. asm
  3893.    test  eax, eax
  3894.    jnz   @@10
  3895.    ret
  3896. @@10:
  3897.    push  eax
  3898.    call  LocalHandle
  3899.    test  eax, eax
  3900.    jnz   @@20
  3901.    ret
  3902. @@20:
  3903.    push  eax
  3904.    call  LocalSize
  3905. end;
  3906.  
  3907. function Year:word;
  3908. var
  3909.  S:TSystemTime;
  3910. begin
  3911.  GetLocalTime(S);
  3912.  Result:=S.wYear;
  3913. end;
  3914.  
  3915. function Month:word;
  3916. var
  3917.  S:TSystemTime;
  3918. begin
  3919.  GetLocalTime(S);
  3920.  Result:=S.wMonth;
  3921. end;
  3922.  
  3923. function Day:word;
  3924. var
  3925.  S:TSystemTime;
  3926. begin
  3927.  GetLocalTime(S);
  3928.  Result:=S.wDay;
  3929. end;
  3930.  
  3931. function DayOfWeek:word;
  3932. var
  3933.  S:TSystemTime;
  3934. begin
  3935.  GetLocalTime(S);
  3936.  Result:=S.wDayOfWeek;
  3937. end;
  3938.  
  3939. function Hour:word;
  3940. var
  3941.  S:TSystemTime;
  3942. begin
  3943.  GetLocalTime(S);
  3944.  Result:=S.wHour;
  3945. end;
  3946.  
  3947. function Minute:word;
  3948. var
  3949.  S:TSystemTime;
  3950. begin
  3951.  GetLocalTime(S);
  3952.  Result:=S.wMinute;
  3953. end;
  3954.  
  3955. function Second:word;
  3956. var
  3957.  S:TSystemTime;
  3958. begin
  3959.  GetLocalTime(S);
  3960.  Result:=S.wSecond;
  3961. end;
  3962.  
  3963. function Milliseconds:word;
  3964. var
  3965.  S:TSystemTime;
  3966. begin
  3967.  GetLocalTime(S);
  3968.  Result:=S.wMilliseconds;
  3969. end;
  3970.  
  3971. function Timer:Integer;
  3972. var
  3973.  S:TSystemTime;
  3974. begin
  3975.  GetLocalTime(S);
  3976.  with S do Result:=wHour*3600000+wMinute*60000+wSecond*1000+wMilliseconds;
  3977. end;
  3978.  
  3979. function LeapYear(Year:Word):Boolean;
  3980. begin
  3981.  if Year mod 100<>0 then Result:=(Year mod 4=0)
  3982.                     else Result:=((Year div 100) mod 4=0);
  3983. end;
  3984.  
  3985. function MonthLength(Month,Year:Word):Word; overload;
  3986. const Data:array[1..12] of byte = (31,28,31,30,31,30,31,31,30,31,30,31);
  3987. begin
  3988.  Result:=Data[Month];
  3989.  if (Month=2) and LeapYear(Year) then Inc(Result);
  3990. end;
  3991.  
  3992. function MonthLength: Word; overload;
  3993. var
  3994.  L: TSystemTime;
  3995. begin
  3996.  GetLocalTime(L);
  3997.  Result:=MonthLength(L.wMonth, L.wYear);
  3998. end;  
  3999.  
  4000. procedure GetLogicalDriveList(const List: TStrings);
  4001. var
  4002.  Size, Pos: Cardinal;
  4003.  Buffer: array[0..127] of AnsiChar;
  4004.  P: PChar;
  4005. begin
  4006.  List.BeginUpdate;
  4007.  try
  4008.   List.Clear;
  4009.   Size:=GetLogicalDriveStrings(SizeOf(Buffer), Buffer);
  4010.   Pos:=0;
  4011.   while Pos<Size do begin
  4012.    P:=@Buffer[Pos];
  4013.    List.Add(P);
  4014.    while Buffer[Pos]<>#0 do Inc(Pos);
  4015.    Inc(Pos);
  4016.   end;
  4017.  finally
  4018.   List.EndUpdate;
  4019.  end;
  4020. end;
  4021.  
  4022. procedure GetFixedDriveList(const List: TStrings);
  4023. var
  4024.  Size, Pos: Cardinal;
  4025.  Buffer: array[0..127] of AnsiChar;
  4026.  P: PChar;
  4027. begin
  4028.  List.BeginUpdate;
  4029.  try
  4030.   List.Clear;
  4031.   Size:=GetLogicalDriveStrings(SizeOf(Buffer), Buffer);
  4032.   Pos:=0;
  4033.   while Pos<Size do begin
  4034.    P:=@Buffer[Pos];
  4035.    if GetDriveType(P) = DRIVE_FIXED then List.Add(P);
  4036.    while Buffer[Pos]<>#0 do Inc(Pos);
  4037.    Inc(Pos);
  4038.   end;
  4039.  finally
  4040.   List.EndUpdate;
  4041.  end;
  4042. end;
  4043.  
  4044. function ChangeLayout(LANG: Integer): Boolean;
  4045. var
  4046.  Layouts: array [0..16] of HKL;
  4047.  i, Count: Integer;
  4048. begin
  4049.  Result:=False;
  4050.  Count:=GetKeyboardLayoutList(High(Layouts)+1, Layouts)-1;
  4051.  for i:=0 to Count do if (LoWord(Layouts[i]) and $FF) = LANG then
  4052.   Result:=ActivateKeyboardLayout(Layouts[i], 0)<>0;
  4053. end;
  4054.  
  4055.  
  4056. function GetStringFileInfo(const FileName: TString; const Key: TString):TString;
  4057. var
  4058.  Translation: PLongInt;
  4059.  W: PWord absolute Translation;
  4060.  Buffer, Value: Pointer;
  4061.  Size, Len, Handle: DWORD;
  4062.  Name, SFI, Lang: TString;
  4063.  P: PChar;
  4064. begin
  4065.  Name:=FileName; CleanUp(Name, True);
  4066.  if IsEmptyStr(Name) then Name:=InstanceName;
  4067.  P:=PChar(Name);
  4068.  Size:=GetFileVersionInfoSize(P, Handle);
  4069.  if Size<>0 then begin
  4070.   Buffer:=AllocateMem(Size);
  4071.   if Buffer = nil then OutOfMemoryError;
  4072.   try
  4073.    GetFileVersionInfo(P, Handle, Size, Buffer);
  4074.    VerQueryValue(Buffer, '\VarFileInfo\Translation', Pointer(Translation), Len);
  4075.    if EqualText(Key, sfiLanguageName) then begin
  4076.     VerLanguageName(W^, Buffer, Size);
  4077.     Result:=PChar(Buffer);
  4078.    end else if EqualText(Key, sfiLanguageID) then begin
  4079.     Result:=IntToStr(W^);
  4080.    end else begin
  4081.     Lang:=IntToHex(SwapWords(Translation^), 8);
  4082.     SFI:=Format('\StringFileInfo\%s\%s', [Lang, Key]);
  4083.     VerQueryValue(Buffer, PChar(SFI), Value, Len);
  4084.     Result:=PChar(Value);
  4085.    end;
  4086.   finally
  4087.    DeallocateMem(Buffer);
  4088.   end;
  4089.  end else Result:='';
  4090. end;
  4091.  
  4092. function GetShortName(const FileName:TString):TString;
  4093. var
  4094.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  4095. begin
  4096.  if FileExists(FileName) then begin
  4097.   GetShortPathName(PChar(FileName), @Buf[0], SizeOf(Buf));
  4098.   Result:=PChar(@Buf[0]);
  4099.  end else Result:=FileName;
  4100. end;
  4101.  
  4102. procedure LoadFile(const FileName: TString; out Buffer: Pointer; out Size: Integer);
  4103. var
  4104.  F: TFile;
  4105. begin
  4106.  F:=TFile.Open(FileName);
  4107.  try
  4108.   Size:=F.Size;
  4109.   Buffer:=AllocateMem(Size);
  4110.   try
  4111.    F.Read(Buffer^, Size);
  4112.   except
  4113.    DeallocateMem(Buffer);
  4114.    raise;
  4115.   end;
  4116.  finally
  4117.   F.Close;
  4118.  end;
  4119. end;
  4120.  
  4121. procedure SaveFile(const FileName: TString; Buffer: Pointer; Size: Integer);
  4122. var
  4123.  F: TFile;
  4124. begin
  4125.  F:=TFile.Create(FileName, False);
  4126.  try
  4127.   F.Write(Buffer^, Size);
  4128.  finally
  4129.   F.Close;
  4130.  end;
  4131. end;
  4132.  
  4133.  
  4134. function _GetLongName(FileName:TString):TString;
  4135. var
  4136.  SR:TSearchRec;
  4137.  Res:Cardinal;
  4138.  Path:TString;
  4139.  S1,S2,SN:TString;
  4140. begin
  4141.  CleanUp(FileName, True);
  4142.  if IsEmptyStr(FileName) then begin
  4143.   Result:='';
  4144.   Exit;
  4145.  end;
  4146.  if not FileExists(FileName) then begin
  4147.   if not PathExists(FileName) then begin
  4148.    Result:=FileName;
  4149.    Exit;
  4150.   end;
  4151.  end;
  4152.  Path:=ExtractFilePath(FileName)+'*.*';
  4153.  S1:=FileName;
  4154.  Delete(S1, 1, 1);
  4155.  if (Path<>'') and (S1<>':') and (S1<>'\') then begin
  4156.   Res:=FindFirst(Path,faAnyFile,SR);
  4157.   Result:=FileName;
  4158.   SN:=ExtractFileName(FileName);
  4159.   while Res=0 do begin
  4160.    S2:=SR.Name;
  4161.    if MatchString(SN, [SR.FindData.cAlternateFileName,S2])<>0 then begin
  4162.     Result:=_GetLongName(TrailTrim(Path,4))+'\'+S2;
  4163.     Break;
  4164.    end;
  4165.    Res:=FindNext(SR);
  4166.   end;
  4167.   FindClose(SR);
  4168.  end else Result:=FileName;
  4169. end;
  4170.  
  4171. function GetLongName(const FileName:TString):TString;
  4172. var
  4173.  GetLongPathName:function (pszShortName:PChar;pszLongName:PChar;
  4174.                            cchBuffer:Integer):Integer stdcall;
  4175.  Handle:hInst;
  4176. begin
  4177.  Handle:=GetModuleHandle('kernel32.dll');
  4178.  @GetLongPathName:=GetProcAddress(Handle,'GetLongPathNameA');
  4179.  if Assigned(GetLongPathName) then begin
  4180.   SetLength(Result,261);
  4181.   if GetLongPathName(PChar(FileName),PChar(Result),260)<>0 then CleanUp(Result)
  4182.                                                            else Result:=FileName;
  4183.  end else Result:=_GetLongName(FileName);
  4184. end;
  4185.  
  4186. function GetUserName: TString;
  4187. var
  4188.  N: Cardinal;
  4189.  Buf: array[0..1023] of AnsiChar;
  4190. begin
  4191.  N:=SizeOf(Buf)-1;
  4192.  Windows.GetUserName(Buf, N);
  4193.  Result:=PChar(@Buf[0]);
  4194. end;
  4195.  
  4196. function GetComputerName: TString;
  4197. var
  4198.  N: Cardinal;
  4199.  Buf: array [0..MAX_COMPUTERNAME_LENGTH + 1] of AnsiChar;
  4200. begin
  4201.  N:=SizeOf(Buf)-1;
  4202.  Windows.GetComputerName(Buf, N);
  4203.  Result:=PChar(@Buf[0]);
  4204. end;
  4205.  
  4206. function PathExists(const Path:TString): Boolean;
  4207. var
  4208.   Code: Integer;
  4209. begin
  4210.   Code := GetFileAttributes(PChar(Path));
  4211.   Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
  4212. end;
  4213.  
  4214. function ExtractFolderName(const FileName: TString): TString;
  4215. var
  4216.  P1, P2: Integer;
  4217. begin
  4218.  P2:=FindChars(FileName, ['\'], Length(FileName), -1);
  4219.  if P2 = 0 then P2:=Length(FileName);
  4220.  P1:=FindChars(FileName, ['\'], P2-1, -1);
  4221.  Result:=ReadSubStr(FileName, P1+1, P2-1);
  4222. end;
  4223.  
  4224. function ChangeFileExt(const FileName, NewExt: TString): TString;
  4225. var
  4226.  P: Integer;
  4227.  Name, Ext: TString;
  4228. begin
  4229.  Name:=PChar(@FileName[1]);
  4230.  Ext:=PChar(@NewExt[1]);
  4231.  CleanUp(Ext, True);
  4232.  Ext:=LeftTrim(Ext, chPoint);
  4233.  P:=FindChars(Name, [chPoint], Length(Name), -1);
  4234.  if P = 0 then Result:=Name+chPoint+Ext
  4235.           else Result:=Copy(Name, 1, P)+Ext;
  4236. end;
  4237.  
  4238. function CompareVersion(const Version1, Version2: TFileVersion): Integer;
  4239. asm
  4240.    mov   ecx, [eax].TFileVersion.HiVersion
  4241.    cmp   ecx, [edx].TFileVersion.HiVersion
  4242.    jg    @@10
  4243.    jl    @@20
  4244.    mov   ecx, [eax].TFileVersion.LoVersion
  4245.    cmp   ecx, [edx].TFileVersion.LoVersion
  4246.    jg    @@10
  4247.    jl    @@20
  4248.    mov   ecx, [eax].TFileVersion.Release
  4249.    cmp   ecx, [edx].TFileVersion.Release
  4250.    jg    @@10
  4251.    jl    @@20
  4252.    mov   ecx, [eax].TFileVersion.Build
  4253.    cmp   ecx, [edx].TFileVersion.Build
  4254.    jg    @@10
  4255.    jl    @@20
  4256.    xor   eax, eax
  4257.    ret
  4258. @@10:
  4259.    xor   eax, eax
  4260.    inc   eax
  4261.    ret
  4262. @@20:
  4263.    xor   eax, eax
  4264.    dec   eax
  4265.    ret
  4266. end;
  4267.  
  4268. function GetFileName(const FileName:TString):TString;
  4269. begin
  4270.  Result:=TrailTrim(ExtractFileName(FileName),Length(ExtractFileExt(FileName)));
  4271. end;
  4272.  
  4273. function GetAbsoluteFileName(CurrentDir, RelativeName: TString): TString;
  4274.  
  4275.  function IsAbsoluteFileName(FileName: TString): Boolean;
  4276.  var
  4277.   P: PWord;
  4278.  begin
  4279.   P:=PWord(PChar(FileName));
  4280.   Result:=P^=$5C5C; // Network name
  4281.   if not Result then begin
  4282.    P:=IncPtr(P, 1);
  4283.    Result:=P^=$5C3A; // Local name
  4284.   end;
  4285.  end;
  4286.  
  4287.  procedure RemoveLastSubDir(var Dir: TString);
  4288.  var
  4289.   P: Integer;
  4290.  begin
  4291.   P:=Length(Dir);
  4292.   while ( P > 0) and ( Dir[P]<>'\') do Dec(P);
  4293.   if P = 0 then Dir:='' else Dir:=Copy(Dir, 1, P-1);
  4294.  end;
  4295.  
  4296.  function FindDots(Name: TString; var P: Integer): Integer;
  4297.  var
  4298.   Ptr: PInteger;
  4299.  begin
  4300.   Ptr:=IncPtr(PChar(Name), P);
  4301.   while ( P >= 0 ) and ( (Ptr^ and $00FFFFFF) <> $5C2E2E) do begin
  4302.    Dec(P);
  4303.    Ptr:=IncPtr(Ptr, -1);
  4304.   end;
  4305.   Inc(P);
  4306.   Result:=P;
  4307.  end;
  4308.  
  4309. var
  4310.  Drive: TString;
  4311.  P: Integer;
  4312. begin
  4313.  if IsAbsoluteFileName(RelativeName) then Result:=RelativeName else begin
  4314.   CurrentDir:=RightTrim(CurrentDir, '\');
  4315.   RelativeName:=LeftTrim(RelativeName, '\');
  4316.   Drive:=ExtractFileDrive(CurrentDir);
  4317.   Delete(CurrentDir, 1, Length(Drive)+1);
  4318.   P:=Length(RelativeName) - 3;
  4319.   while (FindDots(RelativeName, P) > 0) do begin
  4320.    Delete(RelativeName, P, 3);
  4321.    RemoveLastSubDir(CurrentDir);
  4322.    Dec(P);
  4323.   end;
  4324.   Result:=IncludeTrailingBackslash(Drive+'\'+CurrentDir)+RelativeName;
  4325.  end;
  4326. end;
  4327.  
  4328. function GetDiskFreeSize(Dir: TString): Int64;
  4329. var
  4330.  GetDiskFreeSpaceEx: function(Root: PChar; FBA, TNB, TNFB: PInt64): BOOL stdcall;
  4331.  GetDiskFreeSpace: function(Root: PChar; SPC, BPS, NFC, TNC: LPDWORD): BOOL stdcall;
  4332.  Handle: HINST;
  4333.  Dummy: Int64;
  4334.  SPC, BPS, NFC: DWORD;
  4335. begin
  4336.  Handle:=GetModuleHandle('kernel32.dll');
  4337.  GetDiskFreeSpaceEx:=GetProcAddress(Handle, 'GetDiskFreeSpaceExA');
  4338.  if Assigned(GetDiskFreeSpaceEx) then begin
  4339.   if not GetDiskFreeSpaceEx(PChar(Dir), @Result, @Dummy, @Dummy) then Result:=-1;
  4340.  end else begin
  4341.   GetDiskFreeSpace:=GetProcAddress(Handle, 'GetDiskFreeSpaceA');
  4342.   if Assigned(GetDiskFreeSpace) and
  4343.   GetDiskFreeSpace(PChar(Dir), @SPC, @BPS, @NFC, PDWORD(@Dummy))
  4344.    then Result:=SPC*BPS*NFC else Result:=-1;
  4345.  end;
  4346. end;
  4347.  
  4348.  
  4349. function GetColor(Color: Integer): Integer; register;
  4350. asm
  4351.    cmp   eax, 0
  4352.    jge   @@10
  4353.    and   eax, 000000FFH
  4354.    push  eax
  4355.    call  GetSysColor
  4356. @@10:
  4357. end;
  4358.  
  4359. function GetColor(Red, Green, Blue: Integer): Integer; register;
  4360. asm
  4361.    and   eax, 0FFh
  4362.    and   edx, 0FFh
  4363.    and   ecx, 0FFh
  4364.    shl   edx, 8
  4365.    shl   ecx, 16
  4366.    or    eax, ecx
  4367.    or    eax, edx
  4368. end;
  4369.  
  4370. procedure IndexToRGB(Color: Integer; R, G, B : PByte);
  4371. asm
  4372.    push ebx
  4373.    mov  ebx, b
  4374.    test edx, edx
  4375.    jz   @@GREEN
  4376.    mov  [edx], al
  4377. @@GREEN:
  4378.    shr  eax, 8
  4379.    test ecx, ecx
  4380.    jz   @@BLUE
  4381.    mov  [ecx], al
  4382. @@BLUE:
  4383.    shr eax, 8
  4384.    test ebx, ebx
  4385.    jz   @@QUIT
  4386.    mov  [ebx], al
  4387. @@QUIT:
  4388.    pop ebx
  4389. end;
  4390.  
  4391.  
  4392. procedure Line(DC: HDC; X1, Y1, X2, Y2: Integer);
  4393. begin
  4394.  MoveToEx(DC, X1, Y1, nil);
  4395.  LineTo(DC, X2, Y2);
  4396. end;
  4397.  
  4398. function clGradientActiveCaption: Integer;
  4399. var
  4400.  B: BOOL;
  4401. begin
  4402.  SystemParametersInfo(SPI_GETGRADIENTCAPTIONS, 0, @B, 0);
  4403.  if B then Result:=GetSysColor(COLOR_GRADIENTACTIVECAPTION)
  4404.   else Result:=GetSysColor(COLOR_ACTIVECAPTION);
  4405. end;
  4406.  
  4407.  
  4408. function ValueToName(Value:Integer;Map:array of TIdentMapItem; Default: TString = ''):TString;
  4409. var i:Integer;
  4410. begin
  4411.  Result:=Default;
  4412.  for i:=Low(Map) to High(Map) do if Map[i].Value=Value then begin
  4413.   Result:=Map[i].Name;
  4414.   Break;
  4415.  end;
  4416. end;
  4417.  
  4418. function NameToValue(Name:TString;Map:array of TIdentMapItem; Default: Integer = 0):Integer;
  4419. var i:Integer;
  4420. begin
  4421.  Result:=Default;
  4422.  for i:=Low(Map) to High(Map) do if Map[i].Name=Name then begin
  4423.   Result:=Map[i].Value;
  4424.   Break;
  4425.  end;
  4426. end;
  4427.  
  4428. const
  4429.  NPUControl   : word = $1C3F;
  4430.  NPUCtrlRound : word = $133F;
  4431.  NPUCtrlFloor : word = $143F;
  4432.  NPUCtrlCeil  : word = $183F;
  4433.  SaveNPUCtrl  : word = $0000;
  4434.  
  4435. function Int(R: Extended):Extended;
  4436. asm
  4437.   fclex
  4438.   fstcw   SaveNPUCtrl
  4439.   fldcw   NPUControl
  4440.   fld     R
  4441.   frndint
  4442.   fwait
  4443.   fldcw   SaveNPUCtrl
  4444. end;
  4445.  
  4446. function Frac(R:Extended):Extended;
  4447. begin
  4448.  Result:=R-Int(R);
  4449. end;
  4450.  
  4451. function Trunc(R:Extended):Integer;
  4452. var
  4453.  ERX: LongInt;
  4454. asm
  4455.   fclex
  4456.   fstcw SaveNPUCtrl
  4457.   fldcw NPUControl
  4458.   fld   R
  4459.   fistp dword ptr ERX
  4460.   fwait
  4461.   fldcw SaveNPUCtrl
  4462.   mov   eax, ERX
  4463. end;
  4464.  
  4465. function Round(R:Extended):Integer;
  4466. var
  4467.   ERX: LongInt;
  4468. asm
  4469.   fclex
  4470.   fstcw SaveNPUCtrl
  4471.   fldcw NPUCtrlRound
  4472.   fld   R
  4473.   fistp dword ptr ERX
  4474.   fwait
  4475.   fldcw SaveNPUCtrl
  4476.   mov   eax, ERX
  4477. end;
  4478.  
  4479. function Floor(R:Extended):Extended;
  4480. asm
  4481.   fclex
  4482.   fstcw   SaveNPUCtrl
  4483.   fldcw   NPUCtrlFloor
  4484.   fld     R
  4485.   frndint
  4486.   fwait
  4487.   fldcw   SaveNPUCtrl
  4488. end;
  4489.  
  4490. function Ceil(R:Extended):Extended;
  4491. asm
  4492.   fclex
  4493.   fstcw   SaveNPUCtrl
  4494.   fldcw   NPUCtrlCeil
  4495.   fld     R
  4496.   frndint
  4497.   fwait
  4498.   fldcw   SaveNPUCtrl
  4499. end;
  4500.  
  4501. function Arctan2(X, Y: Extended): Extended;
  4502. asm
  4503.         FLD     X
  4504.         FLD     Y
  4505.         FPATAN
  4506.         FWAIT
  4507. end;
  4508.  
  4509. procedure ClearFPUEx;
  4510. asm
  4511.    FCLEX
  4512. end;
  4513.  
  4514. function Infinity(R:Extended):Integer;
  4515. var
  4516.  P:^cardinal;
  4517.  N:Integer;
  4518. begin
  4519.  N:=Integer(@R)+6;
  4520.  P:=Pointer(N);
  4521.  case P^ of
  4522.   $7FFF8000:Result:=1;
  4523.   $FFFF8000:Result:=-1;
  4524.   else Result:=0;
  4525.  end;
  4526. end;
  4527.  
  4528. function NonAtNumber(R:Extended):Boolean;
  4529. var
  4530.  P:^cardinal;
  4531.  N:Integer;
  4532. begin
  4533.  N:=Integer(@R)+6;
  4534.  P:=Pointer(N);
  4535.  PByte(P)^:=0;
  4536.  Result:=P^=$FFFFC000;
  4537. end;
  4538.  
  4539. function LoadTextFile(const FileName:TString; var Text:TString):Integer;
  4540. var
  4541.  F: File;
  4542.  Count:Integer;
  4543. begin
  4544.  {$I-}
  4545.  AssignFile(F,FileName); Reset(F,1);
  4546.  Count:=FileSize(F)+10;
  4547.  Setlength(Text, Count);
  4548.  BlockRead(F, PChar(Text)^, Count);
  4549.  CleanUp(Text);
  4550.  CloseFile(F);
  4551.  {$I+}
  4552.  Result:=IOResult;
  4553. end;
  4554.  
  4555. function SaveTextFile(const FileName, Text: TString):Integer;
  4556. var
  4557.  F:File;
  4558.  Count:Integer;
  4559. begin
  4560.  {$I-}
  4561.  AssignFile(F,FileName); Rewrite(F,1);
  4562.  Count:=Length(Text);
  4563.  BlockWrite(F, PChar(Text)^, Count);
  4564.  CloseFile(F);
  4565.  {$I+}
  4566.  Result:=IOResult;
  4567. end;
  4568.  
  4569. function Incr(var N:Integer):Integer; register;
  4570. asm
  4571.    mov  edx, [eax]
  4572.    inc  edx
  4573.    mov  [eax], edx
  4574.    mov  eax, edx
  4575. end;
  4576.  
  4577. function Decr(var N:Integer):Integer; register;
  4578. asm
  4579.    mov  edx, [eax]
  4580.    dec  edx
  4581.    mov  [eax], edx
  4582.    mov  eax, edx
  4583. end;
  4584.  
  4585. function HiLong(const N: TWideInt): LongInt;
  4586. asm
  4587.    mov   eax, [eax+4]
  4588. end;
  4589.  
  4590. function LoLong(const N: TWideInt): LongInt;
  4591. asm
  4592.    mov   eax, [eax]
  4593. end;
  4594.  
  4595. function HiWord(N: Integer): word;
  4596. asm
  4597.    shr   eax, 16
  4598. end;
  4599.  
  4600. function LoWord(N: Integer): word;
  4601. asm
  4602.    and   eax, 0FFFFh;
  4603. end;
  4604.  
  4605. function HiByte(W: Word): Byte;
  4606. asm
  4607.    shr   ax, 8
  4608. end;
  4609.  
  4610. function LoByte(W: Word): Byte;
  4611. asm
  4612.    and   ax, 0FFh
  4613. end;
  4614.  
  4615. function AbsSub(N1, N2: Integer): Integer;
  4616. asm
  4617.    sub   eax, edx
  4618.    test  eax, eax
  4619.    jl    @@10
  4620.    ret
  4621. @@10:
  4622.    neg   eax
  4623. end;
  4624.  
  4625. function Bit(Value, Index: Integer): Boolean;
  4626. asm
  4627.    bt    eax, edx
  4628.    setc  al
  4629.    and   eax, 0FFh
  4630. end;
  4631.  
  4632.  
  4633. function SwapWords(Value: Integer): Integer;
  4634. asm
  4635.    mov   ecx, eax
  4636.    shl   ecx, 16
  4637.    shr   eax, 16
  4638.    or    eax, ecx
  4639. end;
  4640.  
  4641. function AbsInt(Value: Integer): Integer;
  4642. asm
  4643.    test  eax, eax
  4644.    jl    @@10
  4645.    ret
  4646. @@10:
  4647.    neg   eax
  4648. end;
  4649.  
  4650. function GetAddress: Pointer;
  4651. asm
  4652.    mov   eax, [esp]
  4653.    add   eax, -5
  4654. end;
  4655.  
  4656. procedure MoveMem(const Source; var Dest; Count: Integer);
  4657. asm
  4658.    push  esi
  4659.    push  edi
  4660.    mov   esi, eax
  4661.    mov   edi, edx
  4662.    mov   eax, ecx
  4663.    cmp   edi, esi
  4664.    ja    @@10
  4665.    je    @@20
  4666.    sar   ecx, 2
  4667.    js    @@20
  4668.    rep   movsd
  4669.    mov   ecx, eax
  4670.    and   ecx, 3
  4671.    rep   movsb
  4672.    jmp   @@20
  4673. @@10:
  4674.    lea   esi, [esi+ecx-4]
  4675.    lea   edi, [edi+ecx-4]
  4676.    sar   ecx, 2
  4677.    js    @@20
  4678.    std
  4679.    rep   movsd
  4680.    mov   ecx, eax
  4681.    and   ecx, 3
  4682.    add   esi, 3
  4683.    add   edi, 3
  4684.    rep   movsb
  4685.    cld
  4686. @@20:
  4687.    pop   edi
  4688.    pop   esi
  4689. end;
  4690.  
  4691. procedure InvertMem(var X; Size:Integer=1);
  4692. asm
  4693.    push   esi
  4694.    mov    esi, eax
  4695.    mov    eax, edx
  4696.    sar    edx, 2
  4697. @@10:
  4698.    test   edx, edx
  4699.    jz     @@20
  4700.    mov    ecx, [esi]
  4701.    not    ecx
  4702.    mov    [esi], ecx
  4703.    add    esi, 4
  4704.    dec    edx
  4705.    jmp    @@10
  4706. @@20:
  4707.    mov    edx, eax
  4708.    and    edx, 3
  4709. @@30:
  4710.    test   edx, edx
  4711.    jz     @@40
  4712.    mov    cl, [esi]
  4713.    not    cl
  4714.    mov    [esi], cl
  4715.    inc    esi
  4716.    dec    edx
  4717.    jmp    @@30
  4718. @@40:
  4719.    pop    esi
  4720. end;
  4721.  
  4722. procedure XorMem(var X; Size: Integer; Value: Byte);
  4723. asm
  4724.    test   edx, edx
  4725.    jz     @@10
  4726.    xor    [eax], cl
  4727.    inc    eax
  4728.    dec    edx
  4729.    jmp    XorMem
  4730. @@10:
  4731. end;
  4732.  
  4733. procedure XorMemW(var X; Count: Integer; Value: Word);
  4734. asm
  4735.    test   edx, edx
  4736.    jz     @@10
  4737.    xor    [eax], cx
  4738.    add    eax, 2
  4739.    dec    edx
  4740.    jmp    XorMemW
  4741. @@10:
  4742. end;
  4743.  
  4744. procedure XorMemL(var X; Count: Integer; Value: LongInt);
  4745. asm
  4746.    test   edx, edx
  4747.    jz     @@10
  4748.    xor    [eax], ecx
  4749.    add    eax, 4
  4750.    dec    edx
  4751.    jmp    XorMemL
  4752. @@10:
  4753. end;
  4754.  
  4755. procedure FillMem(var X; Size: Integer; Value: Byte = 0);
  4756. asm
  4757.    push   edi
  4758.    mov    edi, eax
  4759.    mov    ch, cl
  4760.    mov    ax, cx
  4761.    shl    eax, 16
  4762.    mov    ax, cx
  4763.    mov    ecx, edx
  4764.    sar    ecx, 2
  4765.    rep    stosd
  4766.    mov    ecx, edx
  4767.    and    ecx, 3
  4768.    rep    stosb
  4769.    pop    edi
  4770. end;
  4771.  
  4772. procedure FillMemW(var X; Count: Integer; Value: Word = 0);
  4773. asm
  4774.    push   edi
  4775.    mov    edi, eax
  4776.    mov    ax, cx
  4777.    mov    ecx, edx
  4778.    rep    stosw
  4779.    pop    edi
  4780. end;
  4781.  
  4782. procedure FillMemL(var X; Count: Integer; Value: LongInt = 0);
  4783. asm
  4784.    push   edi
  4785.    mov    edi, eax
  4786.    mov    eax, ecx
  4787.    mov    ecx, edx
  4788.    rep    stosd
  4789.    pop    edi
  4790. end;
  4791.  
  4792. procedure ClearMem(var X; Size: Integer);
  4793. asm
  4794.    push   edi
  4795.    mov    edi, eax
  4796.    xor    eax, eax
  4797.    mov    ecx, edx
  4798.    sar    ecx, 2
  4799.    rep    stosd
  4800.    mov    ecx, edx
  4801.    and    ecx, 3
  4802.    rep    stosb
  4803.    pop    edi
  4804. end;
  4805.  
  4806. function GetLength(const Str: TString): Integer; register;
  4807. asm
  4808.    test  eax, eax
  4809.    jz    @@20
  4810.    mov   edx, eax
  4811.    dec   eax
  4812. @@10:
  4813.    inc   eax
  4814.    mov   cl, [eax]
  4815.    test  cl, cl
  4816.    jnz   @@10
  4817.    sub   eax, edx
  4818. @@20:
  4819. end;
  4820.  
  4821. function GetStrLen(const Str: TString): Integer;
  4822. asm
  4823.    test  eax, eax
  4824.    jz    @@10
  4825.    mov   eax, [eax-4]
  4826. @@10:
  4827. end;
  4828.  
  4829. function IsEmptyStr(const Str: TString): LongBool; register;
  4830. asm
  4831.    test  eax, eax
  4832.    jz    @@10
  4833.    mov   al, [eax]
  4834.    test  al, al
  4835.    setz  al
  4836.    and   eax, 0FFh
  4837.    ret
  4838. @@10:
  4839.    inc   al
  4840. end;
  4841.  
  4842. function CharEntryPos(const Str: TString; Ch: Char; Entry: Integer): Integer; register;
  4843. asm
  4844.    push  edi
  4845.    push  esi
  4846.    test  eax, eax
  4847.    jnz   @@10
  4848.    xor   eax, eax
  4849.    jmp   @@50
  4850. @@10:
  4851.    cmp   ecx, 0
  4852.    jnz   @@20
  4853.    xor   eax, eax
  4854.    jmp   @@50
  4855. @@20:
  4856.    mov   edi, eax
  4857.    dec   edi
  4858.    xor   esi, esi
  4859. @@30:
  4860.    inc   edi
  4861.    mov   dh, [edi]
  4862.    test  dh, dh
  4863.    jnz   @@40
  4864.    xor   eax, eax
  4865.    jmp   @@50
  4866. @@40:
  4867.    cmp   dh, dl
  4868.    jne   @@30
  4869.    inc   esi
  4870.    cmp   esi, ecx
  4871.    jne   @@30
  4872.    sub   edi, eax
  4873.    mov   eax, edi
  4874.    inc   eax
  4875. @@50:
  4876.    pop   esi
  4877.    pop   edi
  4878. end;
  4879.  
  4880. procedure ReplaceText(const SubStr: TString; var Str: TString; Pos, Len: Integer);
  4881. begin
  4882.  Delete(Str, Pos, Len);
  4883.  Insert(SubStr, Str, Pos);
  4884. end;
  4885.  
  4886. function EqualText(const S1, S2: TString): LongBool;
  4887. var
  4888.    Nullum: LongInt;
  4889. asm
  4890.    xor   ecx, ecx
  4891.    mov   Nullum, ecx
  4892.    test  edx, edx
  4893.    jz    @@10
  4894.    mov   ecx, [edx-4]
  4895.    jmp   @@20
  4896. @@10:
  4897.    lea   edx, Nullum
  4898. @@20:
  4899.    push  ecx
  4900.    push  edx
  4901.    xor   ecx, ecx
  4902.    test  eax, eax
  4903.    jz    @@30
  4904.    mov   ecx, [eax-4]
  4905.    jmp   @@40
  4906. @@30:
  4907.    lea   eax, Nullum
  4908. @@40:   
  4909.    push  ecx
  4910.    push  eax
  4911.    push  NORM_IGNORECASE
  4912.    push  LOCALE_USER_DEFAULT
  4913.    call  CompareString
  4914.    cmp   eax, 2
  4915.    setz  al
  4916.    and   eax, 0FFh
  4917. end;
  4918.  
  4919. function EqualStr(const S1, S2: TString): LongBool;
  4920. var
  4921.    Nullum: LongInt;
  4922. asm
  4923.    xor   ecx, ecx
  4924.    mov   Nullum, ecx
  4925.    test  edx, edx
  4926.    jz    @@10
  4927.    mov   ecx, [edx-4]
  4928.    jmp   @@20
  4929. @@10:
  4930.    lea   edx, Nullum
  4931. @@20:
  4932.    push  ecx
  4933.    push  edx
  4934.    xor   ecx, ecx
  4935.    test  eax, eax
  4936.    jz    @@30
  4937.    mov   ecx, [eax-4]
  4938.    jmp   @@40
  4939. @@30:
  4940.    lea   eax, Nullum
  4941. @@40:   
  4942.    push  ecx
  4943.    push  eax
  4944.    push  0
  4945.    push  LOCALE_USER_DEFAULT
  4946.    call  CompareString
  4947.    cmp   eax, 2
  4948.    setz  al
  4949.    and   eax, 0FFh
  4950. end;
  4951.  
  4952. function IntToStrLen(N: Integer; Len: Integer = 0): TString;
  4953. begin
  4954.  Result:=IntToStr(N);
  4955.  if GetStrLen(Result)<Len then Result:=FillString('0',Len-GetStrLen(Result))+Result;
  4956. end;
  4957.  
  4958. function GetPos(const SubStr, Str: TString; CaseSensitive: LongBool = True): Integer;
  4959. var
  4960.   PTX, CSX: Integer;
  4961. asm
  4962.    push  esi
  4963.    push  edi
  4964.    push  ebx
  4965.    test  eax, eax
  4966.    jz    @@20
  4967.    test  edx, edx
  4968.    jz    @@20
  4969.    mov   esi, eax
  4970.    mov   edi, edx
  4971.    mov   ptx, edx
  4972.    mov   ebx, [esi-4]
  4973.    not   ecx
  4974.    and   ecx, 1
  4975.    mov   CSX, ecx
  4976.    dec   edi
  4977. @@10:
  4978.    inc   edi
  4979.    mov   al, [edi]
  4980.    test  al, al
  4981.    jz    @@20
  4982.    push  ebx
  4983.    push  esi
  4984.    push  ebx
  4985.    push  edi
  4986.    push  csx
  4987.    push  LOCALE_USER_DEFAULT
  4988.    call  CompareString
  4989.    cmp   eax, 2
  4990.    jne   @@10
  4991.    mov   eax, edi
  4992.    sub   eax, ptx
  4993.    inc   eax
  4994.    jmp   @@30
  4995. @@20:
  4996.    xor   eax, eax
  4997. @@30:
  4998.    pop   ebx
  4999.    pop   edi
  5000.    pop   esi
  5001. end;
  5002.  
  5003. function GUIDToString(const GUID: TGUID): TString;
  5004. var
  5005.  S1, S2, S3: TString;
  5006.  S401: TString;
  5007.  S427: TString;
  5008.  i: Integer;
  5009. begin
  5010.  S1:=IntToHex(GUID.D1, 8);
  5011.  S2:=IntToHex(GUID.D2, 4);
  5012.  S3:=IntToHex(GUID.D3, 4);
  5013.  S401:=IntToHex(GUID.D4[0], 2)+IntToHex(GUID.D4[1], 2);
  5014.  S427:='';
  5015.  for i:=2 to 7 do S427:=S427+IntToHex(GUID.D4[i],2);
  5016.  Result:=Format('{%s-%s-%s-%s-%s}', [S1, S2, S3, S401, S427]);
  5017. end;
  5018.  
  5019.  
  5020. function CreateGUID(out GUID: TGUID): HResult; stdcall;
  5021.  
  5022.  const
  5023.   Funcs: array[Boolean] of TString = ('UuidCreate', 'UuidCreateSequential');
  5024.  
  5025.  function DoCreate(Func: TString; out GUID: TGUID): HResult;
  5026.  var
  5027.   UuidCreateFunc : function (var guid: TGUID): LongInt stdcall;
  5028.   RPCRT4: HINST;
  5029.  begin
  5030.   RPCRT4:=LoadLibrary('RPCRT4.DLL');
  5031.   UuidCreateFunc:=GetProcAddress(RPCRT4, PChar(Func));
  5032.   Result:=UuidCreateFunc(GUID);
  5033.   FreeLibrary(RPCRT4);
  5034.  end;
  5035.  
  5036. begin
  5037.  Result:=DoCreate(Funcs[Win2K or WinME], GUID);
  5038. end;
  5039.  
  5040. const
  5041.  LTRS   : array [0..26] of Char = ' ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  5042.  
  5043. function LetterToNumber(const Letter: TString): Integer;
  5044. var
  5045.  Ch1, Ch2: Integer;
  5046.  L: Integer;
  5047. begin
  5048.  L:=GetLength(Letter);
  5049.  if Inside(L, 1, 2) then begin
  5050.   if Length(Letter)=1 then begin
  5051.    Ch1:=0; Ch2:=Ord(Letter[1])-64;
  5052.   end else begin
  5053.    Ch1:=Ord(Letter[1])-64; Ch2:=Ord(Letter[2])-64;
  5054.   end;
  5055.   Result:=Ch1*26+Ch2;
  5056.  end else Result:=-1;
  5057. end;
  5058.  
  5059. function NumberToLetter(Number: Integer): TString;
  5060. var
  5061.  C1, C2: Integer;
  5062. begin
  5063.  if Inside(Number, 1, 702) then begin
  5064.   C2:=Number mod 26;
  5065.   if C2 = 0 then C2:=26;
  5066.   C1:=(Number - C2) div 26;
  5067.   Result:=LeftTrim(LTRS[C1]+LTRS[C2]);
  5068.  end else Result:='';
  5069. end;
  5070.  
  5071. procedure SplitAlphanumericName(const Name: TString; var Alpha: TString;
  5072.  var Num: Integer; const AdditionalChars: TSetChar = []);
  5073. var
  5074.  _num: TString;
  5075.  i, Len, P, Code: Integer;
  5076.  Ch: Char;
  5077. begin
  5078.  Len:=Length(Name);
  5079.  P:=0;
  5080.  for i:=Len downto 1 do begin
  5081.   Ch:=Name[i];
  5082.   if IsCharAlpha(Ch) or (Ch in AdditionalChars) then begin
  5083.    P:=i;
  5084.    Break;
  5085.   end;
  5086.  end;
  5087.  if P = 0 then begin
  5088.   Alpha:=Name;
  5089.   Num:=0;
  5090.  end else begin
  5091.   Alpha:=Copy(Name, 1, P);
  5092.   _num:=Copy(Name, P+1, Len-P);
  5093.   val(_num, Num, Code);
  5094.  end;
  5095. end;
  5096.  
  5097. function HexToInt(const Hex: TString; var Code: Integer): Integer;
  5098. var
  5099.  I: Integer;
  5100.  C: Integer;
  5101.  N: Integer;
  5102.  Ch: Char;
  5103. begin
  5104.  Result:=0;
  5105.  Code:=0;
  5106.  C:=0;
  5107.  for i:=Length(Hex) downto 1 do begin
  5108.   Ch:=Hex[i];
  5109.   Hole(N);
  5110.   case Ch of
  5111.    '0'..'9': N:=Ord(Ch)-Ord('0');
  5112.    'A'..'F': N:=Ord(Ch)-Ord('A')+10;
  5113.    'a'..'f': N:=Ord(Ch)-Ord('a')+10;
  5114.    else begin
  5115.     Result:=0;
  5116.     Code:=i;
  5117.     Exit;
  5118.    end;
  5119.   end;
  5120.   N:=N shl C;
  5121.   Result:=Result or N;
  5122.   Inc(C, 4);
  5123.  end;
  5124. end;
  5125.  
  5126.  
  5127. function UrlEncode(Str: TString): TString;
  5128.  
  5129. function CharToHex(Ch: Char): Integer;
  5130.  asm
  5131.     and   eax, 0FFh
  5132.     mov   ah, al
  5133.     shr   al, 4
  5134.     and   ah, 00fh
  5135.     cmp   al, 00ah
  5136.     jl    @@10
  5137.     sub   al, 00ah
  5138.     add   al, 041h
  5139.     jmp   @@20
  5140. @@10:
  5141.     add   al, 030h
  5142. @@20:
  5143.     cmp   ah, 00ah
  5144.     jl    @@30
  5145.     sub   ah, 00ah
  5146.     add   ah, 041h
  5147.     jmp   @@40
  5148. @@30:
  5149.     add   ah, 030h
  5150. @@40:
  5151.     shl   eax, 8
  5152.     mov   al, '%'
  5153. end;
  5154.  
  5155. var
  5156.  i, Len: Integer;
  5157.  Ch: Char;
  5158.  N: Integer; P: PChar;
  5159. begin
  5160.  Result:='';
  5161.  Len:=Length(Str);
  5162.  P:=PChar(@N);
  5163.  for i:=1 to Len do begin
  5164.   Ch:=Str[i];
  5165.   if Ch in ['0'..'9', 'A'..'Z', 'a'..'z', '_'] then Result:=Result+Ch else begin
  5166.    if Ch = ' ' then Result:=Result+'+' else begin
  5167.     N:=CharToHex(Ch);
  5168.     Result:=Result+P;
  5169.    end;
  5170.   end;
  5171.  end;
  5172. end;
  5173.  
  5174. function UrlDecode(Str: TString): TString;
  5175.  
  5176. function HexToChar(W: word): Char;
  5177. asm
  5178.    cmp   ah, 030h
  5179.    jl    @@error
  5180.    cmp   ah, 039h
  5181.    jg    @@10
  5182.    sub   ah, 30h
  5183.    jmp   @@30
  5184. @@10:
  5185.    cmp   ah, 041h
  5186.    jl    @@error
  5187.    cmp   ah, 046h
  5188.    jg    @@20
  5189.    sub   ah, 041h
  5190.    add   ah, 00Ah
  5191.    jmp   @@30
  5192. @@20:
  5193.    cmp   ah, 061h
  5194.    jl    @@error
  5195.    cmp   al, 066h
  5196.    jg    @@error
  5197.    sub   ah, 061h
  5198.    add   ah, 00Ah
  5199. @@30:
  5200.    cmp   al, 030h
  5201.    jl    @@error
  5202.    cmp   al, 039h
  5203.    jg    @@40
  5204.    sub   al, 030h
  5205.    jmp   @@60
  5206. @@40:
  5207.    cmp   al, 041h
  5208.    jl    @@error
  5209.    cmp   al, 046h
  5210.    jg    @@50
  5211.    sub   al, 041h
  5212.    add   al, 00Ah
  5213.    jmp   @@60
  5214. @@50:
  5215.    cmp   al, 061h
  5216.    jl    @@error
  5217.    cmp   al, 066h
  5218.    jg    @@error
  5219.    sub   al, 061h
  5220.    add   al, 00Ah
  5221. @@60:
  5222.    shl   al, 4
  5223.    or    al, ah
  5224.    ret
  5225. @@error:
  5226.    xor   al, al
  5227. end;
  5228.  
  5229. function GetCh(P: PChar; var Ch: Char): Char;
  5230. begin
  5231.  Ch:=P^;
  5232.  Result:=Ch;
  5233. end;
  5234.  
  5235. var
  5236.  P: PChar;
  5237.  Ch: Char;
  5238. begin
  5239.  Result:='';
  5240.  P:=@Str[1];
  5241.  while GetCh(P, Ch) <> #0 do begin
  5242.   case Ch of
  5243.    '+': Result:=Result+' ';
  5244.    '%': begin
  5245.     Inc(P);
  5246.     Result:=Result+HexToChar(PWord(P)^);
  5247.     Inc(P);
  5248.    end;
  5249.    else Result:=Result+Ch;
  5250.   end;
  5251.   Inc(P);
  5252.  end;
  5253. end;
  5254.  
  5255.  
  5256. function CreateInstance(CLSID, IID: TGUID; out Instance): HResult;
  5257. begin
  5258.  Result:=CoCreateInstance(CLSID, nil, CLSCTX_INPROC_SERVER, IID, Instance);
  5259.  if (Result <> S_OK) and Assigned(CannotCreateInstance) then CannotCreateInstance(CLSID);
  5260. end;
  5261.  
  5262. function Recycle(const Name: TString; Wnd: HWND = 0): Boolean;
  5263. var
  5264.  FileOp: TSHFileOpStruct;
  5265. begin
  5266.  ClearMem(FileOp, SizeOf(FileOp));
  5267.  if Wnd = 0 then Wnd := TrayWnd;
  5268.  FileOp.Wnd:=Wnd;
  5269.  FileOp.wFunc:=FO_DELETE;
  5270.  FileOp.pFrom:=PChar(Name);
  5271.  FileOp.fFlags:=FOF_ALLOWUNDO or FOF_NOERRORUI or FOF_SILENT;
  5272.  Result:=(SHFileOperation(FileOp) = 0) and (not FileOp.fAnyOperationsAborted);
  5273. end;
  5274.  
  5275. function MapNetworkDrive(Wnd: HWND = 0): DWORD;
  5276. begin
  5277.  if Wnd = 0 then Wnd:=TrayWnd;
  5278.  Result:=WNetConnectionDialog(Wnd, RESOURCETYPE_DISK);
  5279. end;
  5280.  
  5281. function DisconnectNetworkDrive(Wnd: HWND = 0): DWORD;
  5282. begin
  5283.  if Wnd = 0 then Wnd:=TrayWnd;
  5284.  Result:=WNetDisconnectDialog(Wnd, RESOURCETYPE_DISK);
  5285. end;
  5286.  
  5287. function BitsPerPixel: Integer;
  5288. var
  5289.  DH: HWND;
  5290.  DC: HDC;
  5291. begin
  5292.  DH:=GetDesktopWindow;
  5293.  DC:=GetDC(DH);
  5294.  Result:=GetDeviceCaps(DC, BITSPIXEL);
  5295.  ReleaseDC(DH, DC);
  5296. end;
  5297.  
  5298. function RegWriteStr(RootKey: HKEY; Key, Name, Value: TString): Boolean;
  5299. var
  5300.  Handle: HKEY;
  5301.  Res: LongInt;
  5302. begin
  5303.  Result:=False;
  5304.  Res:=RegCreateKeyEx(RootKey, PChar(Key), 0, nil, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS,
  5305.   nil, Handle, nil);
  5306.  if Res<>ERROR_SUCCESS then Exit;
  5307.  Res:=RegSetValueEx(Handle, PChar(Name), 0, REG_SZ, PChar(Value), Length(Value)+1);
  5308.  Result:=Res=ERROR_SUCCESS;
  5309.  RegCloseKey(Handle);
  5310. end;
  5311.  
  5312. function RegQueryStr(RootKey: HKEY; Key, Name: TString; Success: PBoolean = nil): TString;
  5313. var
  5314.  Handle: HKEY;
  5315.  Res: LongInt;
  5316.  DataType, DataSize: DWORD;
  5317. begin
  5318.  SetByteValue(Success, Byte(False));
  5319.  Res:=RegOpenKeyEx(RootKey, PChar(Key), 0, KEY_QUERY_VALUE, Handle);
  5320.  if Res<>ERROR_SUCCESS then Exit;
  5321.  Res:=RegQueryValueEx(Handle, PChar(Name), nil, @DataType, nil, @DataSize);
  5322.  if (Res<>ERROR_SUCCESS) or (DataType<>REG_SZ) then begin
  5323.   RegCloseKey(Handle);
  5324.   Exit;
  5325.  end;
  5326.  SetString(Result, nil, DataSize-1);
  5327.  Res:=RegQueryValueEx(Handle, PChar(Name), nil, @DataType, PByte(@Result[1]), @DataSize);
  5328.  if Res = ERROR_SUCCESS then SetByteValue(Success, Byte(True));
  5329.  RegCloseKey(Handle);
  5330. end;
  5331.  
  5332. function RunApplication(Path, CmdLine, Dir: TString; Wait: Boolean = False): Cardinal;
  5333. var
  5334.  StartUpInfo: TStartUpInfo;
  5335.  ProcessInformation: TProcessInformation;
  5336. begin
  5337.  FillChar(StartUpInfo, SizeOf(StartUpInfo), 0);
  5338.  FillChar(ProcessInformation, SizeOf(ProcessInformation), 0);
  5339.  CleanUp(Path, True);
  5340.  CleanUp(CmdLine, True);
  5341.  CleanUp(Dir, True);
  5342.  if IsEmptyStr(CmdLine) then CmdLine:=chSpace;
  5343.  Result:=0;
  5344.  if CreateProcess(PChar(Path), PChar(CmdLine), nil, nil, False, NORMAL_PRIORITY_CLASS,
  5345.   nil, PChar(Dir), StartUpInfo, ProcessInformation) then begin
  5346.   Result:=ProcessInformation.hProcess;
  5347.   if Wait then begin
  5348.    WaitForSingleObject(Result, INFINITE);
  5349.    Result:=1;
  5350.   end;
  5351.  end;
  5352. end;
  5353.  
  5354. procedure UniteLists(List1, List2: TStrings);
  5355. var
  5356.  C: Integer;
  5357.  i: Integer;
  5358.  S: TString;
  5359. begin
  5360.  C:=List2.Count-1;
  5361.  for i:=0 to C do begin
  5362.   S:=List2[i];
  5363.   if List1.IndexOf(S)=-1 then List1.Add(S);
  5364.  end;
  5365. end;
  5366.  
  5367.  
  5368. { TShellLink }
  5369.  
  5370. constructor TShellLink.Create;
  5371. begin
  5372.  inherited Create;
  5373.  OleInitialize(nil);
  5374.  CreateInstance(CLSID_ShellLink, IShellLink, FShellLink);
  5375.  if Assigned(FShellLink) then FShellLink.QueryInterface(IPersistFile, FPersistFile);
  5376. end;
  5377.  
  5378. function TShellLink.DesktopFolder: TString;
  5379. begin
  5380.  if IsEmptyStr(FDesktopFolder) then
  5381.   FDesktopFolder:=IncludeTrailingBackslash(SpecialFolder(CSIDL_DESKTOP));
  5382.  Result:=FDesktopFolder;
  5383. end;
  5384.  
  5385. destructor TShellLink.Destroy;
  5386. begin
  5387.  FPersistFile:=nil;
  5388.  FShellLink:=nil;
  5389.  inherited Destroy;
  5390. end;
  5391.  
  5392. function TShellLink.GetArguments: TString;
  5393. var
  5394.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  5395. begin
  5396.  Result:='';
  5397.  if Assigned(FShellLink) then begin
  5398.   FResult:=FShellLink.GetArguments(@Buf[0], MAX_PATH);
  5399.   RunError(SShellLinkReadError);
  5400.   Result:=PChar(@Buf[0]);
  5401.  end;
  5402. end;
  5403.  
  5404. function TShellLink.GetDescription: TString;
  5405. var
  5406.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  5407. begin
  5408.  Result:='';
  5409.  if Assigned(FShellLink) then begin
  5410.   FResult:=FShellLink.GetDescription(@Buf[0], MAX_PATH);
  5411.   RunError(SShellLinkReadError);
  5412.   Result:=PChar(@Buf[0]);
  5413.  end;
  5414. end;
  5415.  
  5416. function TShellLink.GetHotKey: Word;
  5417. begin
  5418.  Result:=0;
  5419.  if Assigned(FShellLink) then begin
  5420.   FResult:=FShellLink.GetHotKey(Result);
  5421.   RunError(SShellLinkReadError);
  5422.  end;
  5423. end;
  5424.  
  5425. function TShellLink.GetIconIndex: Integer;
  5426. var
  5427.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  5428. begin
  5429.  Result:=-1;
  5430.  if Assigned(FShellLink) then begin
  5431.   FResult:=FShellLink.GetIconLocation(@Buf[0], MAX_PATH, Result);
  5432.   RunError(SShellLinkReadError);
  5433.  end;
  5434. end;
  5435.  
  5436. function TShellLink.GetIconLoc: TString;
  5437. var
  5438.  Dummy: Integer;
  5439.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  5440. begin
  5441.  Result:='';
  5442.  if Assigned(FShellLink) then begin
  5443.   FResult:=FShellLink.GetIconLocation(@Buf[0], MAX_PATH, Dummy);
  5444.   RunError(SShellLinkReadError);
  5445.   Result:=PChar(@Buf[0]);
  5446.  end;
  5447. end;
  5448.  
  5449. function TShellLink.GetPath: TString;
  5450. var
  5451.  Dummy: TWin32FindData;
  5452.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  5453. begin
  5454.  Result:='';
  5455.  if Assigned(FShellLink) then begin
  5456.   FResult:=FShellLink.GetPath(@Buf[0], MAX_PATH, Dummy, SLGP_UNCPRIORITY);
  5457.   RunError(SShellLinkReadError);
  5458.   Result:=PChar(@Buf[0]);
  5459.  end;
  5460. end;
  5461.  
  5462. function TShellLink.GetPIDL: PItemIDList;
  5463. begin
  5464.  Result:=nil;
  5465.  if Assigned(FShellLink) then begin
  5466.   FResult:=FShellLink.GetIDList(Result);
  5467.   RunError(SShellLinkReadError);
  5468.  end;
  5469. end;
  5470.  
  5471. function TShellLink.GetShowCmd: Integer;
  5472. begin
  5473.  Result:=-1;
  5474.  if Assigned(FShellLink) then begin
  5475.   FResult:=FShellLink.GetShowCmd(Result);
  5476.   RunError(SShellLinkReadError);
  5477.  end;
  5478. end;
  5479.  
  5480. function TShellLink.GetWorkDir: TString;
  5481. var
  5482.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  5483. begin
  5484.  Result:='';
  5485.  if Assigned(FShellLink) then begin
  5486.   FResult:=FShellLink.GetWorkingDirectory(@Buf[0], MAX_PATH);
  5487.   RunError(SShellLinkReadError);
  5488.   Result:=PChar(@Buf[0]);
  5489.  end;
  5490. end;
  5491.  
  5492. function TShellLink.LoadFromFile(FileName: TString): Boolean;
  5493. begin
  5494.  if Assigned(FPersistFile) then begin
  5495.   FResult:=FPersistFile.Load(ResolveFileName(FileName),  OF_READWRITE);
  5496.   RunError(SShellLinkLoadError, FileName);
  5497.  end;
  5498.  Result:=True;
  5499. end;
  5500.  
  5501. function TShellLink.MyDocsFolder: TString;
  5502. begin
  5503.  if IsEmptyStr(FMyDocsFolder) then
  5504.   FMyDocsFolder:=IncludeTrailingBackSlash(SpecialFolder(CSIDL_PERSONAL));
  5505.  Result:=FMyDocsFolder;
  5506. end;
  5507.  
  5508. function TShellLink.ProgramsFolder: TString;
  5509. begin
  5510.  if IsEmptyStr(FProgramsFolder) then
  5511.   FProgramsFolder:=IncludeTrailingBackslash(SpecialFolder(CSIDL_PROGRAMS));
  5512.  Result:=FProgramsFolder;
  5513. end;
  5514.  
  5515.  
  5516. type
  5517.   TFuncStrObj = function: TString of object;
  5518.  
  5519. function TShellLink.ResolveFileName(FileName: TString): PWideChar;
  5520. var
  5521.  P: Integer;
  5522.  
  5523.  function Resolve(Str: TString; F: TFuncStrObj): Boolean;
  5524.  begin
  5525.   Result:=True;
  5526.   P:=Pos(Str, DnString(FileName));
  5527.   if P = 1 then begin
  5528.    Delete(FileName, 1, Length(Str));
  5529.    if FileName[1] = '\' then Delete(FileName, 1, 1);
  5530.    FileName:=F+FileName;
  5531.    Result:=False;
  5532.   end;
  5533.  end;
  5534.  
  5535. begin
  5536.  if Resolve('{$desktop}', DesktopFolder) then
  5537.  if Resolve('{$programs}', ProgramsFolder) then
  5538.  if Resolve('{$startmenu}', StartMenuFolder) then
  5539.  if Resolve('{$startup}', StartUpFolder) then Resolve('{$mydocs}', MyDocsFolder);
  5540.  FTemp:=FileName;
  5541.  Result:=PWideChar(@FTemp[1]);
  5542. end;
  5543.  
  5544. procedure TShellLink.RunError(const Msg, Args: TString);
  5545. begin
  5546.  if Failed(FResult) then begin
  5547.   FResult:=0;
  5548.   if Args<>'' then raise EShellLinkError.CreateFmt(Msg,[Args])
  5549.               else raise EShellLinkError.Create(Msg);
  5550.  end;
  5551. end;
  5552.  
  5553. function TShellLink.SaveToFile(FileName: TString): Boolean;
  5554. begin
  5555.  if Assigned(FPersistFile) then begin
  5556.   FResult:=FPersistFile.Save(ResolveFileName(FileName), True);
  5557.   RunError(SShellLinkSaveError, FileName);
  5558.  end;
  5559.  Result:=True;
  5560. end;
  5561.  
  5562. procedure TShellLink.SetArguments(const Value: TString);
  5563. begin
  5564.  if Assigned(FShellLink) then begin
  5565.   FResult:=FShellLink.SetArguments(PAnsiChar(Value));
  5566.   RunError(SShellLinkWriteError);
  5567.  end;
  5568. end;
  5569.  
  5570. procedure TShellLink.SetDescription(const Value: TString);
  5571. begin
  5572.  if Assigned(FShellLink) then begin
  5573.   FResult:=FShellLink.SetDescription(PAnsiChar(Value));
  5574.   RunError(SShellLinkWriteError);
  5575.  end;
  5576. end;
  5577.  
  5578. procedure TShellLink.SetHotKey(const Value: Word);
  5579. begin
  5580.  if Assigned(FShellLink) then begin
  5581.   FResult:=FShellLink.SetHotKey(Value);
  5582.   RunError(SShellLinkWriteError);
  5583.  end;
  5584. end;
  5585.  
  5586. procedure TShellLink.SetIconIndex(const Value: Integer);
  5587. var
  5588.  OldIndex:Integer;
  5589.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  5590. begin
  5591.  if Assigned(FShellLink) then begin
  5592.   FResult:=FShellLink.GetIconLocation(@Buf[0], MAX_PATH, OldIndex);
  5593.   RunError(SShellLinkWriteError);
  5594.   FResult:=FShellLink.SetIconLocation(@Buf[0], Value);
  5595.   RunError(SShellLinkWriteError);
  5596.  end;
  5597. end;
  5598.  
  5599. procedure TShellLink.SetIconLoc(const Value: TString);
  5600. var
  5601.  Index:Integer;
  5602.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  5603. begin
  5604.  if Assigned(FShellLink) then begin
  5605.   FResult:=FShellLink.GetIconLocation(@Buf[0], MAX_PATH, Index);
  5606.   RunError(SShellLinkWriteError);
  5607.   FResult:=FShellLink.SetIconLocation(PAnsiChar(Value),Index);
  5608.   RunError(SShellLinkWriteError);
  5609.  end;
  5610. end;
  5611.  
  5612. procedure TShellLink.SetPath(const Value: TString);
  5613. begin
  5614.  if Assigned(FShellLink) then begin
  5615.   FResult:=FShellLink.SetPath(PChar(Value));
  5616.   RunError(SShellLinkWriteError);
  5617.  end;
  5618. end;
  5619.  
  5620. procedure TShellLink.SetPIDL(const Value: PItemIDList);
  5621. begin
  5622.  if Assigned(FShellLink) then begin
  5623.   FResult:=FShellLink.SetIDList(Value);
  5624.   RunError(SShellLinkWriteError);
  5625.  end;
  5626. end;
  5627.  
  5628. procedure TShellLink.SetShowCmd(const Value: Integer);
  5629. begin
  5630.  if Assigned(FShellLink) then begin
  5631.   FResult:=FShellLink.SetShowCmd(Value);
  5632.   RunError(SShellLinkWriteError);
  5633.  end;
  5634. end;
  5635.  
  5636. procedure TShellLink.SetWorkDir(const Value: TString);
  5637. begin
  5638.  if Assigned(FShellLink) then begin
  5639.   FResult:=FShellLink.SetWorkingDirectory(PChar(Value));
  5640.   RunError(SShellLinkWriteError);
  5641.  end;
  5642. end;
  5643.  
  5644. class function TShellLink.SpecialFolder(FolderID: Integer): TString;
  5645. var
  5646.  PIDL:PItemIDList;
  5647.  Buf: array [0..MAX_PATH-1] of AnsiChar;
  5648. begin
  5649.  SHGetSpecialFolderLocation(0, FolderID, PIDL);
  5650.  SHGetPathFromIDList(PIDL, @Buf[0]);
  5651.  Result:=PChar(@Buf[0]);
  5652. end;
  5653.  
  5654. function TShellLink.StartMenuFolder: TString;
  5655. begin
  5656.  if IsEmptyStr(FStartMenuFolder) then
  5657.   FStartMenuFolder:=IncludeTrailingBackslash(SpecialFolder(CSIDL_STARTMENU));
  5658.  Result:=FStartMenuFolder;
  5659. end;
  5660.  
  5661. function TShellLink.StartUpFolder: TString;
  5662. begin
  5663.  if IsEmptyStr(FStartUpFolder) then
  5664.   FStartUpFolder:=IncludeTrailingBackslash(SpecialFolder(CSIDL_STARTUP));
  5665.  Result:=FStartUpFolder;
  5666. end;
  5667.  
  5668. { TDynamicArray }
  5669.  
  5670. function TDynamicArray.Add: Integer;
  5671. asm
  5672.    mov   edx, [eax].FCount
  5673.    push  edx
  5674.    call  TDynamicArray.Insert
  5675.    pop   eax
  5676. end;
  5677.  
  5678. function TDynamicArray.AddItem(const Item): Integer;
  5679. asm
  5680.    push  esi
  5681.    push  edi
  5682.    push  ebx
  5683.    mov   esi, eax
  5684.    mov   edi, edx
  5685.    call  TDynamicArray.Add
  5686.    mov   ebx, eax
  5687.    mov   edx, ebx
  5688.    mov   ecx, edi
  5689.    mov   eax, esi
  5690.    call  TDynamicArray.PutItem
  5691.    mov   eax, ebx
  5692.    pop   ebx
  5693.    pop   edi
  5694.    pop   esi
  5695. end;
  5696.  
  5697. function TDynamicArray.AllocMem(ACount: Cardinal; var Handle: hLocal): pointer;
  5698. asm
  5699.    push  edi
  5700.    mov   edi, ecx
  5701.    mov   eax, [eax].FItemSize
  5702.    imul  edx
  5703.    push  edi
  5704.    push  eax
  5705.    push  LHND
  5706.    call  LocalAlloc
  5707.    pop   edi
  5708.    mov   [edi], eax
  5709.    push  eax
  5710.    call  LocalLock
  5711.    pop   edi
  5712. end;
  5713.  
  5714. constructor TDynamicArray.Create(ACount, AItemSize: Cardinal);
  5715. begin
  5716.  inherited Create;
  5717.  FItemSize:=AItemSize;
  5718.  _SetCount(ACount);
  5719. end;
  5720.  
  5721. procedure TDynamicArray.Delete(Index: Integer);
  5722. var
  5723.    thx: LongInt;
  5724. asm
  5725.    mov   ecx, [eax].FCount
  5726.    test  ecx, ecx
  5727.    jz    @@10
  5728.    cmp   edx, ecx
  5729.    jge   @@10
  5730.    test  edx, edx
  5731.    jl    @@10
  5732.    push  esi
  5733.    push  edi
  5734.    push  ebx
  5735.    mov   esi, eax
  5736.    mov   ebx, edx
  5737.    mov   edx, [esi].FCount
  5738.    dec   edx
  5739.    lea   ecx, thx
  5740.    call  TDynamicArray.AllocMem
  5741.    mov   edi, eax
  5742.    mov   eax, [esi].FItemSize
  5743.    mov   ecx, ebx
  5744.    imul  ecx
  5745.    mov   ecx, eax
  5746.    mov   edx, edi
  5747.    mov   eax, [esi].FData
  5748.    call  MoveMem
  5749.    mov   eax, esi
  5750.    mov   edx, ebx
  5751.    inc   edx
  5752.    call  TDynamicArray.GetItemPtr
  5753.    push  eax
  5754.    mov   eax, [esi].FCount
  5755.    sub   eax, ebx
  5756.    dec   eax
  5757.    mov   edx, [esi].FItemSize
  5758.    push  edx
  5759.    imul  edx
  5760.    mov   ecx, eax
  5761.    mov   eax, ebx
  5762.    pop   edx
  5763.    imul  edx
  5764.    add   eax, edi
  5765.    mov   edx, eax
  5766.    pop   eax
  5767.    call  MoveMem
  5768.    mov   eax, esi
  5769.    lea   edx, [esi].FHandle
  5770.    call  TDynamicArray.FreeMem
  5771.    mov   [esi].FData, edi
  5772.    mov   eax, thx
  5773.    mov   [esi].FHandle, eax
  5774.    dec   dword ptr [esi].FCount
  5775.    mov   eax, esi
  5776.    call  TDynamicArray.DoSizeChanged
  5777.    pop   ebx
  5778.    pop   edi
  5779.    pop   esi
  5780.    jmp   @@20
  5781. @@10:
  5782.    call  TDynamicArray.Error
  5783. @@20:
  5784. end;
  5785.  
  5786. procedure TDynamicArray.DeleteItem(Index: Integer; out Item);
  5787. asm
  5788.    push   esi
  5789.    push   ebx
  5790.    mov    esi, eax
  5791.    mov    ebx, edx
  5792.    call   TDynamicArray.GetItem
  5793.    mov    eax, esi
  5794.    mov    edx, ebx
  5795.    call   TDynamicArray.Delete
  5796.    pop    ebx
  5797.    pop    esi
  5798. end;
  5799.  
  5800. destructor TDynamicArray.Destroy;
  5801. begin
  5802.  _SetCount(0);
  5803.  inherited;
  5804. end;
  5805.  
  5806. procedure TDynamicArray.DoSizeChanged;
  5807. begin
  5808.  SizeChanged;
  5809. end;
  5810.  
  5811. procedure TDynamicArray.Error(Index: Integer);
  5812. begin
  5813.   raise EDynArray.CreateFmt(SDynArrayIndexError,[ClassName, Index]);
  5814. end;
  5815.  
  5816. procedure TDynamicArray.Extend(Count: Cardinal);
  5817. asm
  5818.    add   edx, [eax].FCount
  5819.    call  TDynamicArray._SetCount
  5820. end;
  5821.  
  5822. function TDynamicArray.ForEach(Tag: Integer; ForEachFunc: TForEachFunc): Integer;
  5823. var
  5824.    _Tag: LongInt;
  5825.    _Size: LongInt;
  5826.    _Count: LongInt;
  5827. asm
  5828.    push  esi
  5829.    push  edi
  5830.    push  ebx
  5831.    mov   esi, [eax].FData
  5832.    mov   edi, ecx
  5833.    mov   ebx, [eax].FCount
  5834.    mov   ecx, [eax].FItemSize
  5835.    mov   _Size, ecx
  5836.    mov   _Tag,  edx
  5837.    mov   _Count, ebx
  5838.    sub   esi, _Size
  5839.    test  ebx, ebx
  5840. @@10:
  5841.    jle    @@20
  5842.    add   esi, _Size
  5843.    mov   eax, _Tag
  5844.    mov   edx, _Count
  5845.    sub   edx, ebx
  5846.    mov   ecx, esi
  5847.    call  edi
  5848.    test  eax, eax
  5849.    jnz   @@30
  5850.    dec   ebx
  5851.    jmp   @@10
  5852. @@20:
  5853.    xor   eax, eax
  5854. @@30:
  5855.    pop   ebx
  5856.    pop   edi
  5857.    pop   esi
  5858. end;
  5859.  
  5860. procedure TDynamicArray.FreeMem(var Handle: hLocal);
  5861. asm
  5862.    push  esi
  5863.    mov   esi, edx
  5864.    mov   eax, [esi]
  5865.    test  eax, eax
  5866.    jz    @@10
  5867.    push  eax
  5868.    push  eax
  5869.    call  LocalUnlock
  5870.    call  LocalFree
  5871.    xor   eax, eax
  5872.    mov   [esi], eax
  5873. @@10:
  5874.    pop   esi
  5875. end;
  5876.  
  5877. function TDynamicArray.GetFirstItem: Pointer;
  5878. asm
  5879.    mov   eax, [eax].FData
  5880. end;
  5881.  
  5882. procedure TDynamicArray.GetItem(Index: Integer; out Item);
  5883. asm
  5884.    push   esi
  5885.    push   edi
  5886.    push   ebx
  5887.    mov    esi, eax
  5888.    mov    edi, ecx
  5889.    mov    ebx, edx
  5890.    call   TDynamicArray.GetItemPtr
  5891.    test   eax, eax
  5892.    jnz    @@10
  5893.    mov    eax, esi
  5894.    mov    edx, ebx
  5895.    pop    ebx
  5896.    pop    edi
  5897.    pop    esi
  5898.    call   TDynamicArray.Error
  5899.    ret
  5900. @@10:
  5901.    mov    ecx, [esi].FItemSize
  5902.    mov    edx, edi
  5903.    call   MoveMem
  5904.    pop    ebx
  5905.    pop    edi
  5906.    pop    esi
  5907. end;
  5908.  
  5909. function TDynamicArray.GetItemPtr(Index: Integer): Pointer;
  5910. asm
  5911.    mov   ecx, [eax].FCount
  5912.    test  ecx, ecx
  5913.    jz    @@10
  5914.    test  edx, edx
  5915.    jl    @@10
  5916.    cmp   edx, ecx
  5917.    jge   @@10
  5918.    mov   ecx, [eax].FData
  5919.    mov   eax, [eax].FItemSize
  5920.    xchg  eax, edx
  5921.    imul  edx
  5922.    add   eax, ecx
  5923.    ret
  5924. @@10:
  5925.    xor   eax, eax
  5926. end;
  5927.  
  5928. procedure TDynamicArray.Insert(Index: Integer);
  5929. var
  5930.    thx: LongInt;
  5931. asm
  5932.    mov    ecx, [eax].FCount
  5933.    cmp    edx, ecx
  5934.    jg     @@10
  5935.    test   edx, edx
  5936.    jl     @@10
  5937.    push   esi
  5938.    push   edi
  5939.    push   ebx
  5940.    mov    esi, eax
  5941.    mov    ebx, edx
  5942.    mov    edx, [esi].FCount
  5943.    inc    edx
  5944.    lea    ecx, thx
  5945.    call   TDynamicArray.AllocMem
  5946.    mov    edi, eax
  5947.    mov    eax, [esi].FItemSize
  5948.    mov    ecx, ebx
  5949.    imul   ecx
  5950.    mov    ecx, eax
  5951.    mov    edx, edi
  5952.    mov    eax, [esi].FData
  5953.    call   MoveMem
  5954.    mov    eax, esi
  5955.    mov    edx, ebx
  5956.    call   TDynamicArray.GetItemPtr
  5957.    push   eax
  5958.    mov    eax, [esi].FCount
  5959.    sub    eax, ebx
  5960.    mov    edx, [esi].FItemSize
  5961.    push   edx
  5962.    imul   edx
  5963.    mov    ecx, eax
  5964.    mov    eax, ebx
  5965.    inc    eax
  5966.    pop    edx
  5967.    imul   edx
  5968.    add    eax, edi
  5969.    mov    edx, eax
  5970.    pop    eax
  5971.    call   MoveMem
  5972.    mov    eax, esi
  5973.    lea    edx, [esi].FHandle
  5974.    call   TDynamicArray.FreeMem
  5975.    mov    [esi].FData, edi
  5976.    mov    eax, thx
  5977.    mov    [esi].FHandle, eax
  5978.    inc    dword ptr [esi].FCount
  5979.    mov    eax, esi
  5980.    call   TDynamicArray.DoSizeChanged
  5981.    pop    ebx
  5982.    pop    edi
  5983.    pop    esi
  5984.    jmp    @@20
  5985. @@10:
  5986.    call   TDynamicArray.Error
  5987. @@20:
  5988. end;
  5989.  
  5990. procedure TDynamicArray.InsertItem(Index: Integer; const Item);
  5991. asm
  5992.    push   esi
  5993.    push   edi
  5994.    push   ebx
  5995.    mov    esi, eax
  5996.    mov    edi, ecx
  5997.    mov    ebx, edx
  5998.    call   TDynamicArray.Insert
  5999.    mov    eax, esi
  6000.    mov    ecx, edi
  6001.    mov    edx, ebx
  6002.    call   TDynamicArray.PutItem
  6003.    pop    ebx
  6004.    pop    edi
  6005.    pop    esi
  6006. end;
  6007.  
  6008. procedure TDynamicArray.PutItem(Index: Integer; const Item);
  6009. asm
  6010.    push   esi
  6011.    push   edi
  6012.    push   ebx
  6013.    mov    esi, eax
  6014.    mov    edi, ecx
  6015.    mov    ebx, edx
  6016.    call   TDynamicArray.GetItemPtr
  6017.    test   eax, eax
  6018.    jnz    @@10
  6019.    mov    eax, esi
  6020.    mov    edx, ebx
  6021.    pop    ebx
  6022.    pop    edi
  6023.    pop    esi
  6024.    call   TDynamicArray.Error
  6025.    ret
  6026. @@10:
  6027.    mov    ecx, [esi].FItemSize
  6028.    mov    edx, edi
  6029.    xchg   eax, edx
  6030.    call   MoveMem
  6031.    pop    ebx
  6032.    pop    edi
  6033.    pop    esi
  6034. end;
  6035.  
  6036. procedure TDynamicArray.SetCount(const Value: Cardinal);
  6037. var
  6038.  THX, TDX: LongInt;
  6039. asm
  6040.    test  edx, edx
  6041.    jg    @@10
  6042.    mov   [eax].FCount, 0
  6043.    lea   edx, [eax].FHandle
  6044.    call  TDynamicArray.FreeMem
  6045.    jmp   @@30
  6046. @@10:
  6047.    cmp   edx, [eax].FCount
  6048.    je    @@30
  6049.    push  esi
  6050.    push  edi
  6051.    mov   esi, eax
  6052.    mov   edi, edx
  6053.    lea   ecx, thx
  6054.    call  TDynamicArray.AllocMem
  6055.    mov   tdx, eax
  6056.    mov   ecx, [esi].FCount
  6057.    mov   edx, edi
  6058.    cmp   edx, ecx
  6059.    jl    @@20
  6060.    mov   edx, ecx
  6061. @@20:
  6062.    mov   eax, edx
  6063.    mov   edx, [esi].FItemSize
  6064.    imul  edx
  6065.    mov   ecx, eax
  6066.    mov   edx, tdx
  6067.    mov   eax, [esi].FData
  6068.    call  MoveMem
  6069.    mov   eax, tdx
  6070.    mov   [esi].FData, eax
  6071.    lea   edx, [esi].FHandle
  6072.    mov   eax, esi
  6073.    call  TDynamicArray.FreeMem
  6074.    mov   eax, thx
  6075.    mov   [esi].FHandle, eax
  6076.    mov   [esi].FCount, edi
  6077.    mov   eax, esi
  6078.    call  TDynamicArray.DoSizeChanged
  6079.    pop   edi
  6080.    pop   esi
  6081. @@30:
  6082. end;
  6083.  
  6084. procedure TDynamicArray.SizeChanged;
  6085. begin
  6086.  
  6087. end;
  6088.  
  6089. procedure TDynamicArray.Swap(Index1, Index2: Cardinal);
  6090. var
  6091.    thx, tdx: LongInt;
  6092. asm
  6093.    push  esi
  6094.    push  edi
  6095.    push  ebx
  6096.    mov   ebx, eax
  6097.    mov   esi, edx
  6098.    mov   edi, ecx
  6099.    mov   edx, 1
  6100.    lea   ecx, thx
  6101.    call  TDynamicArray.AllocMem
  6102.    mov   tdx, eax
  6103.    mov   eax, ebx
  6104.    mov   edx, esi
  6105.    call  TDynamicArray.GetItemPtr
  6106.    mov   edx, esi
  6107.    test  eax, eax
  6108.    jz    @@10
  6109.    mov   esi, eax
  6110.    mov   edx, tdx
  6111.    mov   ecx, [ebx].FItemSize
  6112.    call  MoveMem
  6113.    mov   eax, ebx
  6114.    mov   edx, edi
  6115.    call  TDynamicArray.GetItemPtr
  6116.    mov   edx, edi
  6117.    test  eax, eax
  6118.    jz    @@10
  6119.    mov   edi, eax
  6120.    mov   edx, esi
  6121.    mov   ecx, [ebx].FItemSize
  6122.    call  MoveMem
  6123.    mov   eax, tdx
  6124.    mov   edx, edi
  6125.    mov   ecx, [ebx].FItemSize
  6126.    call  MoveMem
  6127.    mov   eax, ebx
  6128.    lea   edx, thx
  6129.    call  TDynamicArray.FreeMem
  6130.    pop   ebx
  6131.    pop   edi
  6132.    pop   esi
  6133.    jmp   @@20
  6134. @@10:
  6135.    mov   eax, ebx
  6136.    push  eax
  6137.    push  edx
  6138.    lea   edx, thx
  6139.    call  TDynamicArray.FreeMem
  6140.    pop   edx
  6141.    pop   eax
  6142.    pop   ebx
  6143.    pop   edi
  6144.    pop   esi
  6145.    call  TDynamicArray.Error
  6146. @@20:
  6147. end;
  6148.  
  6149. procedure TDynamicArray.Trim(Count: Cardinal);
  6150. asm
  6151.    mov    ecx, edx
  6152.    mov    edx, [eax].FCount
  6153.    sub    edx, ecx
  6154.    call   TDynamicArray._SetCount
  6155. end;
  6156.  
  6157. procedure TDynamicArray._SetCount(const Value: Cardinal);
  6158. begin
  6159.  SetCount(Value);
  6160. end;
  6161.  
  6162. { TFile }
  6163.  
  6164. procedure TFile.Close;
  6165. begin
  6166.  Free;
  6167. end;
  6168.  
  6169. constructor TFile.Create(AFileName: TString; Backup: Boolean);
  6170. begin
  6171.  FStatus:=fsWriting;
  6172.  inherited Create;
  6173.  FFileName:=AFileName;
  6174.  if Backup and FileExists(FFileName) then CreateBackup;
  6175.  FHandle:=CreateFile(PChar(FFileName), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
  6176.   FILE_ATTRIBUTE_NORMAL, 0);
  6177.  if FHandle = INVALID_HANDLE_VALUE then Error(GetLastError);
  6178. end;
  6179.  
  6180. procedure TFile.CreateBackup;
  6181. var
  6182.  BackupName: TString;
  6183.  Ext: TString;
  6184. begin
  6185.  BackupName:=FFileName;
  6186.  Ext:=ExtractFileExt(BackupName);
  6187.  BackupName:=TrailTrim(BackupName, Length(Ext));
  6188.  Delete(Ext, 1, 1);
  6189.  BackupName:=BackupName+'.~'+Ext;
  6190.  if FileExists(BackupName) then DeleteFile(BackupName);
  6191.  if not RenameFile(FFileName, BackupName) then Error(GetLastError)
  6192. end;
  6193.  
  6194. class function TFile.EncodeDateTime(Year, Month, Day, Hour, Min,
  6195.   Sec: Word): TFileTime;
  6196. var
  6197.  LT: TFileTime;
  6198.  ST: TSystemTime;
  6199. begin
  6200.  ST.wYear:=Year;
  6201.  ST.wMonth:=Month;
  6202.  ST.wDayOfWeek:=0;
  6203.  ST.wDay:=Day;
  6204.  ST.wHour:=Hour;
  6205.  ST.wMinute:=Min;
  6206.  ST.wSecond:=Sec;
  6207.  ST.wMilliseconds:=0;
  6208.  SystemTimeToFileTime(ST, LT);
  6209.  LocalFileTimeToFileTime(LT, Result);
  6210. end;
  6211.  
  6212. destructor TFile.Destroy;
  6213. begin
  6214.  CloseHandle(FHandle);
  6215.  inherited;
  6216. end;
  6217.  
  6218. procedure TFile.Error(Code: Integer);
  6219. const
  6220.  strFileStatus : array[TFileStatus] of TString = (SFileReading, SFileWriting);
  6221. begin
  6222.  if Code<>0 then raise EFileError.CreateFmt(SFileError,
  6223.   [strFileStatus[FStatus], FFileName, GetErrorMessage(Code)]);
  6224. end;
  6225.  
  6226. class procedure TFile.DecodeDateTime(const DateTime: TFileTime; Year,
  6227.   Month, Day, Hour, Min, Sec: PWord);
  6228. var
  6229.  LT: TFileTime;
  6230.  ST: TSystemTime;
  6231. begin
  6232.  FileTimeToLocalFileTime(DateTime, LT);
  6233.  FileTimeToSystemTime(LT, ST);
  6234.  SetWordValue(Year, ST.wYear);
  6235.  SetWordValue(Month, ST.wMonth);
  6236.  SetWordValue(Day, ST.wDay);
  6237.  SetWordValue(Hour, ST.wHour);
  6238.  SetWordValue(Min, ST.wMinute);
  6239.  SetWordValue(Sec, ST.wSecond);
  6240. end;
  6241.  
  6242. function TFile.GetAttributes: LongInt;
  6243. begin
  6244.  Result:=GetFileAttributes(PChar(FFileName));
  6245.  if Result = LongInt($FFFFFFFF) then Error(GetLastError);
  6246. end;
  6247.  
  6248. function TFile.GetCreationTime: TFileTime;
  6249. begin
  6250.  if not GetFileTime(FHandle, @Result, nil, nil) then Error(GetLastError);
  6251. end;
  6252.  
  6253. function TFile.GetErrorMessage(Code: Integer): TString;
  6254. begin
  6255.  case Code of
  6256.   2: Result:=SFileError002;
  6257.   3: Result:=SFileError003;
  6258.   4: Result:=SFileError004;
  6259.   5: Result:=SFileError005;
  6260.   14: Result:=SFileError014;
  6261.   15: Result:=SFileError015;
  6262.   17: Result:=SFileError017;
  6263.   19: Result:=SFileError019;
  6264.   20: Result:=SFileError020;
  6265.   21: Result:=SFileError021;
  6266.   22: Result:=SFileError022;
  6267.   25: Result:=SFileError025;
  6268.   26: Result:=SFileError026;
  6269.   27: Result:=SFileError027;
  6270.   29: Result:=SFileError029;
  6271.   30: Result:=SFileError030;
  6272.   32: Result:=SFileError032;
  6273.   36: Result:=SFileError036;
  6274.   38: Result:=SFileError038;
  6275.   39: Result:=SFileError039;
  6276.   50: Result:=SFileError050;
  6277.   51: Result:=SFileError051;
  6278.   52: Result:=SFileError052;
  6279.   53: Result:=SFileError053;
  6280.   54: Result:=SFileError054;
  6281.   55: Result:=SFileError055;
  6282.   57: Result:=SFileError057;
  6283.   58: Result:=SFileError058;
  6284.   59: Result:=SFileError059;
  6285.   64: Result:=SFileError064;
  6286.   65: Result:=SFileError065;
  6287.   66: Result:=SFileError066;
  6288.   67: Result:=SFileError067;
  6289.   70: Result:=SFileError070;
  6290.   82: Result:=SFileError082;
  6291.   112: Result:=SFileError112;
  6292.   123: Result:=SFileError123;
  6293.   161: Result:=SFileError161;
  6294.   183: Result:=SFileError183;
  6295.   else Result:='';
  6296.  end;
  6297. end;
  6298.  
  6299. function TFile.GetLastAccessTime: TFileTime;
  6300. begin
  6301.  if not GetFileTime(FHandle, nil, @Result, nil) then Error(GetLastError);
  6302. end;
  6303.  
  6304. function TFile.GetLastWriteTime: TFileTime;
  6305. begin
  6306.  if not GetFileTime(FHandle, nil, nil, @Result) then Error(GetLastError);
  6307. end;
  6308.  
  6309. function TFile.GetSize: Integer;
  6310. begin
  6311.  Result:=GetFileSize(FHandle, nil);
  6312.  if Result = -1 then Error(GetLastError);
  6313. end;
  6314.  
  6315. constructor TFile.Open(AFileName: TString);
  6316. begin
  6317.  inherited Create;
  6318.  FStatus:=fsReading;
  6319.  FFileName:=AFileName;
  6320.  FHandle:=CreateFile(PChar(FFileName), GENERIC_READ, 0, nil, OPEN_EXISTING,
  6321.   FILE_ATTRIBUTE_NORMAL, 0);
  6322.  if FHandle = INVALID_HANDLE_VALUE then Error(GetLastError);
  6323. end;
  6324.  
  6325. procedure TFile.Read(var Buffer; Size: Integer);
  6326. begin
  6327.  if FStatus = fsReading then begin
  6328.   if not ReadFile(FHandle, Buffer, Cardinal(Size), FDummy, nil)
  6329.    then Error(GetLastError);
  6330.  end;
  6331. end;
  6332.  
  6333. procedure TFile.Seek(Position: Integer);
  6334. begin
  6335.  SetFilePointer(FHandle, Position, nil, FILE_BEGIN);
  6336.  Error(GetLastError);
  6337. end;
  6338.  
  6339. procedure TFile.SetAttributes(const Value: LongInt);
  6340. begin
  6341.  if not SetFileAttributes(PChar(FFileName), Value) then Error(GetLastError);
  6342. end;
  6343.  
  6344. procedure TFile.SetCreationTime(const Value: TFileTime);
  6345. begin
  6346.  if not SetFileTime(FHandle, @Value, nil, nil) then Error(GetLastError);
  6347. end;
  6348.  
  6349. procedure TFile.SetLastAccessTime(const Value: TFileTime);
  6350. begin
  6351.  if not SetFileTime(FHandle, nil, @Value, nil) then Error(GetLastError);
  6352. end;
  6353.  
  6354. procedure TFile.SetLastWriteTime(const Value: TFileTime);
  6355. begin
  6356.  if not SetFileTime(FHandle, nil, nil, @Value) then Error(GetLastError);
  6357. end;
  6358.  
  6359. procedure TFile.UserError(Code: Integer);
  6360. begin
  6361.  Error(Code);
  6362. end;
  6363.  
  6364. procedure TFile.Write(const Buffer; Size: Integer);
  6365. begin
  6366.  if FStatus = fsWriting then begin
  6367.   if not WriteFile(FHandle, Buffer, Cardinal(Size), FDummy, nil)
  6368.    then Error(GetLastError);
  6369.  end;
  6370. end;
  6371.  
  6372. { TFileStrm }
  6373.  
  6374. procedure TFileStrm.Close;
  6375. begin
  6376.  Free;
  6377. end;
  6378.  
  6379. constructor TFileStrm.Create(AFileName: TString; Backup: Boolean);
  6380. begin
  6381.  FStatus:=fsWriting;
  6382.  inherited Create;
  6383.  FFileName:=AFileName;
  6384.  if Backup and FileExists(FFileName) then CreateBackup;
  6385.  FHandle:=CreateFile(PChar(FFileName), GENERIC_WRITE, 0, nil, CREATE_ALWAYS,
  6386.   FILE_ATTRIBUTE_NORMAL, 0);
  6387.  if FHandle = INVALID_HANDLE_VALUE then Error(GetLastError);
  6388. end;
  6389.  
  6390. procedure TFileStrm.CreateBackup;
  6391. var
  6392.  BackupName: TString;
  6393.  Ext: TString;
  6394. begin
  6395.  BackupName:=FFileName;
  6396.  Ext:=ExtractFileExt(BackupName);
  6397.  BackupName:=TrailTrim(BackupName, Length(Ext));
  6398.  Delete(Ext, 1, 1);
  6399.  BackupName:=BackupName+'.~'+Ext;
  6400.  if FileExists(BackupName) then DeleteFile(BackupName);
  6401.  if not RenameFile(FFileName, BackupName) then Error(GetLastError)
  6402. end;
  6403.  
  6404. class procedure TFileStrm.DecodeDateTime(const DateTime: TFileTime; Year,
  6405.   Month, Day, Hour, Min, Sec: PWord);
  6406. var
  6407.  LT: TFileTime;
  6408.  ST: TSystemTime;
  6409. begin
  6410.  FileTimeToLocalFileTime(DateTime, LT);
  6411.  FileTimeToSystemTime(LT, ST);
  6412.  SetWordValue(Year, ST.wYear);
  6413.  SetWordValue(Month, ST.wMonth);
  6414.  SetWordValue(Day, ST.wDay);
  6415.  SetWordValue(Hour, ST.wHour);
  6416.  SetWordValue(Min, ST.wMinute);
  6417.  SetWordValue(Sec, ST.wSecond);
  6418. end;
  6419.  
  6420. destructor TFileStrm.Destroy;
  6421. begin
  6422.  CloseHandle(FHandle);
  6423.  inherited;
  6424. end;
  6425.  
  6426. class function TFileStrm.EncodeDateTime(Year, Month, Day, Hout, Min,
  6427.   Sec: Word): TFileTime;
  6428. var
  6429.  LT: TFileTime;
  6430.  ST: TSystemTime;
  6431. begin
  6432.  ST.wYear:=Year;
  6433.  ST.wMonth:=Month;
  6434.  ST.wDayOfWeek:=0;
  6435.  ST.wDay:=Day;
  6436.  ST.wHour:=Hour;
  6437.  ST.wMinute:=Min;
  6438.  ST.wSecond:=Sec;
  6439.  ST.wMilliseconds:=0;
  6440.  SystemTimeToFileTime(ST, LT);
  6441.  LocalFileTimeToFileTime(LT, Result);
  6442. end;
  6443.  
  6444. procedure TFileStrm.Error(Code: Integer);
  6445. const
  6446.  strFileStatus : array[TFileStatus] of TString = (SFileReading, SFileWriting);
  6447. begin
  6448.  if Code<>0 then raise EFileError.CreateFmt(SFileError,
  6449.   [strFileStatus[FStatus], FFileName, GetErrorMessage(Code)]);
  6450. end;
  6451.  
  6452. function TFileStrm.GetAttributes: LongInt;
  6453. begin
  6454.  Result:=GetFileAttributes(PChar(FFileName));
  6455.  if Result = LongInt($FFFFFFFF) then Error(GetLastError);
  6456. end;
  6457.  
  6458. function TFileStrm.GetCreationTime: TFileTime;
  6459. begin
  6460.  if not GetFileTime(FHandle, @Result, nil, nil) then Error(GetLastError);
  6461. end;
  6462.  
  6463. function TFileStrm.GetErrorMessage(Code: Integer): TString;
  6464. begin
  6465.  case Code of
  6466.   2: Result:=SFileError002;
  6467.   3: Result:=SFileError003;
  6468.   4: Result:=SFileError004;
  6469.   5: Result:=SFileError005;
  6470.   14: Result:=SFileError014;
  6471.   15: Result:=SFileError015;
  6472.   17: Result:=SFileError017;
  6473.   19: Result:=SFileError019;
  6474.   20: Result:=SFileError020;
  6475.   21: Result:=SFileError021;
  6476.   22: Result:=SFileError022;
  6477.   25: Result:=SFileError025;
  6478.   26: Result:=SFileError026;
  6479.   27: Result:=SFileError027;
  6480.   29: Result:=SFileError029;
  6481.   30: Result:=SFileError030;
  6482.   32: Result:=SFileError032;
  6483.   36: Result:=SFileError036;
  6484.   38: Result:=SFileError038;
  6485.   39: Result:=SFileError039;
  6486.   50: Result:=SFileError050;
  6487.   51: Result:=SFileError051;
  6488.   52: Result:=SFileError052;
  6489.   53: Result:=SFileError053;
  6490.   54: Result:=SFileError054;
  6491.   55: Result:=SFileError055;
  6492.   57: Result:=SFileError057;
  6493.   58: Result:=SFileError058;
  6494.   59: Result:=SFileError059;
  6495.   64: Result:=SFileError064;
  6496.   65: Result:=SFileError065;
  6497.   66: Result:=SFileError066;
  6498.   67: Result:=SFileError067;
  6499.   70: Result:=SFileError070;
  6500.   82: Result:=SFileError082;
  6501.   112: Result:=SFileError112;
  6502.   123: Result:=SFileError123;
  6503.   161: Result:=SFileError161;
  6504.   183: Result:=SFileError183;
  6505.   else Result:='';
  6506.  end;
  6507. end;
  6508.  
  6509. function TFileStrm.GetLastAccessTime: TFileTime;
  6510. begin
  6511.  if not GetFileTime(FHandle, nil, @Result, nil) then Error(GetLastError);
  6512. end;
  6513.  
  6514. function TFileStrm.GetLastWriteTime: TFileTime;
  6515. begin
  6516.  if not GetFileTime(FHandle, nil, nil, @Result) then Error(GetLastError);
  6517. end;
  6518.  
  6519. constructor TFileStrm.Open(AFileName: TString);
  6520. begin
  6521.  inherited Create;
  6522.  FStatus:=fsReading;
  6523.  FFileName:=AFileName;
  6524.  FHandle:=CreateFile(PChar(FFileName), GENERIC_READ, 0, nil, OPEN_EXISTING,
  6525.   FILE_ATTRIBUTE_NORMAL, 0);
  6526.  if FHandle = INVALID_HANDLE_VALUE then Error(GetLastError);
  6527. end;
  6528.  
  6529. function TFileStrm.Read(var Buffer; Count: Integer): LongInt;
  6530. begin
  6531.  if FStatus = fsReading then begin
  6532.   if not ReadFile(FHandle, Buffer, Cardinal(Count), LongWord(Result), nil)
  6533.    then Error(GetLastError);
  6534.  end;
  6535. end;
  6536.  
  6537. function TFileStrm.Seek(Offset: Integer; Origin: Word): LongInt;
  6538. begin
  6539.  Result:=SetFilePointer(FHandle, Position, nil, Origin);
  6540.  Error(GetLastError);
  6541. end;
  6542.  
  6543. procedure TFileStrm.SetAttributes(const Value: LongInt);
  6544. begin
  6545.  if not SetFileAttributes(PChar(FFileName), Value) then Error(GetLastError);
  6546. end;
  6547.  
  6548. procedure TFileStrm.SetCreationTime(const Value: TFileTime);
  6549. begin
  6550.  if not SetFileTime(FHandle, @Value, nil, nil) then Error(GetLastError);
  6551. end;
  6552.  
  6553. procedure TFileStrm.SetLastAccessTime(const Value: TFileTime);
  6554. begin
  6555.  if not SetFileTime(FHandle, nil, @Value, nil) then Error(GetLastError);
  6556. end;
  6557.  
  6558. procedure TFileStrm.SetLastWriteTime(const Value: TFileTime);
  6559. begin
  6560.  if not SetFileTime(FHandle, nil, nil, @Value) then Error(GetLastError);
  6561. end;
  6562.  
  6563. procedure TFileStrm.SetSize(NewSize: LongInt);
  6564. begin
  6565.  raise EFileError.Create(SCannotSetSize);
  6566. end;
  6567.  
  6568. procedure TFileStrm.UserError(Code: Integer);
  6569. begin
  6570.  Error(Code);
  6571. end;
  6572.  
  6573. function TFileStrm.Write(const Buffer; Count: Integer): LongInt;
  6574. begin
  6575.  if FStatus = fsWriting then begin
  6576.   if not WriteFile(FHandle, Buffer, Cardinal(Count), LongWord(Result), nil)
  6577.    then Error(GetLastError);
  6578.  end;
  6579. end;
  6580.  
  6581. { TUnknown }
  6582.  
  6583. function TUnknown.QueryInterface(const IID: TGUID; out Obj): HResult;
  6584. begin
  6585.  if GetInterface(IID, Obj) then Result:=S_OK else Result:=E_NOINTERFACE;
  6586. end;
  6587.  
  6588. function TUnknown.Unknown: IUnknown;
  6589. begin
  6590.  GetInterface(IUnknown, Result);
  6591. end;
  6592.  
  6593. procedure TUnknown.Unknown(out Obj);
  6594. begin
  6595.  GetInterface(IUnknown, Obj);
  6596. end;
  6597.  
  6598. function TUnknown._AddRef: Integer;
  6599. begin
  6600.  Result:=Incr(FRefCount);
  6601. end;
  6602.  
  6603. function TUnknown._Release: Integer;
  6604. begin
  6605.  Result:=Decr(FRefCount);
  6606. end;
  6607.  
  6608. { TMatrixRow }
  6609.  
  6610. constructor TMatrixRow.Create(AColCount: Integer; AMatrix: TMatrix);
  6611. begin
  6612.  FMatrix:=AMatrix;
  6613.  inherited Create(AColCount, FMatrix.FItemSize);
  6614. end;
  6615.  
  6616. { TMatrixRows }
  6617.  
  6618. constructor TMatrixRows.Create(AMatrix: TMatrix);
  6619. begin
  6620.  inherited Create(0, SizeOf(TMatrixRow));
  6621. end;
  6622.  
  6623. procedure TMatrixRows.DeleteCol(Index: Integer);
  6624. begin
  6625.  FColIndex:=Index;
  6626.  ForEach(Integer(Self), @TMatrixRows.DeleteColFunc);
  6627.  Dec(FWidth);
  6628. end;
  6629.  
  6630. function TMatrixRows.DeleteColFunc(Index: Integer;
  6631.   var Row: TMatrixRow): Integer;
  6632. begin
  6633.  Row.Delete(FColIndex);
  6634.  Result:=0;
  6635. end;
  6636.  
  6637. function TMatrixRows.GetRow(Index: Integer): TMatrixRow;
  6638. begin
  6639.  Result:=PMatrixRow(GetItemPtr(Index))^;
  6640. end;
  6641.  
  6642. procedure TMatrixRows.InsertCol(Index: Integer);
  6643. begin
  6644.  FColIndex:=Index;
  6645.  ForEach(Integer(Self), @TMatrixRows.InsertColFunc);
  6646.  Inc(FWidth);
  6647. end;
  6648.  
  6649. function TMatrixRows.InsertColFunc(Index: Integer;
  6650.   var Row: TMatrixRow): Integer;
  6651. begin
  6652.  Row.Insert(FColIndex);
  6653.  Result:=0;
  6654. end;
  6655.  
  6656. procedure TMatrixRows.SetRow(Index: Integer; const Value: TMatrixRow);
  6657. begin
  6658.  PMatrixRow(GetItemPtr(Index))^:=Value;
  6659. end;
  6660.  
  6661. procedure TMatrixRows.SetWidth(const Value: Integer);
  6662. begin
  6663.  FWidth := Value;
  6664.  ForEach(Integer(Self), @TMatrixRows.SetWidthFunc);
  6665. end;
  6666.  
  6667. function TMatrixRows.SetWidthFunc(Index: Integer;
  6668.   var Row: TMatrixRow): Integer;
  6669. begin
  6670.  Row.Count:=FWidth;
  6671.  Result:=0;
  6672. end;
  6673.  
  6674. { TMatrix }
  6675.  
  6676. constructor TMatrix.Create(AColCount, ARowCount, AItemSize: Integer);
  6677. begin
  6678.  inherited Create;
  6679.  FItemSize:=AItemSize;
  6680.  FRows:=TMatrixRows.Create(Self);
  6681.  RowCount:=ARowCount;
  6682.  ColCount:=AColCount;
  6683. end;
  6684.  
  6685. function TMatrix.CreateRow: TMatrixRow;
  6686. begin
  6687.  Result:=TMatrixRow.Create(ColCount, Self);
  6688. end;
  6689.  
  6690. procedure TMatrix.DeleteCol(Index: Integer);
  6691. begin
  6692.  if Inside(Index, 0, FRows.Width - 1)
  6693.   then FRows.DeleteCol(Index)
  6694.   else raise EMatrixError.CreateFmt(SColIndexOutOfRange, [Index]);
  6695. end;
  6696.  
  6697. procedure TMatrix.DeleteRow(Index: Integer);
  6698. begin
  6699.  if Inside(Index, 0, FRows.Count - 1) then begin
  6700.   FRows[Index].Free;
  6701.   FRows.Delete(Index);
  6702.  end else raise EMatrixError.CreateFmt(SRowIndexOutOfRange, [Index]);
  6703. end;
  6704.  
  6705. destructor TMatrix.Destroy;
  6706. begin
  6707.  FRows.Free;
  6708.  inherited;
  6709. end;
  6710.  
  6711. function TMatrix.ForEachRow(Tag: Integer;
  6712.   ForEachRowFunc: TForEachFunc): Integer;
  6713. begin
  6714.  Result:=FRows.ForEach(Tag, ForEachRowFunc);
  6715. end;
  6716.  
  6717. function TMatrix.GetColCount: Integer;
  6718. begin
  6719.  Result:=FRows.Width;
  6720. end;
  6721.  
  6722. procedure TMatrix.GetItem(ACol, ARow: Integer; out Item);
  6723. begin
  6724.  if Inside(ARow, 0, FRows.Count - 1) and Inside(ACol, 0, FRows.FWidth-1)
  6725.   then FRows[ARow].GetItem(ACol, Item)
  6726.   else raise EMatrixError.CreateFmt(SIndicesOutOfRange, [ACol, ARow]);
  6727. end;
  6728.  
  6729. function TMatrix.GetRow(Index: Integer): TMatrixRow;
  6730. begin
  6731.  Result:=FRows[Index];
  6732. end;
  6733.  
  6734. function TMatrix.GetRowCount: Integer;
  6735. begin
  6736.  Result:=FRows.Count;
  6737. end;
  6738.  
  6739. procedure TMatrix.InsertCol(Index: Integer);
  6740. begin
  6741.  if Inside(Index, 0, FRows.Width)
  6742.   then FRows.InsertCol(Index)
  6743.   else raise EMatrixError.CreateFmt(SColIndexOutOfRange, [Index]);
  6744. end;
  6745.  
  6746. procedure TMatrix.InsertRow(Index: Integer);
  6747. var
  6748.  Temp: TMatrixRow;
  6749. begin
  6750.  if Inside(Index, 0, FRows.Count) then begin
  6751.   Temp:=CreateRow;
  6752.   FRows.InsertItem(Index, Temp);
  6753.  end else raise EMatrixError.CreateFmt(SRowIndexOutOfRange, [Index]);
  6754. end;
  6755.  
  6756. procedure TMatrix.PutItem(ACol, ARow: Integer; const Item);
  6757. begin
  6758.  if Inside(ARow, 0, FRows.Count - 1) and Inside(ACol, 0, FRows.FWidth-1)
  6759.   then FRows[ARow].PutItem(ACol, Item)
  6760.   else raise EMatrixError.CreateFmt(SIndicesOutOfRange, [ACol, ARow]);
  6761. end;
  6762.  
  6763. procedure TMatrix.SetColCount(const Value: Integer);
  6764. begin
  6765.  FRows.Width:=Value;
  6766. end;
  6767.  
  6768. procedure TMatrix.SetRowCount(const Value: Integer);
  6769. var
  6770.  OldCount: Integer;
  6771.  i: Integer;
  6772. begin
  6773.  OldCount:=RowCount;
  6774.  if OldCount < Value then begin
  6775.   for i:=OldCount+1 to Value do InsertRow(RowCount);
  6776.  end else if OldCount > Value then begin
  6777.   for i:=OldCount-1 downto Value do DeleteRow(RowCount-1);
  6778.  end;
  6779. end;
  6780.  
  6781. end.
  6782.  
  6783.