名 称: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;