|
Example fills Listview1 items with stored procedures names, input parameters and OID's (overload).
function GetSQLForParams(const anIntVer: integer): string;
const ArgNames: array[boolean] of string = ('NULL','proargnames[g.s]');
sqlShowParameters810 = 'SELECT proargnames[g.s], '+
' COALESCE(proargtypes[g.s-1], proallargtypes[g.s]),'+
' proargmodes[g.s], '+
' format_type(t.oid,-1) '+
' FROM '+
' pg_proc p, '+
' pg_type t , '+
' generate_series(1,32) as g(s)'+
' WHERE '+
' COALESCE(p.proargtypes[g.s-1],proallargtypes[g.s]) = t.oid AND ';
sqlShowParameters = 'SELECT %s, '+ //proargnames[g.s] > 8.0.0
' proargtypes[g.s], '+
' ''i''::varchar, '+
' format_type(t.oid,-1) '+
' FROM '+
' pg_proc p, '+
' pg_type t , '+
' %s as g(s) '+ //!!! generate_series(0,current_setting(''max_function_args'')::int)
' WHERE '+
' p.proargtypes[g.s] = t.oid AND ';
sqlTail = ' p.oid = %d '+
' ORDER BY g.s ';
function GetGenSeries(const StartPos,EndPos: string): string;
const sqlGenerateSeries =
'(select i*10+j as n'+
' from (select 0 union all select 1 union all select 2 union all'+
' select 3 union all select 4 union all select 5 union all'+
' select 6 union all select 7 union all select 8 union all'+
' select 9) s1(i),'+
' (select 0 union all select 1 union all select 2 union all'+
' select 3 union all select 4 union all select 5 union all'+
' select 6 union all select 7 union all select 8 union all'+
' select 9) s2(j)'+
' where (i*10+j >= %s) AND (i*10+j <= %s))';
begin
if anIntVer >= 080000 then
Result := Format('generate_series(%s,%s)',[StartPos, EndPos])
else
Result := Format(sqlGenerateSeries,[StartPos, EndPos]);
end;
begin
If anIntVer >= 080100 then
Result := sqlShowParameters810 + sqlTail
else
Result := Format(sqlShowParameters,[ArgNames[anIntVer >= 080000], GetGenSeries('0','32')]) +
sqlTail;
end;
procedure TForm1.GetStoredProcList;
Var SL: TStringList;
i: integer;
LI: TlistItem;
ParamString: shortstring;
Q: TPSQLQuery;
OldCursor: TCursor;
SQL: string;
begin
OldCursor := Screen.Cursor;
Sl := TStringList.Create;
try
Screen.Cursor := crSQLWait;
Application.ProcessMessages; //added to defroze
FStoredProc.Database.GetStoredProcNames('',SL);
Q := TPSQLQuery.Create(nil);
try
Q.Database := FStoredProc.Database;
Q.RequestLive := False;
Q.ParamCheck := False;
Q.OIDAsInt := True;
ListView1.Items.BeginUpdate;
ListView1.Items.Clear;
PB.Min := 0;
PB.Max := Sl.Count-1;
SQL := GetSQLForParams(FStoredProc.Database.ServerVersionAsInt);
for i:=0 to Sl.Count-1 do
begin
LI := ListView1.Items.Add;
LI.Caption := SL[I];
LI.SubItems.Append(inttostr(integer(SL.Objects[I])));
Q.SQL.Text := Format(SQL,[integer(SL.Objects[I])]);
Q.Open;
Q.First;
ParamString := '';
while not Q.Eof do
begin
if not Q.Fields[2].IsNull then
case Q.Fields[2].AsString[1] of
'o': ParamString := ParamString + 'OUT ';
'b': ParamString := ParamString + 'INOUT ';
end;
If Q.Fields[0].AsString > '' then
ParamString := ParamString + Q.Fields[0].AsString + ' ';
ParamString := ParamString + Q.Fields[3].AsString + '; ';
Q.Next;
end;
LI.SubItems.Append('('+Copy(ParamString,1,Length(ParamString)-2)+')');
PB.Position := i;
Application.ProcessMessages;
end;
ListView1.Items.EndUpdate;
finally
Q.Free;
end;
finally
Sl.Free;
Screen.Cursor := OldCursor;
end;
end;
|