home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / delphi / kompon / d3456 / SQLSET.ZIP / SQLSET.PAS < prev    next >
Pascal/Delphi Source File  |  2002-06-02  |  8KB  |  324 lines
  1.  (*********************************************)
  2.  (*                                           *)
  3.  (*   SQLSet v1.02 for Delphi 3/4/5/6         *)
  4.  (*                                           *)
  5.  (*   Copiright 2000 by George Barbakadze     *)
  6.  (*   All rights reserved                     *)
  7.  (*                                           *)
  8.  (*********************************************)
  9.  
  10. {$D+,L+,Y+}
  11.  
  12. unit sqlset;
  13.  
  14. interface
  15.  
  16. uses
  17.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  18.   StdCtrls, Menus, DList, Reader;
  19.  
  20. const
  21.   VarStruct = 0;
  22.     
  23. type
  24.   PStrValue = ^string;
  25.  
  26.   TSQLItem = class(TCollectionItem)
  27.   private
  28.     FTitle, FSQLText: string;
  29.     procedure SetTitle(const value: string);
  30.     procedure SetSQLText(const value: string);
  31.   public
  32.     constructor Create(Collection: TCollection); override;
  33.     destructor Destroy; override;
  34.     procedure Assign(Source: TPersistent); override;
  35.   published
  36.     property Title: string read FTitle write SetTitle;
  37.     property SQLText: string read FSQLText write SetSQLText;
  38.   end;
  39.  
  40.   TSQLSet = class;
  41.  
  42.   TSQLItems = class(TCollection)
  43.   private
  44.     FSQLSet: TSQLSet;
  45.     function GetItem(Index: Integer): TSQLItem;
  46.     procedure SetItem(Index: Integer; Value: TSQLItem);
  47.   public
  48.     constructor Create(SQLSet: TSQLSet);
  49.     function Add: TSQLItem;
  50.     property SQLSet: TSQLSet read FSQLSet;
  51.     property Items[index: Integer]: TSQLItem read GetItem write SetItem;
  52.   end;
  53.  
  54.   TSQLSet = class(TComponent)
  55.   private
  56.     { Private declarations }
  57.     FSQLItems: TSQLItems;
  58.     Reader: TReader;
  59.     procedure SetSQLItems(const Value: TSQLItems);
  60.     function GetSQLItems: TSQLItems;
  61.     procedure DisposeValue(Sender: TObject; Structure: integer;
  62.       Properties: pointer);
  63.     function GetText(const Title: string): string;
  64.   protected
  65.     { Protected declarations }
  66.   public
  67.     { Public declarations }
  68.     constructor Create(AOwner: TComponent); override;
  69.     destructor Destroy; override;
  70.     function RegisterVar(const VarName, Value: string): boolean;
  71.     procedure RemoveVar(const VarName: string);
  72.     procedure ClearVariables;
  73.     procedure AddSQL(const Title, SQLText: string);
  74.     procedure RemoveSQL(const Title: string);
  75.     procedure ClearItems;
  76.     function GetSQL(const Title: string): string;
  77.   published
  78.     { Published declarations }
  79.     property SQLItems: TSQLItems read GetSQLItems write SetSQLItems;
  80.   end;
  81.  
  82. implementation
  83.  
  84. {TSQLItem}
  85. constructor TSQLItem.Create(Collection: TCollection);
  86. begin
  87.   inherited Create(Collection);
  88. end;
  89.  
  90. destructor TSQLItem.Destroy;
  91. begin
  92.   inherited Destroy;
  93. end;
  94.  
  95. procedure TSQLItem.SetTitle(const value: String);
  96. begin
  97.   FTitle := value;
  98.   Changed(false);
  99. end;
  100.  
  101. procedure TSQLItem.SetSQLText(const value: String);
  102. begin
  103.   FSQLText := value;
  104.   Changed(false);
  105. end;
  106.  
  107. procedure TSQLItem.Assign(Source: TPersistent);
  108. begin
  109.   if Source is TSQLItem then begin
  110.     Title := TSQLItem(Source).Title;
  111.     SQLText := TSQLItem(Source).SQLText;
  112.   end
  113.   else inherited Assign(Source);
  114. end;
  115.  
  116. {TSQLItems}
  117. constructor TSQLItems.Create(SQLSet: TSQLSet);
  118. begin
  119.   inherited Create(TSQLItem);
  120.   FSQLSet := SQLSet;
  121. end;
  122.  
  123. function TSQLItems.GetItem(Index: Integer): TSQLItem;
  124. begin
  125.   Result := TSQLItem(inherited GetItem(Index));
  126. end;
  127.  
  128. procedure TSQLItems.SetItem(Index: Integer; Value: TSQLItem);
  129. begin
  130.   inherited SetItem(Index, Value);
  131. end;
  132.  
  133. function TSQLItems.Add: TSQLItem;
  134. begin
  135.   Result := TSQLItem(inherited Add);
  136. end;
  137.  
  138. {TSQLSet}
  139. constructor TSQLSet.Create(AOwner: TComponent);
  140. begin
  141.   inherited Create(AOwner);
  142.   FSQLItems := TSQLItems.Create(self);
  143.   Reader:=TReader.Create(Self);
  144.   with Reader do begin
  145.     OnDisposeProperties:=DisposeValue;
  146.     RegStandardFreeSymbols;
  147.     RemoveFreeSymbol(#13);
  148.     RemoveFreeSymbol(#10);
  149.     AddDelimiter(#13+#10, 0, nil);
  150.     AddDelimiter('.', 0, nil);
  151.     AddDelimiter(',', 0, nil);
  152.     AddDelimiter(';', 0, nil);
  153.     AddDelimiter(':', 0, nil);
  154.     AddDelimiter('''', 0, nil);
  155.     AddDelimiter('"', 0, nil);
  156.     AddDelimiter('@', 0, nil);
  157.     AddDelimiter('(', 0, nil);
  158.     AddDelimiter(')', 0, nil);
  159.     AddDelimiter('/', 0, nil);
  160.     AddDelimiter('*', 0, nil);
  161.     AddDelimiter('^', 0, nil);
  162.     AddDelimiter('+', 0, nil);
  163.     AddDelimiter('-', 0, nil);
  164.     AddDelimiter('=', 0, nil);
  165.     AddDelimiter('>', 0, nil);
  166.     AddDelimiter('<', 0, nil);
  167.     AddDelimiter('<>', 0, nil);
  168.     AddDelimiter('>=', 0, nil);
  169.     AddDelimiter('<=', 0, nil);
  170.     AddDelimiter('[', 0, nil);
  171.     AddDelimiter(']', 0, nil);
  172.     AddDelimiter('{', 0, nil);
  173.     AddDelimiter('}', 0, nil);
  174.     AddDelimiter('(+)', 0, nil);
  175.     AddDelimiter(':=', 0, nil);
  176.     AddDelimiter('!=', 0, nil);
  177.     AddDelimiter('^=', 0, nil);
  178.     AddDelimiter('--', 0, nil);
  179.     AddDelimiter('||', 0, nil);
  180.     AddDelimiter('/*', 0, nil);
  181.     AddDelimiter('*/', 0, nil);
  182.   end;
  183. end;
  184.  
  185. destructor TSQLSet.Destroy;
  186. begin
  187.   FSQLItems.Destroy;
  188.   Reader.Destroy;
  189.   inherited Destroy;
  190. end;
  191.  
  192. procedure TSQLSet.SetSQLItems(const Value: TSQLItems);
  193. begin;
  194.   FSQLItems.Assign(Value);
  195. end;
  196.  
  197. function TSQLSet.GetSQLItems: TSQLItems;
  198. begin;
  199.   Result := FSQLItems;
  200. end;
  201.  
  202. procedure TSQLSet.DisposeValue(Sender: TObject; Structure: integer;
  203.   Properties: pointer);
  204. begin
  205.   if Structure=VarStruct then if PStrValue(Properties)^<>'' then
  206.     Dispose(PStrValue(Properties));
  207. end;
  208.  
  209. function TSQLSet.RegisterVar(const VarName, Value: string): boolean;
  210. var
  211.   VarValue: PStrValue;
  212.   i: integer;
  213. begin
  214.   Result:=false;
  215.   if VarName = '' then
  216.     MessageDlg('Variable name missing', mtError, [mbOK], 0)
  217.   else begin
  218.     New(VarValue);
  219.     for i:=1 to Length(VarName) do if Reader.IsDelimiter(VarName[i]) then begin
  220.       MessageDlg('The variable name can not contain a devider "'+
  221.                  VarName[i]+'"', mtError, [mbOK], 0);
  222.       Exit;
  223.     end;
  224.     VarValue^:=Value;
  225.     Reader.AddKeyWord(AnsiLowerCase(VarName), VarStruct, VarValue);
  226.     Result:=true;
  227.   end;
  228. end;
  229.  
  230. procedure TSQLSet.RemoveVar(const VarName: string);
  231. begin
  232.   Reader.Remove(AnsiLowerCase(VarName));
  233. end;
  234.  
  235. procedure TSQLSet.ClearVariables;
  236. begin
  237.   Reader.ClearKeyWords;
  238. end;
  239.  
  240. procedure TSQLSet.AddSQL(const Title, SQLText: string);
  241. var
  242.   i: integer;
  243.   VC: TSQLItem;
  244. begin
  245.   for i := 0 to FSQLItems.Count - 1 do
  246.     if AnsiLowerCase(FSQLItems.Items[i].Title)=
  247.       AnsiLowerCase(Title) then begin
  248.       FSQLItems.Items[i].Title:=Title;
  249.       FSQLItems.Items[i].SQLText:=SQLText;
  250.       Exit;
  251.     end;
  252.   VC := FSQLItems.Add;
  253.   VC.Title := Title;
  254.   VC.SQLText := SQLText;
  255. end;
  256.  
  257. procedure TSQLSet.RemoveSQL(const Title: string);
  258. var
  259.   OldSQLItems: TSQLItems;
  260.   i, i1: Integer;
  261. begin
  262.   OldSQLItems := TSQLItems.Create(Self);
  263.   try
  264.     OldSQLItems.Assign(FSQLItems);
  265.     FSQLItems.Clear;
  266.     i1:=0;
  267.     for i := 0 to OldSQLItems.Count - 1 do
  268.       if AnsiLowerCase(OldSQLItems.Items[i].Title)=
  269.         AnsiLowerCase(Title) then inc(i1)
  270.       else begin
  271.         FSQLItems.Add;
  272.         FSQLItems.Items[i-i1].Assign(OldSQLItems.Items[i]);
  273.       end;
  274.   finally
  275.     OldSQLItems.Free;
  276.   end;
  277. end;
  278.  
  279. procedure TSQLSet.ClearItems;
  280. begin
  281.   FSQLItems.Clear;
  282. end;
  283.  
  284. function TSQLSet.GetText(const Title: string): string;
  285. var
  286.   i: integer;
  287. begin
  288.   Result:='';
  289.   for i := 0 to FSQLItems.Count - 1 do
  290.     if AnsiLowerCase(FSQLItems.Items[i].Title)=
  291.       AnsiLowerCase(Title) then begin
  292.       Result:=FSQLItems.Items[i].SQLText;
  293.       Exit;
  294.     end;
  295. end;
  296.  
  297. function TSQLSet.GetSQL(const Title: string): string;
  298. var
  299.   Scroller: TScroller;
  300.   s: string;
  301.   i: integer;
  302. begin
  303.   Result:='';
  304.   Scroller:=TScroller.Create(Reader);
  305.   try
  306.     with Scroller do begin
  307.       First(GetText(Title), 0);
  308.       while PosList[0].Status<>sNone do begin
  309.         s:='';
  310.         for i:=1 to Length(PosList[0].FreeStr) do s:=s+' ';
  311.         if PosList[0].Status=sKeyWord then
  312.           Result:=Result+s+PStrValue(PosList[0].Additional)^
  313.         else Result:=Result+s+PosList[0].ActiveStr;
  314.         Next;
  315.       end;
  316.     end;
  317.   finally
  318.     Scroller.Destroy;
  319.   end;
  320. end;
  321.  
  322. end.
  323.  
  324.