I have used PL/SQL dynamic content for creating a report. I need to add functionality to scrape (take data) from this HTML. Moreover, I have SQL which returns data.
How can I do this with APEX region PL/SQL dynamic content?
PL/SQL code for creating HTML tags with data:
declare
l_sql varchar2(2000) := test.function(92500, 2017, 2, 114); --return which select when we dynamical execute this select it will return data
l_columns varchar2(2000) := test.test_function_dynamic_columns_name(92500, 2017, 2, 114);
l_vc_arr2 APEX_APPLICATION_GLOBAL.VC_ARR2;
v_tableclob clob := '<table summary="" class="a-IRR-table" id="2212903112260009" role="presentation">';
v_rowclob clob;
v_rowclob_1 clob;
begin
l_vc_arr2 := APEX_UTIL.STRING_TO_TABLE(l_columns);
v_tableclob := v_tableclob||'<tr>';
v_tableclob := v_tableclob ||'<th class="a-IRR-header">';
v_tableclob := v_tableclob ||REPLACE(REPLACE(l_columns,'"',' '),':','</th><th class="a-IRR-header">');
v_tableclob := v_tableclob ||'</th></tr>';
FOR z IN 1..l_vc_arr2.count LOOP
if l_vc_arr2(z) = '"SUM"' then
v_rowclob := v_rowclob ||'<td class="summation">''||t.'||l_vc_arr2(z)||'||''</td>';
v_rowclob_1 := v_rowclob_1 || '<td id="total_sum"></td>';
else
v_rowclob := v_rowclob ||'<td>''||t.'||l_vc_arr2(z)||'||''</td>';
v_rowclob_1 := v_rowclob_1 || '<td></td>';
end if;
end loop;
execute immediate
'
declare
begin
htp.p('''||v_tableclob||''');
for t in ('||l_sql||') loop
htp.p(''<tr>'||v_rowclob||'</tr>'');
end loop;
htp.p(''<tr>'');
htp.p('''|| v_rowclob_1 ||''');
htp.p(''</tr>'');
htp.p(''</table>'');
end;';
end;
My project uses a REST server with FireDac.
I have a generic function that makes all my Selects but when I try to ApplyUpdates if does nothings. No message, no crash, it just keeps going and the data is not reflected to the database.
My Code:
function TServerMethods.ApplyUpdates(banco, tabela : String; const DeltaList: TFDJSONDeltas; var Mensagem : String) : Boolean;
var
LApply : IFDJSONDeltasApplyUpdates;
Query : TFDQuery;
begin
mensagem := '';
result := false;
try
try
LApply := TFDJSONDeltasApplyUpdates.Create(DeltaList);
Query := CriaQuery(banco,Tabela);
Query.Open();
LApply.ApplyUpdates(banco + '.' + tabela, Query.Command);
if LApply.Errors.Count > 0 then
raise Exception.Create(LApply.Errors.Strings.ToString);
result := true;
except
on E:Exception do
begin
mensagem := 'Ocorreu um Erro na atualização: ' + #13#10 + E.Message;
end;
end;
finally
end;
end;
The GetDeltas function (the function that generates the DeltaList):
function GetDeltas(Banco, Tabela : String; MemTable : TFDMemTable) : TFDJSONDeltas;
begin
if MemTable.State in [dsInsert, dsEdit] then
MemTable.Post;
result := TFDJSONDeltas.Create;
TFDJSONDeltasWriter.ListAdd(result, MemTable);
end;
My "CriaQuery" Function:
function TServerMethods.CriaQuery(Database : String; Tabela : String = '') : TFDQuery;
var
FieldName : Boolean;
i : Integer;
begin
result := TFDQuery.Create(self);
result.Connection := Connection;
result.FetchOptions.AutoFetchAll := afAll;
result.name := 'Qry' + Database + tabela;
result.SQL.Clear;
FieldName := false;
if Trim(Tabela) <> '' then
begin
result.SQL := MontaSQL(database + '.' + tabela);
result.SQL.Add(' and 1 = 0');
result.Open();
QryCampos.First;
result.IndexFieldNames := result.Fields[1].FieldName;
for i := 0 to result.Fields.Count-1 do
begin
if (UPPERCASE(Copy(result.Fields[i].FieldName, Length(result.Fields[i].FieldName)-1,2)) = 'ID') and
(not FieldName) then
begin
result.Fields[i].ProviderFlags := [pfInUpdate, pfInWhere, pfInKey];
FieldName := true;
end
else
result.Fields[i].ProviderFlags := [pfInUpdate];
end;
result.Close;
result.SQL.Delete(result.SQL.Count-1);
end;
end;
Function that generates the bindings of the components:
procedure LinkaComponente(Campo : TField; Dono : TFmxObject; Classe : String);
var
BindSource : TBindSourceDB;
BindingList : TBindingsList;
Link : TLinkControlToField;
begin
if Dono is TForm then
begin
BindSource := TBindSourceDB.Create(Dono);
end
else
begin
BindSource := TBindSourceDB.Create(Dono.Owner);
end;
BindingList := TBindingsList.Create(BindSource.Owner);
Link := TLinkControlToField.Create(BindSource.Owner);
BindSource.DataSet := Campo.DataSet;
if Classe = 'TCheckBox' then
begin
Link.Control := Dono.FindComponent(Campo.FieldName);
Link.CustomFormat := 'ToStr(%s) <> "N"';
Link.CustomParse := 'IfThen(%s,"S","N")';
end
else if Classe = 'TFrameF2' then
begin
Link.Control := (Dono.FindComponent('Frame' + Campo.FieldName) as TFrameF2).edtFK;
end
else
Link.Control := Dono.FindComponent(Campo.FieldName);
Link.DataSource := BindSource;
Link.FieldName := Campo.FieldName;
Link.Active := true;
end;
the moment I call the applyUpdates function:
procedure TDMPadrao.DMApplyUpdates;
var
Deltas : TFDJSONDeltas;
Mensagem : String;
begin
//repetir esses comando para todas as MemTables do DM na sua ordem de dependencia
// tabelas pai antes de tabelas filhas...
try
Deltas := GetDeltas(banco, tabela, FDMemTable);
except
on E:Exception do
begin
FDMemTable.Edit;
MostraMensagemBasica('Ocorreu um Erro na atualização:' + #13#10 + E.Message);
abort;
end;
end;
if not DMClient.ServerMethodsClient.ApplyUpdates(banco, tabela, Deltas, Mensagem) then
begin
FDMemTable.Edit;
MostraMensagemBasica(Mensagem);
abort;
end;
end;
Everything works fine when I'm reading. I Only get a problem when I call the ApplyUpdates function
Thanks.
I had similar problem and I got it resolved passing the table name to Query.UpdateOptions.UpdateTableName before ApplyUpdates.
Are you doing it inside "CriaQuery"?
What is your Delphi Version?
Here is my working code, I have tested it in Delphi XE7 e XE7 Update 1:
procedure TDBDM.ApplyDeltas(const ADeltaList: TFDJSONDeltas; const TableName: string);
var
JSONDeltas: IFDJSONDeltasApplyUpdates;
Query: TFDQuery;
begin
JSONDeltas := TFDJSONDeltasApplyUpdates.Create(ADeltaList);
Query := CreateQuery(TableName);
try
Query.UpdateOptions.UpdateTableName := TableName;
JSONDeltas.ApplyUpdates(0, Query.Command);
if JSONDeltas.Errors.Count > 0 then
begin
raise Exception.Create(JSONDeltas.Errors.Strings.Text);
end;
finally
Query.Free;
end;
end;
Notes
different from your code, Query.Open is not called.
TFDMemTable.CachedUpdates must be True
Edit: Added the client side code to applyUpdates
I call this method in TFDMemTable.AfterPost event.
const
CustomerTableName = 'CUSTOMER';
procedure TCustomersDataModuleClient.ApplyUpdates;
var
Deltas: TFDJSONDeltas;
begin
Deltas := TFDJSONDeltas.Create;
TFDJSONDeltasWriter.ListAdd(Deltas, CustomerTableName, CustomersMemTable);
RestClientModule.CustomersMethodsClient.ApplyUpdates(Deltas);
CustomersMemTable.CommitUpdates;
end;
All I want to do is to implement "Export to excel" option of a classical webbrowser, to Delphi2007 commands...... When I am using this option from a webbrowser to export a 12000 rows table it takes less than a minute to export the table from any web browser from windows. Trying to implement this in Delphi using 2D Array it takes 10 minutes... Trying to implement the export with parsing technique (Stringlists, strings, Pos(tr), pos (td) & some other string functions) it takes a long... Hence, which are the commands of a webbrowser to export an html table to excel that I have to convert them to Delphi? Should I use javascript inside Delphi? Should I use pointers? Should I use HTML entities? xml?...Any ideas? Thank you in advance.
2D ARRAY
Excel:= CreateOleObject('Excel.Application');
ovTable := WebBrowser1.OleObject.Document.all.tags('TABLE').item(0);
arrayn:=VarArrayCreate([1, ovTable.Rows.Length, 1, ovTable.Rows.Item(1).Cells.Length], varvariant);
for i:=0 to (ovTable.Rows.Length - 1) do
begin
for j := 0 to (ovTable.Rows.Item(i).Cells.Length - 1) do
Begin
arrayn[i+1, j+1]:=ovTable.Rows.Item(i).Cells.Item(j).InnerText;
Application.ProcessMessages;
end;end;
WS.range[ws.cells[1, 1], ws.cells[ovTable.Rows.Length, ovTable.Rows.Item(1).Cells.Length]].value:=arrayn;
Excel.WorkBooks[1].SaveAs(directorylistbox1.Directory+'\'+'test.xlsx');
WS := Excel.WorkBooks.close;
Excel.quit;
Excel:=unassigned;
HTML PARSING
function HTMLCleanUp(L : string) : string;
const
CSVTempSeparator = #255; //replaced by a comma
CRLF = #13#10;
var
P1,P2 : integer;
begin
P1 := Pos('<',L); //clean-up anything between <>
while (P1>0) do //WHILE1
begin
P2 := Pos('>',L);
if (P2>0)
then Begin Delete(L,P1,P2-P1+1); end;
P1 := Pos('<',L);
end; //WHILE1
L:=StringReplace(L,' ','-',[rfReplaceAll]);
L:=StringReplace(L,'-01','',[rfReplaceAll]);
L:=StringReplace(L,'-02','',[rfReplaceAll]);
L:=StringReplace(L,'-03','',[rfReplaceAll]);
Result := Trim(L);
end;
function HTMLTableToCSV(HTML,CSV : TStringList) : boolean;
const
CRLF = #13#10;
CSVTempSeparator = #9;
var
P1,P2,P3,P4, p5, P6, p11, p22 : integer;
S,TmpStr,CSVStr : string;
begin
Result := True;
S := Trim(StringReplace(HTML.Text,CRLF,'',[rfReplaceAll]));
P1 := PosEx('<TR',S, 1); //CASE SENSITIVE , TR->FIRST ROW
CSVStr := '';
while (P1>0) do //while1
begin
P2 := PosEx('</TR',S, P1);
if (P2>0) //if1
then begin
TmpStr := Copy(S,P1,P2-P1+1);
//Delete(S,P1,P2-P1+1);
CSVStr := ''; p11:=1;p22:=1;
P11 := PosEx('<TH',TmpStr,1);
while (P11>0) do //while2
begin
P22 := PosEx('</TH',TmpStr, P11);
if (P22>0) //if2
then begin
CSVStr :=
//CSVStr+Trim(Copy(TmpStr,P1+4,P2-P1-4));//+CSVTempSeparator;
CSVStr+Trim(Copy(TmpStr,P11,P22-P11))+CSVTempSeparator;
//Delete(TmpStr,P1,P2-P1+1);
end //if2
else begin
Result := False;
Exit;
end; //if2
P11 := PoseX('<TH',TmpStr, P22);
end; //while2
P11 := PosEx('<TD',TmpStr, 1);
while (P11>0) do //while2
begin
P22 := PosEx('</TD',TmpStr, P11);
if (P22>0) //if2
then begin
CSVStr :=
//CSVStr+Trim(Copy(TmpStr,P1+4,P2-P1-4));//+CSVTempSeparator;
CSVStr+Trim(Copy(TmpStr,P11,P22-P11))+CSVTempSeparator;
//Delete(TmpStr,P1,P2-P1+1);
end //if2
else begin
Result := False;
Exit;
end; //if2
P11 := PosEx('<TD',TmpStr,P22);
end; //while2
end //if1
else begin
Result:=false;
exit;
end; //if1
CSV.Add(HTMLCleanUp(CSVStr));
P1 := PosEx('<TR',S,P2); //CASE SENSITIVE
end; //while1
end;
procedure TForm11.Button1Click(Sender: TObject);
const
xlExcel7 = $00000027;
TmpFileName='c:\test\Test.txt';
VAR
Excel: Olevariant;
HTMLStrList,CSVSTRList : TStringList;
begin
HTMLStrList := TStringList.Create;
try
HTMLStrList.LoadFromFile('C:\test\TestTable1.htm');
CSVSTRList := TStringList.Create;
try
if HTMLTableToCSV(HTMLStrList,CSVSTRList)
then Begin
CSVSTRList.SaveToFile(TmpFileName);
Excel:= CreateOleObject('Excel.Application');
Excel.WorkBooks.opentext(TmpFileName);//OPEN TXT WITH EXCEL
Excel.DisplayAlerts := False;
Excel.WorkBooks[1].SaveAs('c:\test\Nisa.xls', xlExcel7);//SAVE TAB DELIMITED TEXT FILE
Excel.WorkBooks[1].close;
Excel.quit;
Excel:=unassigned;
End
else ShowMessage('Error converting HTML table to CSV');
finally
CSVSTRList.Free;
end;
finally
HTMLStrList.Free;
DeleteFile(TmpFileName);
end;
end;
procedure TForm11.FormCreate(Sender: TObject);
begin
webBrowser1.Navigate('http://samples.msdn.microsoft.com/workshop/samples/author/tables/HTML_ Table.htm');
end;
procedure TForm11.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
Document: IHtmlDocument2;
CurWebrowser : IWebBrowser;
TopWebBrowser: IWebBrowser;
WindowName : string;
begin
CurWebrowser := pDisp as IWebBrowser;
TopWebBrowser := (ASender as TWebBrowser).DefaultInterface;
if CurWebrowser=TopWebBrowser then
begin
document := webbrowser1.document as IHtmlDocument2;
memo3.lines.add(trim(document.body.innerhtml)); // to get html
ShowMessage('Document is complete.')
end;
end;
end.
I found the solution...HTML Table Parsing in Less than a second!
function HTMLCleanUp(L : string) : string;
var
P1,P2 : integer;
begin
P1 := Pos('<',L); //clean-up anything between <>
while (P1>0) do //WHILE1
begin
P2 := Pos('>',L);
if (P2>0)
then Begin Delete(L,P1,P2-P1+1); end;
P1 := Pos('<',L);
end; //WHILE1
L:=StringReplace(L,' ','-',[rfReplaceAll]);
Result := Trim(L);
end;
procedure TForm11.WB_SaveAs_HTML(WB : TWebBrowser; const FileName : string) ;
var
PersistStream: IPersistStreamInit;
Stream: IStream;
FileStream: TFileStream;
begin
if not Assigned(WB.Document) then
begin
ShowMessage('Document not loaded!') ;
Exit;
end;
PersistStream := WB.Document as IPersistStreamInit;
FileStream := TFileStream.Create(FileName, fmCreate) ;
try
Stream := TStreamAdapter.Create(FileStream, soReference) as IStream;
if Failed(PersistStream.Save(Stream, True)) then ShowMessage('SaveAs HTML fail!') ;
finally
FileStream.Free;
end;
end; (* WB_SaveAs_HTML *)
procedure TForm11.Button1Click(Sender: TObject);
const
xlExcel7 = $00000027;
TmpFileName='c:\test\xxxx.txt';
CRLF = #13#10;
CSVTempSeparator = #9; //#255; //replaced by a comma
ADPNEWHOTURL = 'http://samples.msdn.microsoft.com/workshop/samples/author/tables/HTML_Table.htm';
VAR
Excel, WS: Olevariant;
P1,P2,P3,P4, p5, P6, p11, p22 : integer;
i, j: Integer;
buffer,rawHTM,TmpStr,CSVStr:string;
HTMFile : TextFile;
CSVSTRList : TStringList;
begin
CSVSTRList := TStringList.Create;
WB_SaveAs_HTML(WebBrowser1,TmpFileName) ;
AssignFile(HTMFile, TmpFileName);//read the HTML file
Reset(HTMFile);
while not EOF(HTMFile) do begin
ReadLn(HTMFile, buffer);
rawHTM := Concat(rawHTM, buffer);
end;
i:=1;j:=1;
rawHTM := Trim(StringReplace(rawHTM,CRLF,'',[rfReplaceAll]));
P1 := PosEx('<TR',rawHTM, 1); //CASE SENSITIVE , TR->FIRST ROW
while (P1>0) do //while1
begin
P2 := PosEx('</TR',rawHTM, P1);
if (P2>0) //if1
then begin
TmpStr := Copy(rawHTM,P1,P2-P1+1);
CSVStr := '';p11:=1;p22:=1;
P11 := PosEx('<TH',TmpStr,1);
while (P11>0) do //while2
begin
P22 := PosEx('</TH',TmpStr, P11);
if (P22>0) //if2
then begin
CSVStr :=CSVStr+
HTMLCleanUp(Trim(Copy(TmpStr,P11,P22-P11)))+CSVTempSeparator; j:=j+1;
end //if2
else begin
Exit;
end; //if2
P11 := PoseX('<TH',TmpStr, P22);
end; //while2
P11 := PosEx('<TD',TmpStr, 1);
while (P11>0) do //while2
begin
P22 := PosEx('</TD',TmpStr, P11);
if (P22>0) //if2
then begin
CSVStr :=CSVStr+
HTMLCleanUp(Trim(Copy(TmpStr,P11,P22-P11)))+CSVTempSeparator; j:=j+1;
end //if2
else begin
Exit;
end; //if2
P11 := PosEx('<TD',TmpStr,P22);
end; //while2
end //if1
else begin
exit;
end; //if1
CSVSTRList.Add(CSVStr);
P1 := PosEx('<TR',rawHTM,P2); i:=i+1; j:=1; //CASE SENSITIVE
end; //while1
CSVSTRList.SaveToFile('c:\test\xxx2.txt');
Excel:= CreateOleObject('Excel.Application');
Excel.WorkBooks.opentext('c:\test\xxx2.txt');//OPEN TXT WITH EXCEL
Excel.visible := True;
CloseFile(HTMFile);
DeleteFile(TmpFileName);
end;
I've only just started learning Pascal so please excuse my ineptitude if I've missed something glaringly obvious.
I have a program that connects to a DB, retrieves a list of accounts and displays them in a StringGrid. I am now trying to extend the program so that selecting a row in the grid will perform a further search using parameters returned from the grid.
I have the grid setup correctly (I think!), I've managed to write the accountID value into a variable and am using it to construct a query.
When the time comes to run the query a segfault is issued and I don't understand why, the error message is
Project SQLConnect raised exception class 'External: SIGSEGV' at address 583166
The Assembler window shows the following gobbledygook:
00583166 8b09 mov (%ecx),%ecx
Here are the procedures I'm using to return data
Initial return before selecting row, this works - on its own:
procedure TForm1.sendQueryClick(Sender: TObject);
begin
CreateConnection;
CreateTransaction;
try
Query := GetQuery;
Query.SQL.Text := 'SELECT * FROM tbl_accounts LEFT JOIN tbl_properties ON tbl_accounts.ClientID = tbl_properties.PropertyID LEFT JOIN tbl_clients ON tbl_accounts.ClientID = tbl_clients.ClientID ORDER BY tbl_accounts.AccountID DESC';
AConnection.Open;
Query.Open;
while not Query.Eof do
begin
accID := Query.FieldByName('AccountID').AsString;
accountNo := Query.FieldByName('AccountNumber').AsString;
mortgagors := Query.FieldByName('Mortgagors').AsString;
address := Query.FieldByName('Address').AsString;
accResults.RowCount := accResults.RowCount + 1;
accResults.Cells[0, accResults.RowCount - 1] := accID;
accResults.Cells[1, accResults.RowCount - 1] := accountNo;
accResults.Cells[2, accResults.RowCount - 1] := mortgagors;
accResults.Cells[3, accResults.RowCount - 1] := address;
Query.Next;
end;
finally
Query.Close;
AConnection.Close;
Query.Free;
ATransaction.Free;
AConnection.Free;
end;
end;
This is the row select query, which causes the segfault:
procedure TForm1.accResultsSelectCell(Sender: TObject; aCol, aRow: Integer; var CanSelect: Boolean);
begin
// Hide Account ID Column
accResults.ColWidths[0] := 0;
CurrCol := 0;
CurrRow := aRow;
// Grab Account ID value from cell
CellValue := accResults.Cells[CurrCol, CurrRow];
selectedRow.Text := CellValue;
// Setup Query
try
TestQuery := GetQuery;
TestQuery.SQL.Text := 'SELECT * FROM tbl_accounts LEFT JOIN tbl_properties ON tbl_accounts.ClientID = tbl_properties.PropertyID LEFT JOIN tbl_clients ON tbl_accounts.ClientID = tbl_clients.ClientID WHERE AccountID = :AccID';
TestQuery.Params.ParamByName('AccID').AsString := CellValue;
// Open Database connection
AConnection.Open;
TestQuery.Open;
begin
end;
finally
TestQuery.Close;
AConnection.Close;
TestQuery.Free;
ATransaction.Free;
AConnection.Free;
end;
end;
IIRC: Make sure that the type of the parameter is not ftunknown.
I am working with Devart's MyDac and MySQL Server 5.0.41. Here is a section from the documentation on executing stored procedures with TMyConnection.ExecProc:
Note: Stored functions unlike stored procedures return result values that are obtained internally through the RESULT parameter. You will no longer have to provide anonymous value in the Params array to describe the result of the function. The stored function result is obtained from the Params[0] indexed property or with the ParamByName('RESULT') method call.
They also give an example on how to execute a stored function:
aStringVariable1 := TMyConnection.ExecProc('StoredFunctionName',['Param1','Param2']);
aStringVariable2 := TMyConnection.ParamByName('Result').AsString;
By Following these examples, my execution of the stored functions are returning Param1 in the variable aStringVariable2.The execution of the functions in the Query Browser returns the right results. Any pointers on the right way to execute stored functions in MyDAC with TMyConnection or TMyStoredProc will be appreciated.
Thanks in advance.
Here is the code we use to call stored procedures - hope it helps
function TDbControl.DatabaseStoredProc(FConnectionsAddr: integer; SpName: string;var Params: TDAParams): boolean;
var
MyStoredProc: TMyStoredProc;
PramsTxt: String;
Idx, Idx2: Integer;
begin
result := False;
MyStoredProc := nil;
try
try
MyStoredProc := TMyStoredProc.Create(nil);
MyStoredProc.Connection := TMyConnection(FConnectionsAddr);
MyStoredProc.StoredProcName := SpName;
MyStoredProc.ParamCheck := False;
if assigned(Params) then
begin
for Idx := 0 to Params.Count - 1 do
begin
MyStoredProc.ParamByName(Params[Idx].Name).DataType := Params[Idx].DataType;
MyStoredProc.ParamByName(Params[Idx].Name).Value := Params[Idx].Value;
end;
end;
MyStoredProc.Execute;
if assigned(Params) then
begin
for Idx := 0 to Params.Count - 1 do
begin
if (Params[Idx].ParamType = ptOutput ) then
Params[Idx].Value := MyStoredProc.ParamByName(Params[Idx].Name).Value;
end;
end;
result := True;
except
on E: Exception do
begin
PramsTxt := '';
if assigned(Params) then
begin
for Idx2 := 0 to Params.Count - 1 do
begin
PramsTxt := PramsTxt + Params.Items[Idx2].Name + '=' + Params[Idx2].AsString + ',';
end;
end;
LogText(FConnectionsAddr, 'DatabaseStoredProc Err:' + E.Message + ' SpName:' + SpName + ' Prams:' + PramsTxt);
raise ;
end;
end;
finally
FreeAndNil(MyStoredProc);
end;
end;