以“&字段名”作为变量的SQL语句解析用到思路和方法

{******************************************************************************

名 称：StrToStrings

主要功能：字符串转换为字符列表

参数说明：字符串、分隔符、字符串列表

返 回 值：无

主要流程：

编写日期：

编写人员：

更新日志：

*******************************************************************************}

procedure pdStrToStrings(S: string; Sep: string; List: TStrings);

var

I, L: Integer;

Left: string;

begin

List.Clear;

L := Length(Sep);

I := Pos(Sep, S);

while (I > 0) do

begin

Left := Copy(S, 1, I - 1);

List.Add(Left);

Delete(S, 1, I + L - 1);

I := Pos(Sep, S);

end;

if Trim(S) <> '' then

List.Add(S);

end;

//更新脚本中的变量

function fnSetSqlVariable(sSqlText:string;lList:TStrings):string;

var

i,iPos:Integer;

sNameText:string;

begin

Result :='';

for i:=0 to lList.Count-1 do

begin

sNameText := UpperCase(lList.Names[i]);

iPos := Pos('&'+sNameText,UpperCase(sSqlText));

if iPos>0 then

begin

sSqlText:=StringReplace(sSqlText,'&'+sNameText,lList.Values[sNameText],[rfReplaceAll]);

end;

end;

Result := sSqlText;

end;

思路：

{

字符串转换为字符列表；

循环界面，取变量。

设置变量

}

附加：

{******************************************************************************

单元名称：uBBPublic.pas

主要功能：报表公共单元

编写日期：

编写人员：

更新日志：

******************************************************************************}

unit uBBPublic;

interface

{copyright by NanNing Huarong Electronic Technology Co., Ltd.2010}

uses SysUtils, Forms, Controls, Classes, Windows, ShellApi, StrUtils,

Registry, TypInfo, Messages, ADODB, DBCtrls, StdCtrls, Winsock,

uConst, Dialogs, uMsgBox, inifiles, Variants, uAdodsOp;

type

PNodxRec = ^TNodxRec;

TNodxRec = record

vNodeID: string; //ID号

vNodeName: string; //名称

vNodeReport: string; //报表类型

vNodeMeno: string;//描述

end;

TSelectRec = record

vIdText:string;//编号

vNameText:string;//名称

end;

function fnGetSelectSql(sSqlText:string):string;

function fnGetCaption(sSqlText:string):string;

function fnGetVariable(sVarText:string):string;

function fnGetSelectText(sSqlText:string):string;

function fnSetVariable(sVarText:string):string;

function fnSetSqlVariable(sSqlText:string;lList:TStrings):string;

function fnGetBmSql(sSqlText: string):string;

procedure pdCreateTable;

implementation

uses

uPublic,ufrmBbPrompt,uDataBase;

//创建表

procedure pdCreateTable;

var

sSql:string;

pDBOpr: IDBOper;

AdodsOp: IAdodsOp;

begin

pDBOpr := TDBOper.Create;

with pDBOpr do

begin

if not CheckTableExists('ZRB1') then

begin

sSql := 'CREATE TABLE ZRB1(';

sSql := sSql+'BAZ001 VARCHAR2(16) PRIMARY KEY,';

sSql := sSql+'BAZ002 VARCHAR2(20),';

sSql := sSql+'BAZ003 VARCHAR2(100),';

sSql := sSql+'BAZ004 LONG,';

sSql := sSql+'BAZ005 DATE DEFAULT SYSDATE,';

sSql := sSql+'BAZ006 VARCHAR2(2000))';

try

AdodsOp := TAdodsOp.Create();

AdodsOp.ExcuteSQL(sSql);

except

on E:Exception do

pdMsgOK('创建表错误！'+E.Message+';脚本:->'+sSql);

end;

end;

end;

end;

//取主脚本语句

function fnGetSelectSql(sSqlText:string):string;

var

iPos,i,x,iRow,iFlag:Integer;

sSelectSql,sText:string;

sVarText,sVarName,sVarValue:string;

