===========pu_insert過程的Delphi源碼如下====================
procedure pu_insert(tablename:string;sarr:array of string);
var rets,s,s1,s2:string;i,j,k,m,l:integer;c:char;
begin
rets:='(';l:=high(sarr);
for i:=0 to l do
begin
s:=sarr[i];k:=0; s1:='';
m:=length(s);
for j:=0 to m do
begin
if s[j]=#9 then inc(k) else
begin
if k=1 then s1:=s1+s[j];
end;
end;
if i=l then rets:=rets+s1+') values(' else rets:=rets+s1+',';
end; //以上取完了所有鍵名
for i:=0 to l do
begin
s:=sarr[i];k:=0; s1:='';s2:='';
m:=length(s);
for j:=0 to m do
begin
if s[j]=#9 then inc(k) else
begin
if k=2 then s1:=s1+s[j];
if k=11 then s2:=s2+s[j];
end;
end;
c:=upcase(s1[1]);
if i=l then begin
if (c='D') and (s2='') then rets:=rets+' null) ' else //日期為空時
if (c='F') or (c='I') then rets:=rets+s2+') ' else //數值類型
rets:=rets+#39+s2+#39+') '; //#39是MSSQL字串分隔符
end
else
begin
if (c='D') and (s2='') then rets:=rets+' null,' else
if (c='F') or (c='I') then rets:=rets+s2+',' else rets:=rets+#39+s2+#39+',';
end;
end;
if debug then tell('insert into '+tablename+' '+rets);
pu_exec('insert into '+tablename+' '+rets);
end;
我還編了另一個過程pu_update也類似,只是多了一個條件參數,就不介紹了。
因為這種方法在運行時要解釋執行,比較慢,正式發布前,我會用另一個工具對源代碼進行翻譯成真正的SQL,這個工具軟件的核心源碼摘錄如下：
function doinsert2(ss:string):string;
var l:tstringlist;i,j:integer;s:string;st:string;hav:boolean;
ch:string;label next1,next2,next3;
begin//
try l:=tstringlist.create;
s:='';
for i:=1 to length(ss) do//分行,第一行專用
begin
if (ss[i]<>#13) and (ss[i]<>#10) then s:=s+ss[i];
if ss[i]=#13 then begin l.Add(s);s:='' end;
end;
for i:=1 to l.count-1 do//清除第一個'號前的所有字符
begin
if l[i][1]='/' then goto next3;
hav:=false;
s:='';for j:=1 to length(l[i]) do
begin
if l[i][j]=#39 then hav:=true;
if hav then s:=s+l[i][j];
end;
l[i]:=s;
next3:
end;
st:='///insert'#13#10+
'pu_exec('#39'insert into '+myfind(ss,12,#39)+' (';
for i:=1 to l.Count-1 do
begin
if l[i][1]='/' then goto next1;
if (i<>l.count-1) and ((i mod 8)=0) then st:=st+#39'+'#13#10#39;
if i<>l.count-1 then st:=st+mytab(l[i],1)+','
else st:=st+mytab(l[i],1)+') values('#39;
next1:
end;
for i:=1 to l.Count-1 do
begin
if l[i][1]='/' then goto next2;
st:=st+#13#10;
if mytab(l[i],2)[1] in ['F','I','f','i'] then ch:='' else ch:='#39+';
if i<>l.count-1 then st:=st+'+'+ch+mytab(l[i],12)+'+'+ch+#39','#39
else st:=st+'+'+ch+mytab(l[i],12)+'+'+ch+#39')'#39')';
next2:
end;
result:=st;
finally
l.Free;
end;
end;
function doupdate(ss:string):string;
var l:tstringlist;i,j:integer;s:string;st:string;hav:boolean;
ch:string;label next1,next2,next3;
begin//
try l:=tstringlist.create;
s:='';
for i:=1 to length(ss) do//分行,第一行專用
begin
if (ss[i]<>#13) and (ss[i]<>#10) then s:=s+ss[i];
if ss[i]=#13 then begin l.Add(s);s:='' end;
end;
for i:=1 to l.count-1 do//清除第一個'號前的所有字符
begin
if l[i][1]='/' then goto next3;
hav:=false;
s:='';for j:=1 to length(l[i]) do
begin
if l[i][j]=#39 then hav:=true;
if hav then s:=s+l[i][j];
end;
l[i]:=s;
next3:
end;
st:='///update'#13#10+
'pu_exec('#39'update '+myfind(ss,12,#39)+' set '#39;
for i:=1 to l.Count-1 do
begin
if l[i][1]='/' then goto next1;
st:=st+#13#10'+'#39;
if mytab(l[i],2)[1] in ['F','I','f','i'] then ch:='' else ch:='#39+';
st:=st+mytab(l[i],1)+'='#39;
if i<>l.count-1 then st:=st+'+'+ch+mytab(l[i],12)+'+'+ch+#39','#39
else st:=st+'+'+ch+mytab(l[i],12)+'+'+ch;
next1:
end;
i:=pos(',',l[0]);
st:=st+#39' where '#39'+'+myfind(l[0],i+1,',')+')';
result:=st;
finally
l.Free;
end;
end;
// end of doupdate
function doinsert(ss:string):string;
var st,s,sod,snew:string;i,i1,i2,i3,i4,l:integer;hav:boolean;
begin//
st:=ss;
//開始qkinsert
repeat
i1:=pos('pu_insert('#39,st); if i1<=0 then break;
sod:='';
for i:=i1 to length(st) do
begin
sod:=sod+st[i];
if (st[i]=')') and (st[i-1]=']') and ((st[i+1]=';') or (st[i-2]=#10) or (st[i-2]=#13)) then break;
end;
snew:=doinsert2(sod);
st:=stringreplace(st,sod,snew,[rfReplaceAll]);
until 1>2;
//開始qkupdate
repeat
i1:=pos('pu_update('#39,st); if i1<=0 then break;
sod:='';
for i:=i1 to length(st) do
begin
sod:=sod+st[i];
if (st[i]=')') and (st[i-1]=']') and ((st[i+1]=';') or (st[i-2]=#10) or (st[i-2]=#13)) then break;
end;
snew:=doupdate(sod);
st:=stringreplace(st,sod,snew,[rfReplaceAll]);
until 1>2;
result:=st;
end;
procedure TForm1.Button11Click(Sender: TObject);label lb1;
var
sr: TSearchRec;
i1,FileAttrs,i: Integer;
t,f:file;
a:array[1..1000000]of char;s1,fff:string;
st:string;stin:string;
begin
if open1.Execute=false then exit;
s1:=open1.FileName;
memo2.text:=''; FileAttrs := faAnyFile;
s1:=extractfilepath(s1);//showmessage(s1);exit;
if FindFirst(s1+'*.pas',FileAttrs, sr) = 0 then
repeat
if sr.attr=fareadonly then begin memo2.text:=memo2.text+'操作失敗:';goto lb1 end;
if sr.attr=faVolumeID then begin memo2.text:=memo2.text+'操作失敗:'; goto lb1 end;
if sr.attr=fadirectory then begin memo2.text:=memo2.text+'操作失敗:'; goto lb1 end;
assignfile(t,s1+sr.Name);
reset(t,1);
blockread(t,a,1000000,i1);
closefile(t);
if i1>=1000000 then begin memo2.text:=memo2.text+'文件太大,操作失敗';goto lb1 end;
if i1>0 then
try
stin:='';
for i:=1 to i1 do stin:=stin+a[i];
if deb=10 then showmessage('in '+stin);
st:=doinsert(stin);
if deb=10 then showmessage('out '+st);
assignfile(f,s1+sr.Name);
rewrite(f,1);
blockwrite(f,st[1],length(st));
closefile(f);
except
memo2.Text:=memo2.text+'打開失敗:'
end;
lb1: memo2.Text:=memo2.text+sr.name+#13#10;
application.ProcessMessages;
until FindNext(sr) <> 0;
end;
我是這樣寫復雜的查詢語句的,如我編了一個查詢當前發庫的窗口,源程序主體(下例中的前16行)也是從Excel排好版粘過來,
注意這個示例中不僅生成了SQL，而且還設定了dbgrid1的各字段的寬度，及字段的中文名。也就是說它的數據顯示隨源程序而變。
t.s_add(1,'s','','a.trnno','發貨單號',90,'','','','');
t.s_add(1,'s','','a.orderno','訂單號',90,'','','','');
t.s_add(1,'s','','c.branchcode','分公司',61,'','','','');
t.s_add(1,'s','','month(a.times)','月份',60,'','','','');
t.s_add(1,'s','','a.times','發貨日期',75,'','','','');
t.s_add(1,'s','','upper(b.modleserial)','系列',60,'','','','');
t.s_add(1,'s','','a.k_modle','成品型號',100,'','','','');
t.s_add(1,'s','','b.modlesm','成品說明',100,'','','','');
t.s_add(1,'s','','(-a.qty)','發貨數量',75,'','','','');
t.s_add(1,'s','','a.n_ccj','標准出廠價',85,'','','','');
t.s_add(1,'s','','(-a.qty * a.n_ccj)','出廠價總額',130,'','','','');
t.s_add(1,'s','','b.factoryprice','當前出廠價',85,'','','','');
t.s_add(1,'s','','(-a.qty * b.factoryprice)','當前價總額',130,'','','','');
t.s_add(1,'s','','a.realccj','訂單出廠價',85,'','','','');
t.s_add(1,'s','','(-a.qty * a.realccj)','訂單價總額',130,'','','','');
t.s_add(1,'s','','d.remark','備注',150,'','','','');
t.s_add(1,'f','','chg_stkcrd a,modle b,orders c,fhd d','',0,'','','','');
t.s_add(1,'w','','','',0,'','','','a.k_modle=b.modle and a.k_fid='+_factid+' and a.trntype='#39'發貨'#39
+' and a.orderno=c.orderno and a.trnno=d.fhdcode');
t.s_add(1,'w','cxbuttonedit2','a.k_modle','',0,'=',#39,#39,'');
t.s_add(1,'w','cxbuttonedit1','b.modlesm','',0,'like',#39'%','%'#39,'');
t.s_add(1,'w','cxbuttonedit7','b.modleserial','',0,'=',#39,#39,'');
t.s_add(1,'w','cxtextedit5','(-a.qty)','',0,'>=','','','');
t.s_add(1,'w','cxtextedit4','(-a.qty)','',0,'<=','','','');
t.s_add(1,'w','cxdateedit1','a.times','',0,'>=',#39,#39,'');
t.s_add(1,'w','cxdateedit2','a.times','',0,'<=',#39,c59+#39,'');
t.s_add(1,'w','cxbuttonedit3','a.trnno','',0,'=',#39,#39,'');
t.s_add(1,'w','cxbuttonedit5','a.orderno','',0,'=',#39,#39,'');
t.s_add(1,'w','cxbuttonedit6','c.branchcode','',0,'=',#39,#39,'');
pu_cdsql(q1,t.s_getsql(1)); //執行SQL並放在cd1這個內存表中
t.S_GridWidth(1,dbgrid1); //設dbgrid1各個字段的寬度
其中T是一個專用於生成SQL的對象(源代碼較長，略過)，其運行畫面及產生的SQL語句見此blog後附的圖片
