Related
I have this bit of code here...
set serveroutput on;
DECLARE
v_response varchar(3000) := '{"content":{"stuff":{"cat":"meow","dog":"woof"}},"http_code":401,"response_code":"-1"}';
v_content varchar(3000);
BEGIN
select json_value(v_response, '$.content') into v_content from dual;
dbms_output.put_line('v_content: ' || v_content);
END;
I would expect the variable v_content to contain something along the lines of '{"stuff":{"cat":"meow","dog":"woof"}'. However it is returning nothing.
JSON_VALUE finds a specified scalar JSON value in JSON data and returns it as a SQL value.
select json_value('{"content":{"stuff":{"cat":"meow","dog":"woof"}},"http_code":401,"response_code":"-1"}', '$.content.stuff.cat') from dual
returned meow
Try this:
DECLARE
je JSON_ELEMENT_T;
jo JSON_OBJECT_T;
content JSON_OBJECT_T;
v_response varchar(3000) := '{"content":{"stuff":{"cat":"meow","dog":"woof"}},"http_code":401,"response_code":"-1"}';
BEGIN
je := JSON_ELEMENT_T.parse(v_response);
IF (je.is_Object) THEN
jo := treat(je AS JSON_OBJECT_T);
content := jo.get_Object('content');
END IF;
DBMS_OUTPUT.put_line(content.to_string);
END;
I'm working with gmlib in Delphi Seattle 10.
My client application sends the location(Latitude and Longitude) through an fireMonkey application to my database InterBase XE7.
My admin console consists in display a google map with markers that come from a query,for later calculate the distance between all markers in the map.
The procedure that creates markers is working perfectly and at the same time i'm filling the GMDirection component with the coordinates of markers. Here is the code of "CreatePoint" procedure:
amplitud := 1;
posicion := 0;
Distancia := 0;
markerGM.Tag := 1;
qryDatos.Close;
qryDatos.Open;
while not qryDatos.Eof do
begin
SetLength(marcadores,amplitud);
marcadores[posicion] := qryDatos.FieldByName('PLULOG').AsInteger;
Latitud := qryDatos.FieldByName('LATITUD').AsFloat;
Longitud := qryDatos.FieldByName('LONGITUD').AsFloat;
autorizado := qryDatos.FieldByName('AUTORIZADO').AsString;
with markerGM.Add(Latitud,Longitud) do
begin
if autorizado = 'T' then
begin
if markerGM.Tag = 1 then
begin
directionGM.DirectionsRequest.Origin.LatLng.Lat := Latitud;
directionGM.DirectionsRequest.Origin.LatLng.Lng := Longitud;
end
else if markerGM.Tag = 2 then
begin
directionGM.DirectionsRequest.Destination.LatLng.Lat := Latitud;
directionGM.DirectionsRequest.Destination.LatLng.Lng := Longitud;
directionGM2.DirectionsRequest.Origin.LatLng.Lat := Latitud;
directionGM2.DirectionsRequest.Origin.LatLng.Lng := Longitud;
Distancia := DistanceBetween(directionGM.DirectionsRequest.Origin.LatLng.Lat,directionGM.DirectionsRequest.Origin.LatLng.Lng,
directionGM.DirectionsRequest.Destination.LatLng.Lat,directionGM.DirectionsRequest.Destination.LatLng.Lng);
end
else if markerGM.Tag = 3 then
begin
directionGM2.DirectionsRequest.Destination.LatLng.Lat := Latitud;
directionGM2.DirectionsRequest.Destination.LatLng.Lng := Longitud;
directionGM3.DirectionsRequest.Origin.LatLng.Lat := Latitud;
directionGM3.DirectionsRequest.Origin.LatLng.Lng := Longitud;
Distancia := Distancia + DistanceBetween(directionGM2.DirectionsRequest.Origin.LatLng.Lat,directionGM2.DirectionsRequest.Origin.LatLng.Lng,
directionGM2.DirectionsRequest.Destination.LatLng.Lat,directionGM2.DirectionsRequest.Destination.LatLng.Lng);
end
else if markerGM.Tag = 4 then
begin
directionGM3.DirectionsRequest.Destination.LatLng.Lat := Latitud;
directionGM3.DirectionsRequest.Destination.LatLng.Lng := Longitud;
directionGM4.DirectionsRequest.Origin.LatLng.Lat := Latitud;
directionGM4.DirectionsRequest.Origin.LatLng.Lng := Longitud;
Distancia := Distancia + DistanceBetween(directionGM3.DirectionsRequest.Origin.LatLng.Lat,directionGM3.DirectionsRequest.Origin.LatLng.Lng,
directionGM3.DirectionsRequest.Destination.LatLng.Lat,directionGM3.DirectionsRequest.Destination.LatLng.Lng);
end;
MarkerType := mtColored;
ColoredMarker.Width := 48 + (Index * 20);
ColoredMarker.Height := 48;
markerGM.Tag := markerGM.Tag + 1;
end;
end;
mapGM.RequiredProp.Center.Lat := Latitud;
mapGM.RequiredProp.Center.Lng := Longitud;
mapGM.RequiredProp.Zoom := 13;
amplitud := amplitud + 1;
posicion := posicion + 1;
qryDatos.Next;
end;
mapGM.Active := True;
And here is the code of the procedure of "DistanceBetween" from Internet:
function TfrmLocationMain.DistanceBetween(const Lat1: Extended; const Lon1: Extended; const Lat2: Extended; const Lon2: Extended): Extended;
begin
Result := RadToDeg(ArcCos(Sin(DegToRad(Lat1)) * Sin(DegToRad(Lat2)) + Cos(DegToRad(Lat1)) * Cos(DegToRad(Lat2)) * Cos(DegToRad(Lon1 - Lon2)))) * 69.09;
end;
And finally. When the google map with the markers are created and the components are full of data. I'm execute all the GMDirection components to calculate the distance and displays in a EditText.
procedure TfrmLocationMain.btnRutaClick(Sender: TObject);
begin
directionGM.Execute;
directionGM2.Execute;
directionGM3.Execute;
directionGM4.Execute;
Distancia := (Distancia/0.62137);
edtDistancia.Text := FloatToStr(Distancia);
mapGM.RequiredProp.Zoom := 14;
end;
All this code is working with all registers in a test database. With coordinates from my country El Salvador. But when I implemented in a database from Guatemala. Some coordinates are causing that GMDirection component give me the following error:
Could not convert variant of type(Null) into type(OleStr)
This happens whit some coordinates from a Guatemala's database.
For example. If the Query gives me the following data:
14.513,-90.558
14.559,-90.545
14.572,-90.542
All the code works perfectly. But if the Query gives me the following data:
14.505,-90.568
14.667,-90.494
14.666,-90.494
Give me the error above.
I don't know what is the problem. And I don't understand why the code works with some registers and with others not.
If someone has a similar problem or idea of what may be failing.
I would greatly appreciate your help with this.
Regards.
I have found the problem. To solve it, open unit GMDirection, add Variants unit to the uses clause
implementation
uses
{$IFDEF DELPHIXE2}
System.SysUtils, System.DateUtils, Xml.XMLIntf, Xml.XMLDoc, System.Variants,
{$ELSE}
SysUtils, DateUtils, XMLIntf, XMLDoc, Variants,
{$ENDIF}
Lang, GMFunctions;
Search line (3575 aprox)
if SameText(Node.NodeName, LBL_D_SUMMARY) then Result.FSumary := Node.NodeValue;
and replace by
if SameText(Node.NodeName, LBL_D_SUMMARY) and (Node.NodeValue <> null) then Result.FSumary := Node.NodeValue;
Recompile the components
That's all
I'm using the script below in order to fetch JSON file from MongoDB, parse it and then insert it into Oracle table.
The script works fine in a sense that it inserts all values correctly into Oracle table. That includes the value Photo which is an image of base64 formate and it is much larger than 32KB.
The column Photo in the table Appery_Photos is of the type CLOB while column DecodedPhoto is of the type BLOB.
The problem lies in the line blobOriginal := base64decode1(Photo); which I used to decode the CLOB into BLOB. The function base64decode1 has been replaced with several functions (i.e. decode_base64 , base64DecodeClobAsBlob_plsql, base64decode , from_base64 & finally JSON_EXT.DECODE).
The result was the same for all of them. That is, the resultant BLOB object cannot be openned as an image in any of images editors (I'm using Oracle SQL Developer to download it).
I checked CLOB, and I could not find any newlines \n, nor could I find any spaces (only + signs found). Furthermore, I inserted CLOB value into the base64-image-converter and it displays the image correctly. In addition, I tried to encode the resultant BLOB in base64 back in order to further validate (using the opposite functions provided in the links above), the resultant base64 is not the same at all.
BEGIN
l_http_request := UTL_HTTP.begin_request('https://api.appery.io/rest/1/db/collections/Photos?where=%7B%22Oracle_Flag%22%3A%22Y%22%7D' , 'GET' , 'HTTP/1.1');
-- ...set header's attributes
UTL_HTTP.set_header(l_http_request, 'X-Appery-Database-Id', '53f2dac5e4b02cca64021dbe');
l_http_response := UTL_HTTP.get_response(l_http_request);
BEGIN
LOOP
UTL_HTTP.read_text(l_http_response, buf);
l_response_text := l_response_text || buf;
END LOOP;
EXCEPTION
WHEN UTL_HTTP.end_of_body THEN
NULL;
END;
l_list := json_list(l_response_text);
FOR i IN 1..l_list.count
LOOP
A_id := json_ext.get_string(json(l_list.get(i)),'_id');
l_val := json_ext.get_json_value(json(l_list.get(i)),'Photo');
dbms_lob.createtemporary(Photo, true, 2);
json_value.get_string(l_val, Photo);
dbms_output.put_line(dbms_lob.getlength(Photo));
dbms_output.put_line(dbms_lob.substr(Photo, 20, 1));
blobOriginal := base64decode1(Photo);
A_Name := json_ext.get_string(json(l_list.get(i)),'Name');
Remarks := json_ext.get_string(json(l_list.get(i)),'Remarks');
Status := json_ext.get_string(json(l_list.get(i)),'Status');
UserId := json_ext.get_string(json(l_list.get(i)),'UserId');
A_Date := json_ext.get_string(json(l_list.get(i)),'Date');
A_Time := json_ext.get_string(json(l_list.get(i)),'Time');
MSG_status := json_ext.get_string(json(l_list.get(i)),'MSG_status');
Oracle_Flag := json_ext.get_string(json(l_list.get(i)),'Oracle_Flag');
acl := json_ext.get_string(json(l_list.get(i)),'acl');
INSERT
INTO Appery_Photos
(
A_id,
Photo,
DecodedPhoto,
A_Name,
Remarks,
Status,
UserId,
A_Date,
A_Time,
MSG_status ,
Oracle_Flag,
acl
)
VALUES
(
A_id,
Photo,
blobOriginal,
A_Name,
Remarks,
Status,
UserId,
A_Date,
A_Time,
MSG_status ,
Oracle_Flag,
acl
);
dbms_lob.freetemporary(Photo);
END LOOP;
-- finalizing
UTL_HTTP.end_response(l_http_response);
EXCEPTION
WHEN UTL_HTTP.end_of_body THEN
UTL_HTTP.end_response(l_http_response);
END;
Any help is deeply appreciated.
I found that is not in the function I used in the base64 decoding. Instead, the value I have is not base64 encoded strings, but base64 encode dataURi's, something like
data:image/jpeg;base64,/9j/4AAQSkZJRgABAQAAA
So I have to use something like: clobbase642blob( substr( Photo, instr( Photo, ',' ) + 1 ) )
The following script is inspired by Oracle Community answer
DECLARE
l_param_list VARCHAR2(512);
l_http_request UTL_HTTP.req;
l_http_response UTL_HTTP.resp;
l_response_text CLOB;
--l_response_text VARCHAR2(32767);
buf VARCHAR2(32767);
l_list json_list;
l_val json_value;
A_id VARCHAR2(100);
Photo CLOB;
A_Name VARCHAR2(100);
Remarks VARCHAR2(100);
Status VARCHAR2(100);
UserId VARCHAR2(100);
A_Date VARCHAR2(100);
A_Time VARCHAR2(100);
MSG_status VARCHAR2(100);
Oracle_Flag VARCHAR2(100);
acl VARCHAR2(100);
obj json_list;
blobOriginal BLOB := empty_blob();
clobInBase64 CLOB;
substring VARCHAR2(2000);
tmp BLOB;
n pls_integer := 0;
substring_length pls_integer := 2000;
------------------------------------------------------
FUNCTION clobbase642blob(
p_clob CLOB )
RETURN BLOB
IS
t_blob BLOB;
t_buffer VARCHAR2(32767);
t_pos NUMBER := 1;
t_size NUMBER := nls_charset_decl_len( 32764, nls_charset_id( 'char_cs' ) );
t_len NUMBER;
t_tmp raw(32767);
BEGIN
dbms_lob.createtemporary( t_blob, true );
t_len := LENGTH( p_clob );
LOOP
EXIT
WHEN t_pos > t_len;
t_buffer := REPLACE( REPLACE( SUBSTR( p_clob, t_pos, t_size ), chr(10) ), chr(13) );
t_pos := t_pos + t_size;
WHILE t_pos 0
LOOP
t_buffer := t_buffer || REPLACE( REPLACE( SUBSTR( p_clob, t_pos, 1 ), chr(10) ), chr(13) );
t_pos := t_pos + 1;
END LOOP;
t_tmp := utl_encode.base64_decode( utl_raw.cast_to_raw( t_buffer ) );
dbms_lob.writeappend( t_blob, utl_raw.length( t_tmp ), t_tmp );
END LOOP;
RETURN t_blob;
END;
------------------------------------------------------
BEGIN
-- service's input parameters
-- preparing Request...
l_http_request := UTL_HTTP.begin_request('https://api.appery.io/rest/1/db/collections/Photos?where=%7B%22Oracle_Flag%22%3A%22Y%22%7D' , 'GET' , 'HTTP/1.1');
-- ...set header's attributes
UTL_HTTP.set_header(l_http_request, 'X-Appery-Database-Id', '53f2dac5e4b02cca64021dbe');
l_http_response := UTL_HTTP.get_response(l_http_request);
BEGIN
LOOP
UTL_HTTP.read_text(l_http_response, buf);
l_response_text := l_response_text || buf;
END LOOP;
EXCEPTION
WHEN UTL_HTTP.end_of_body THEN
NULL;
END;
l_list := json_list(l_response_text);
FOR i IN 1..l_list.count
LOOP
A_id := json_ext.get_string(json(l_list.get(i)),'_id');
--deal with base64 URI photo >32KB
l_val := json_ext.get_json_value(json(l_list.get(i)),'Photo');
dbms_lob.createtemporary(Photo, true, 2);
json_value.get_string(l_val, Photo);
--dbms_output.put_line(dbms_lob.getlength(Photo));
--dbms_output.put_line(dbms_lob.substr(Photo, 20, 1));
blobOriginal := clobbase642blob( SUBSTR( Photo, 24 ) );
A_Name := json_ext.get_string(json(l_list.get(i)),'Name');
Remarks := json_ext.get_string(json(l_list.get(i)),'Remarks');
Status := json_ext.get_string(json(l_list.get(i)),'Status');
UserId := json_ext.get_string(json(l_list.get(i)),'UserId');
A_Date := json_ext.get_string(json(l_list.get(i)),'Date');
A_Time := json_ext.get_string(json(l_list.get(i)),'Time');
MSG_status := json_ext.get_string(json(l_list.get(i)),'MSG_status');
Oracle_Flag := json_ext.get_string(json(l_list.get(i)),'Oracle_Flag');
acl := json_ext.get_string(json(l_list.get(i)),'acl');
INSERT
INTO Appery_Photos
(
A_id,
Photo,
DecodedPhoto,
A_Name,
Remarks,
Status,
UserId,
A_Date,
A_Time,
MSG_status ,
Oracle_Flag,
acl
)
VALUES
(
A_id,
Photo,
blobOriginal,
A_Name,
Remarks,
Status,
UserId,
A_Date,
A_Time,
MSG_status ,
Oracle_Flag,
acl
);
dbms_lob.freetemporary(Photo);
END LOOP;
-- finalizing
UTL_HTTP.end_response(l_http_response);
EXCEPTION
WHEN UTL_HTTP.end_of_body THEN
UTL_HTTP.end_response(l_http_response);
END;
/
It is Base64 or HexBinary...
This works for HexBinary
function DESERIALIZE_HEX_BLOB(P_SERIALIZATION CLOB)
return BLOB
is
V_BLOB BLOB;
V_OFFSET INTEGER := 1;
V_AMOUNT INTEGER := 32000;
V_INPUT_LENGTH NUMBER := DBMS_LOB.GETLENGTH(P_SERIALIZATION);
V_HEXBINARY_DATA VARCHAR2(32000);
begin
if (P_SERIALIZATION is NULL) then return NULL; end if;
DBMS_LOB.CREATETEMPORARY(V_BLOB,TRUE,DBMS_LOB.CALL);
while (V_OFFSET <= V_INPUT_LENGTH) loop
V_AMOUNT := 32000;
DBMS_LOB.READ(P_SERIALIZATION,V_AMOUNT,V_OFFSET,V_HEXBINARY_DATA);
V_OFFSET := V_OFFSET + V_AMOUNT;
DBMS_LOB.APPEND(V_BLOB,TO_BLOB(HEXTORAW(V_HEXBINARY_DATA)));
end loop;
return V_BLOB;
end;
--
And could probably be modified to handle Base64 without too much trouble.
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 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;