lSqlTextList,lValueList:TStrings;

begin

lSqlTextList := TStringList.Create;

lValueList:= TStringList.Create;

lValueList.Clear;

iFlag := 0;

try

try

pdStrToStrings(sSqlText,';',lSqlTextList);

//取变量 //set 方式的变量

for i:=0 to lSqlTextList.Count-1 do

begin

sText := Trim(lSqlTextList.Strings[i]);

sVarText := fnGetVariable(sText);

if sVarText<>'' then lValueList.Add(sVarText);

end;

//设置变量 //get方式外部带入的变量

for i:=0 to lSqlTextList.Count-1 do

begin

sText := Trim(lSqlTextList.Strings[i]);

for x:=0 to lValueList.Count-1 do

begin

sVarName := lValueList.Names[x];

sVarValue:= lValueList.Values[sVarName];

iPos := Pos(UpperCase('&'+lValueList.Names[x]),UpperCase(sText));

if iPos>0 then sText:= StringReplace(sText,'&'+sVarName,sVarValue,[rfReplaceAll]);

end;

sVarText := fnSetVariable(sText);

if sVarText<>'' then

begin

iRow := lValueList.Add(sVarText);

if lValueList.Values[lValueList.Names[iRow]]='' then

begin

//iFlag := 1;

Exit;

end;

end;

if iFlag = 1 then Result :='';

end;

//取脚本 （取Select 语句）

for i:=0 to lSqlTextList.Count-1 do

begin

sText := Trim(lSqlTextList.Strings[i]);

sSelectSql := fnGetSelectText(sText);

if sVarText<>'' then Exit;

end;

sSelectSql := fnSetSqlVariable(sSelectSql,lValueList);//设置变量

Result := sSelectSql;

except

on E: Exception do

begin

pdMsgOK('取脚本错误，uBBPublic.fnGetSelectSql函数！'+E.Message);

end;

end;

finally

lSqlTextList.Free;

lValueList.Free;

end;

end;

//取字段别名

function fnGetCaption(sSqlText:string):string;

var

iAliasPos,i:Integer;

sCaption:string;

lSqlTextList:TStrings;

begin

lSqlTextList := TStringList.Create;

pdStrToStrings(sSqlText,';',lSqlTextList);

try

for i:=0 to lSqlTextList.Count-1 do

begin

iAliasPos :=Pos('ALIAS ',UpperCase(lSqlTextList.Strings[i]));

if iAliasPos>0 then

begin

sCaption:= Trim(lSqlTextList.Strings[i]);

Delete(sCaption, 1, 5);

Result:= sCaption;

end;

end;

finally

lSqlTextList.Free;

end;

end;

//取变量

function fnGetVariable(sVarText:string):string;

var

iSetPos,iPos:Integer;

sVariable,sVariableText,sValue:string;

AdodsOp: IAdodsOp;

begin

Result := '';

//判断SET宏

iSetPos := Pos('SET ',UpperCase(sVarText));

if iSetPos>0 then

begin

sVarText := Trim(sVarText);

Delete(sVarText, 1, 3);

sVarText := Trim(sVarText);

iPos := Pos('=',sVarText);

sVariable := Copy(sVarText,0,iPos-1);

sVariableText:= Copy(sVarText,iPos+1,Length(sVarText)-iPos);

if Pos('SELECT ',sVariableText)<1 then

begin

Result := sVariable+'='+QuotedStr(sVariableText);

end

else

begin

try

AdodsOp := TAdodsOp.Create();

With TAdoQuery.Create(nil) Do

try

Connection := AdodsOp.GetADOConn;

SQL.Text := sVariableText;

Open;

if RecordCount<=1 then

sValue := Trim(Fields[0].AsString);

if sValue<>'' then sValue:=QuotedStr(sValue);

finally

Free;

end;

Result := sVariable+'='+sValue;

except

on E: Exception do

begin

pdMsgOK('取变量错误，uBBPublic.fnGetVariable函数！'+E.Message);

