home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / nastroje / d23456 / SPLBASE.ZIP / Splbase / Include / SplUnit1.pas < prev   
Pascal/Delphi Source File  |  2001-08-05  |  14KB  |  535 lines
  1. (*********** SplitBase Data Management Systems ***********
  2.  *                                                       *
  3.  *           Copyright (c) 2001 Leon O. Romain           *
  4.  *                                                       *
  5.  *                     leon@kafou.com                    *
  6.  *                                                       *
  7.  *********************************************************)
  8.  
  9. {
  10. This program is free software; you can redistribute it and/or
  11. modify it under the terms of the GNU General Public License
  12. as published by the Free Software Foundation; either version 2
  13. of the License, or (at your option) any later version.
  14.  
  15. This program is distributed in the hope that it will be useful,
  16. but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. GNU General Public License for more details.
  19.  
  20. You should have received a copy of the GNU General Public License
  21. along with this program; if not, write to the Free Software
  22. Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  23. }
  24.  
  25. unit SplUnit1;
  26.  
  27. interface
  28.  
  29. uses
  30.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  31.   StdCtrls;
  32.  
  33. type
  34.   TForm1 = class(TForm)
  35.     GroupBox1: TGroupBox;
  36.     Edit1: TEdit;
  37.     GroupBox2: TGroupBox;
  38.     Edit2: TEdit;
  39.     Button1: TButton;
  40.     Button2: TButton;
  41.     Button3: TButton;
  42.     Button4: TButton;
  43.     Button5: TButton;
  44.     Button6: TButton;
  45.     Button7: TButton;
  46.     Button8: TButton;
  47.     Button9: TButton;
  48.     Button10: TButton;
  49.     Button11: TButton;
  50.     Memo1: TMemo;
  51.     procedure Button9Click(Sender: TObject);
  52.     procedure Button10Click(Sender: TObject);
  53.     procedure FormCreate(Sender: TObject);
  54.     procedure Button6Click(Sender: TObject);
  55.     procedure Button7Click(Sender: TObject);
  56.     procedure Button8Click(Sender: TObject);
  57.     procedure Button5Click(Sender: TObject);
  58.     procedure Button1Click(Sender: TObject);
  59.     procedure Button4Click(Sender: TObject);
  60.     procedure Button2Click(Sender: TObject);
  61.     procedure Button3Click(Sender: TObject);
  62.     procedure Button11Click(Sender: TObject);
  63.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  64.   private
  65.     { Private declarations }
  66.   public
  67.     { Public declarations }
  68.   end;
  69.  
  70. var
  71.   Form1: TForm1;
  72.   dogen: boolean {Starts and stops automatic data generation};
  73.  
  74. implementation
  75.  
  76. {$R *.DFM}
  77.  
  78. {$I splinc}
  79.  
  80.  
  81. function spellnum ( num : string ) : string;
  82. {This procedure converts a string digits into its English
  83.  string equivalent. The number must be a value less than 10
  84.  billion converted into a string of length 10 and filled
  85.  left with zeroes if necessary}
  86. var
  87.    x : integer;
  88.    s, s1 : string;
  89.    ar : array [0..32] of string[10];
  90.    p, p3, cnt, ck : integer;
  91. begin
  92.    p := 32;
  93.    p3 := 1;
  94.    s := '';
  95.    if strtointdef ( num, -1 ) < 0 then
  96.       num := '';
  97.    if num <> '' then
  98.    begin
  99.       ar[0] := 'zero';
  100.       ar[1] := 'one';
  101.       ar[2] := 'two';
  102.       ar[3] := 'three';
  103.       ar[4] := 'four';
  104.       ar[5] := 'five';
  105.       ar[6] := 'six';
  106.       ar[7] := 'seven';
  107.       ar[8] := 'eight';
  108.       ar[9] := 'nine';
  109.       ar[10] := 'ten';
  110.       ar[11] := 'eleven';
  111.       ar[12] := 'twelve';
  112.       ar[13] := 'thirteen';
  113.       ar[14] := 'fourteen';
  114.       ar[15] := 'fifteen';
  115.       ar[16] := 'sixteen';
  116.       ar[17] := 'seventeen';
  117.       ar[18] := 'eighteen';
  118.       ar[19] := 'nineteen';
  119.       ar[20] := 'twenty';
  120.       ar[21] := 'thirty';
  121.       ar[22] := 'fourty';
  122.       ar[23] := 'fifty';
  123.       ar[24] := 'sixty';
  124.       ar[25] := 'seventy';
  125.       ar[26] := 'eighty';
  126.       ar[27] := 'ninety';
  127.       ar[28] := 'hundred';
  128.       ar[29] := '';
  129.       ar[30] := 'thousand';
  130.       ar[31] := 'million';
  131.       ar[32] := 'billion';
  132.       if num [1] <> '0' then
  133.       begin
  134.          x := strtoint ( num[1] );
  135.          s := s + ar [x] + ' ' + ar [p] + ' ';
  136.       end;
  137.    end
  138.    else
  139.       s := '';
  140.    p := p - 1;
  141.    cnt := 2;
  142.    ck := 0;
  143.  
  144.    while cnt <= length ( num ) do
  145.    begin
  146.       if num[cnt] <> '0' then
  147.       begin
  148.          if p3 = 1 then
  149.          begin
  150.             x := strtoint ( num[cnt] );
  151.             s := s + ar [x] + ' hundred ';
  152.             cnt := cnt + 1;
  153.             p3 := p3 + 1;
  154.             ck := 2;
  155.          end
  156.          else if p3 = 2 then
  157.          begin
  158.             if num[cnt] = '1' then
  159.             begin
  160.                s1 := num[cnt] + num [cnt + 1];
  161.                x := strtoint ( s1 );
  162.                s := s + ar [x] + ' ';
  163.                p3 := p3 + 1;
  164.                cnt := cnt + 1;
  165.                ck := 1;
  166.             end
  167.             else
  168.             begin
  169.                s1 := num[cnt];
  170.                x := strtoint ( s1 );
  171.                s := s + ar [x + 18] + ' ';
  172.                p3 := p3 + 1;
  173.                cnt := cnt + 1;
  174.                if num[cnt] = '0' then
  175.                   ck := 1
  176.                else
  177.                   ck := 3;
  178.             end
  179.          end
  180.          else
  181.          begin
  182.             if ck <> 1 then
  183.             begin
  184.                x := strtoint ( num[cnt] );
  185.                s := s + ar [x] + ' ';
  186.                ck := 2;
  187.             end;
  188.             if ck > 0 then
  189.                s := s + ar [p] + ' ';
  190.             cnt := cnt + 1;
  191.             ck := 0;
  192.             p := p - 1;
  193.             p3 := 1;
  194.          end
  195.       end
  196.       else
  197.       begin
  198.          if p3 = 3 then
  199.          begin
  200.             if ck <> 1 then
  201.             begin
  202.                x := strtoint ( num[cnt] );
  203.                if ( x > 0 ) or ( ( s = '' ) and
  204.                                  ( cnt = 10 ) ) then
  205.                begin
  206.                   s := s + ar [x] + ' ';
  207.                   ck := 2;
  208.                end
  209.             end;
  210.             if ck > 0 then
  211.                s := s + ar [p] + ' ';
  212.             cnt := cnt + 1;
  213.             ck := 0;
  214.             p := p - 1;
  215.             p3 := 1;
  216.          end
  217.          else
  218.          begin
  219.             cnt := cnt + 1;
  220.             p3 := p3 + 1;
  221.          end;
  222.       end;
  223.    end;
  224.    spellnum := s;
  225. end;
  226.  
  227. procedure TForm1.Button9Click(Sender: TObject);
  228. begin
  229.    close
  230. end;
  231.  
  232. procedure TForm1.Button10Click(Sender: TObject);
  233. {Automatically inputs 1 million even numbers from 2 to
  234.  2000000 into the database from different angles to also
  235.  test its strength. Process can be terminated by clicking
  236.  the "stop" button.}
  237. var
  238.    x : integer;
  239.    ll : array [1..4] of longint;
  240.    cnt : longint;
  241.    s1, s2 : string;
  242. begin
  243.    if not ( activedb ) then
  244.    begin
  245.       showmessage ('No active database.');
  246.       dogen := true;
  247.    end;
  248.    if dogen then
  249.    begin
  250.       button10.Caption := '&Generate';
  251.       dogen := false;
  252.    end
  253.    else
  254.    begin
  255.       dogen := true;
  256.       button10.Caption := '&Stop';
  257.       ll[1] := 500000;
  258.       ll[2] := 500002;
  259.       ll[3] := 1500000;
  260.       ll[4] := 1500002;
  261.       x := 1;
  262.       cnt := 0;
  263.       s1 := timetostr ( time );
  264.       edit1.Text := s1;
  265.       repeat
  266.          s1 := inttostr ( ll[x] );
  267.          while length ( s1 ) < 10 do
  268.             s1 := '0' + s1;
  269.          setlength ( s1, 10 );
  270.          s2 := spellnum ( s1 );
  271.          if s2 <> '' then
  272.          begin
  273.             edit2.Text := s1;
  274.             memo1.Text := s2;
  275.             if odd ( x ) then
  276.                ll[x] := ll[x] - 2
  277.             else
  278.                ll[x] := ll[x] + 2;
  279.  
  280.             if addfield ( s1, 1 ) then
  281.             begin
  282.                if addfield ( s2, 2 ) then
  283.                begin
  284.                   if not ( addrec ( s1 ) ) then
  285.                      showmessage ( inttostr ( splerr.recnum ) + ' ' +
  286.                                    splerr.recstr );
  287.                end
  288.                else
  289.                   showmessage ( inttostr ( splerr.recnum ) + ' ' +
  290.                                 splerr.recstr );
  291.             end
  292.             else
  293.                showmessage ( inttostr ( splerr.recnum ) + ' ' +
  294.                              splerr.recstr );
  295.  
  296.             x := x + 1;
  297.             if x = 5 then
  298.                x := 1;
  299.             cnt := cnt + 1;
  300.          end
  301.          else
  302.          begin
  303.             edit2.Text := 'Error generating number.';
  304.             memo1.Text := 'Illegal or non positive number.';
  305.             dogen := false
  306.          end;
  307.  
  308.          application.ProcessMessages;
  309.  
  310.       {until (topbox^.count = splmax) or (dogen = false);}
  311.       until (cnt >= 1000000) or (dogen = false);
  312.       edit1.Text := edit1.Text + ' - ' + timetostr ( time )
  313.                     + ' - ' + inttostr ( cnt ) + ' - ' +
  314.                     inttostr ( reccount );
  315.    end;
  316.  
  317. end;
  318.  
  319. procedure TForm1.FormCreate(Sender: TObject);
  320. begin
  321.    dogen := false;
  322.    if initspl then
  323.    begin
  324.       initbase;
  325.       edit2.Text := 'Splitter database system initialized.'
  326.    end
  327.    else
  328.       edit2.text := 'Initialization failed.'
  329. end;
  330.  
  331. procedure TForm1.Button6Click(Sender: TObject);
  332. var
  333.    s : string;
  334. begin
  335.    initbase;
  336.    if setspl ('010140') then
  337.    begin
  338.       if createspl ('test') then
  339.          edit2.Text := 'Splitter Database created.'
  340.       else
  341.       begin
  342.          s := inttostr ( splerr.recnum ) + ' ' +
  343.          splerr.recstr;
  344.          edit2.Text := s;
  345.       end
  346.    end
  347.    else
  348.    begin
  349.       s := inttostr ( splerr.recnum ) + ' ' +
  350.       splerr.recstr;
  351.       edit2.Text := s;
  352.    end
  353. end;
  354.  
  355. procedure TForm1.Button7Click(Sender: TObject);
  356. var
  357.    s : string;
  358. begin
  359.    initbase;
  360.    if openspl ('test') then
  361.    begin
  362.       limrec := reccount;
  363.       edit2.Text := 'Splitter Database opened.';
  364.       memo1.text := curdtb + ' - ' +
  365.                     inttostr ( allrec.size ) + ' - ' +
  366.                     inttostr ( limrec );
  367.    end
  368.    else
  369.    begin
  370.       s := inttostr ( splerr.recnum ) + ' ' +
  371.       splerr.recstr;
  372.       edit2.Text := s;
  373.    end
  374. end;
  375.  
  376. procedure TForm1.Button8Click(Sender: TObject);
  377. var
  378.    s1, s2 : string;
  379. begin
  380.    if activedb then
  381.    begin
  382.       s1 := edit1.Text;
  383.       while length ( s1 ) < 10 do
  384.          s1 := '0' + s1;
  385.       setlength ( s1, 10 );
  386.       s2 := spellnum ( s1 );
  387.       if s2 <> '' then
  388.       begin
  389.          edit2.Text := s1;
  390.          memo1.Text := s2;
  391.          if addfield ( s1, 1 ) then
  392.          begin
  393.             if addfield ( s2, 2 ) then
  394.             begin
  395.                if addrec ( s1 ) then
  396.                   showmessage ('Record sucessfuly inserted.')
  397.                else
  398.                   showmessage ( inttostr ( splerr.recnum ) + ' ' +
  399.                                 splerr.recstr );
  400.             end
  401.             else
  402.                showmessage ( inttostr ( splerr.recnum ) + ' ' +
  403.                              splerr.recstr );
  404.          end
  405.          else
  406.             showmessage ( inttostr ( splerr.recnum ) + ' ' +
  407.                           splerr.recstr );
  408.       end
  409.       else
  410.       begin
  411.          showmessage ('Illegal input. Not a positive number.');
  412.          edit2.Text := s1;
  413.          memo1.Text := 'Illegal value.';
  414.       end;
  415.    end
  416.    else
  417.       showmessage ('No active database.');
  418. end;
  419.  
  420. procedure TForm1.Button5Click(Sender: TObject);
  421. var
  422.    s : string;
  423. begin
  424.    if activedb then
  425.    begin
  426.       s := edit1.Text;
  427.       while length ( s ) < 10 do
  428.          s := '0' + s;
  429.       edit1.Text := s;
  430.       if getrec ( s ) then
  431.       begin
  432.          showmessage ('Record found.');
  433.          memo1.Text := 'Record found.';
  434.          edit2.text := getfield ( 1 );
  435.          memo1.Text := getfield ( 2 );
  436.       end
  437.       else
  438.       begin
  439.          showmessage ('Record not found.');
  440.          memo1.Text := inttostr ( splerr.recnum ) + ' '
  441.                        + splerr.recstr;
  442.       end
  443.    end
  444.    else
  445.       showmessage ('No active database.');
  446. end;
  447.  
  448. procedure TForm1.Button1Click(Sender: TObject);
  449. begin
  450.    if not (dbempty) then
  451.    begin
  452.       if firstrec then
  453.       begin
  454.          edit2.text := getfield ( 1 );
  455.          memo1.Text := getfield ( 2 );
  456.       end
  457.       else
  458.          memo1.Text := inttostr ( splerr.recnum ) + ' '
  459.                        + splerr.recstr;
  460.    end
  461.    else
  462.       showmessage ('Database empty or not loaded.')
  463. end;
  464.  
  465. procedure TForm1.Button4Click(Sender: TObject);
  466. begin
  467.    if not (dbempty) then
  468.    begin
  469.       if lastrec then
  470.       begin
  471.          edit2.text := getfield ( 1 );
  472.          memo1.Text := getfield ( 2 );
  473.       end
  474.       else
  475.          memo1.Text := inttostr ( splerr.recnum ) + ' '
  476.                        + splerr.recstr;
  477.    end
  478.    else
  479.       showmessage ('Database empty or not loaded.')
  480. end;
  481.  
  482. procedure TForm1.Button2Click(Sender: TObject);
  483. begin
  484.    if not (dbempty) then
  485.    begin
  486.       if nextrec then
  487.       begin
  488.          edit2.text := getfield ( 1 );
  489.          memo1.Text := getfield ( 2 );
  490.       end
  491.       else
  492.          memo1.Text := inttostr ( splerr.recnum ) + ' '
  493.                        + splerr.recstr;
  494.    end
  495.    else
  496.       showmessage ('Database empty or not loaded.')
  497. end;
  498.  
  499. procedure TForm1.Button3Click(Sender: TObject);
  500. begin
  501.    if not (dbempty) then
  502.    begin
  503.       if prevrec then
  504.       begin
  505.          edit2.text := getfield ( 1 );
  506.          memo1.Text := getfield ( 2 );
  507.       end
  508.       else
  509.          memo1.Text := inttostr ( splerr.recnum ) + ' '
  510.                        + splerr.recstr;
  511.    end
  512.    else
  513.       showmessage ('Database empty or not loaded.')
  514. end;
  515.  
  516. procedure TForm1.Button11Click(Sender: TObject);
  517. begin
  518.    if delrec then
  519.       showmessage ('Record properly deleted.')
  520.    else
  521.    memo1.Text := inttostr ( splerr.recnum ) + ' '
  522.                  + splerr.recstr;
  523.  
  524. end;
  525.  
  526. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  527. begin
  528.    if releasespl then
  529.       showmessage ('Splitter database system released.')
  530.    else
  531.       showmessage ('Error releasing Splitter database system.');
  532. end;
  533.  
  534. end.
  535.