end;

end;

end;

end;

end;

//设置变量

function fnSetVariable(sVarText:string):string;

var

iGetPos,i:Integer;

sText,sName,sPrompt,sType,sValue,sDefault:string;

sVariable,sDateFormat:string;

lVarList:TStrings;

frmBbPrompt: TfrmBbPrompt;

begin

Result := '';

frmBbPrompt:=TfrmBbPrompt.Create(nil);

lVarList :=TStringList.Create;

try

//判断GET宏

iGetPos := Pos('GET ',UpperCase(sVarText));

if iGetPos>0 then

begin

sVarText := Trim(sVarText);

Delete(sVarText, 1, 3);

sVarText := Trim(sVarText);

try

begin

pdStrToStrings(sVarText,' ',lVarList);

//取设置变量信息

for i:=0 to lVarList.Count-1 do

begin

sText := lVarList.names[i];

sVariable := lVarList.Values[sText];

if UpperCase(sText)='NAME' then sName := sVariable;

if UpperCase(sText)='PROMPT' then sPrompt := sVariable;

if UpperCase(sText)='TYPE' then sType := sVariable;

if UpperCase(sText)='VALUES' then sValue := sVariable;

if UpperCase(sText)='DEFAULT' then sDefault := sVariable;

end;

//下啦选择框

if UpperCase(sType)='DDDW' then

begin

sValue := fnGetBmSql(sValue);

sValue:=frmBbPrompt.fnShowPrompt(sPrompt,sValue,sDefault);

if sValue<>'' then sValue := QuotedStr(sValue);

end

else if UpperCase(sType)='DATE' then

begin

sValue:=frmBbPrompt.fnShowPrompt(sPrompt,sValue,sDefault);

sValue:=StringReplace(sValue,'-','',[rfReplaceAll]);

sValue:=StringReplace(sValue,'/','',[rfReplaceAll]);

sValue:=StringReplace(sValue,':','',[rfReplaceAll]);

if (Length(sValue)=8) then sDateFormat:= 'YYYYMMDD';

if (Length(sValue)=12) then sDateFormat:='YYYYMMDDHH24MI';

if (Length(sValue)=14) then sDateFormat:='YYYYMMDDHH24MISS';

if (sDateFormat='') and (Length(sValue)<>0) then

begin

pdMsgOK('日期格式错误，uBBPublic.fnSetVariable函数！数据:->'+sValue);

sValue :='';

end;

if sValue<>'' then

sValue := 'TO_DATE('+QuotedStr(sValue)+','+QuotedStr(sDateFormat)+')';

end

else

begin

sValue:=frmBbPrompt.fnShowPrompt(sPrompt,sValue,sDefault);

if sValue<>'' then sValue := QuotedStr(sValue);

end;

Result := sName+'='+sValue;

end;

except

on e:Exception do

begin

pdMsgOK('替换变量错误，uBBPublic.fnSetVariable函数！脚本:->'+sVarText)

end;

end;

end;

finally

lVarList.Free;

end;

end;

//取主脚本语句

function fnGetSelectText(sSqlText:string):string;

var

iSelectPos:Integer;

begin

Result :='';

//判断SELECT宏

iSelectPos := Pos('SELECT ',UpperCase(sSqlText));

if iSelectPos>0 then

begin

Result :=sSqlText;

end;

end;

//更新脚本中的变量

function fnSetSqlVariable(sSqlText:string;lList:TStrings):string;

var

i,iPos:Integer;

sNameText:string;

begin

Result :='';

for i:=0 to lList.Count-1 do

begin

sNameText := UpperCase(lList.Names[i]);

iPos := Pos('&'+sNameText,UpperCase(sSqlText));

if iPos>0 then

begin

sSqlText:=StringReplace(sSqlText,'&'+sNameText,lList.Values[sNameText],[rfReplaceAll]);

end;

end;

Result := sSqlText;

end;

//取编码语句

function fnGetBmSql(sSqlText: string):string;

var

iBegPos,iEndPos:Integer;

sSelectSql:string;

begin

Result :='';

iBegPos := Pos('[',sSqlText);

iEndPos := Pos(']',sSqlText);

if (iBegPos > 0) and (iEndPos > 0) then

begin

sSelectSql := UpperCase(Copy(sSqlText,2,iEndPos-iBegPos-1));

sSelectSql:= StringReplace(sSelectSql,'|',' ',[rfReplaceAll]);

if (Pos('SELECT ',sSelectSql)<1)or(Pos(' FROM ',sSelectSql)<1) then

pdMsgOK('编码格式错误，uBBPublic.fnGetBmSql函数！脚本:->'+sSelectSql);

Result := sSelectSql;

end

else pdMsgOK('编码格式错误，uBBPublic.fnGetBmSql函数！脚本:->'+sSqlText);

end;

end.

procedure TfrmMdlTjbb.tvTitleDblClick(Sender: TObject);

var

sSqlText,sCaption:string;

i:Integer;

CaptionList:TStrings;

begin

inherited;

CaptionList := TStringList.Create;

CaptionList.Clear;

if GetNodeID='' then Exit;

lblTitle.Caption := GetNodeName;

try

try

with adqTitle do

begin

if Active then Close;

SQL.Text := 'SELECT BAZ004 FROM ZRB1 WHERE BAZ001='+QuotedStr(GetNodeID);

AdoOpr.Open(adqTitle);

sSqlText := UpperCase(FieldByName('BAZ004').AsString);

try

sCaption := fnGetCaption(sSqlText);

pdStrToStrings(sCaption,',',CaptionList);

//处理脚本

sSqlText := fnGetSelectSql(sSqlText);

if sSqlText='' then Exit;

except

on E: Exception do

begin

WaitForm.pdHideProgress;

MsgBox.DoSysError(E.Message,'脚本:->'+sSqlText,'处理脚本');

end;

end;

begin

try

WaitForm.pdShowProgress(cTJData);

try

with adsMaster do

begin

if Active then Close;

CommandText := sSqlText;

AdoOpr.Open(adsMaster);

famDBGrid1.dbgFrame.Columns.Clear;

for i:=0 to adsMaster.FieldCount-1 do

begin

famDBGrid1.dbgFrame.Columns.Add;

if (CaptionList.Count<=i) then CaptionList.Add(adsMaster.Fields[i].FieldName);

famDBGrid1.dbgFrame.Columns.Items[i].FieldName :=adsMaster.Fields[i].FieldName;

famDBGrid1.dbgFrame.Columns.Items[i].Title.Caption:=CaptionList.Strings[i];

case adsMaster.Fields[i].DataType of

ftFloat:

begin

famDBGrid1.dbgFrame.Columns.Items[i].DisplayFormat:='0.00';

famDBGrid1.dbgFrame.Columns.Items[i].Width:=80;

end;

ftBCD:

begin

famDBGrid1.dbgFrame.Columns.Items[i].Width:=80;

end;

ftInteger:

begin

famDBGrid1.dbgFrame.Columns.Items[i].DisplayFormat:='0';

famDBGrid1.dbgFrame.Columns.Items[i].Width:=80;

end

else

begin

if (famDBGrid1.dbgFrame.Columns.Items[i].Width>180) then

famDBGrid1.dbgFrame.Columns.Items[i].Width:=180;

if (famDBGrid1.dbgFrame.Columns.Items[i].Width<70) then

famDBGrid1.dbgFrame.Columns.Items[i].Width:=70;

end;

end;

end;

end;

except

on E: Exception do

begin

WaitForm.pdHideProgress;

MsgBox.DoSysError(E.Message,'脚本:->'+sSqlText,'执行脚本');

end;

end;

finally

WaitForm.pdCloseProgress;

end;

end;

end;

except

on E: Exception do

begin

MsgBox.DoSysError(E.Message,'脚本:->'+sSqlText,'运行脚本')

end;

end;

finally

CaptionList.Free;

end;

end;