Is there an way to pass a widestring to a TStringStream? - delphi

I have this Delphi function:
function DevuelveResumenEventos(cnnBBDD : TADOConnection;sFecha,sHora,sCtrlPac : string) : TStream;
var
sTextoArmado : string;
stCarga : TStringStream;
begin
with TADOTable.Create(Application.MainForm) do
try
sTextoArmado := '';
Connection := cnnBBDD;
TableName := 'EAPC_EVENTOS';
Filter := 'EAPC_FECHA = '+sFecha+' and EAPC_HORA = '+sHora+' and EAPC_CTRL_PAC = '+sCtrlPac;
Filtered := True;
Open;
while not Eof do
begin
sTextoArmado := sTextoArmado + FormatDateTime('dd-mm-yyyy', FieldValues['EAPC_FECHA_EVENTO'])+
' '+MinutsToStr(FieldValues['EAPC_HORA_EVENTO'])+
' ('+Trim(FieldValues['EAPC_LOGIN_USER'])+
') - '+FieldByName('EAPC_EVENTO').AsString+CRLF+CRLF;
Next;
end;
**stCarga := TStringStream.Create(sTextoArmado);
with TRichEdit.Create(Application.MainForm) do
begin
Parent := Application.MainForm;
Text := sTextoArmado;
Lines.SaveToStream(stCarga);
Free;
end;
finally
Close;
Free;
end;
Result := stCarga;**
end;
The intention is to retrieve a series of RTF formated texts, concatenate them with other texts and return them in a single TStringStream to be displayed in a TRichEdit in a form.
How can I skip the "use the on-the-fly RichEdit" and send the resulting texts as a TStringStream?

Related

Getting cyrillic string in richedit with Delphi

I have a formatted text on a wordpad file(rtf). I'm trying to open it on a richedit on a delphi form. The problem is that the string is in cyrillic(Bulgarian) and it's saved with weird hieroglyphs or whatever those are "Âëåçå ïîòðåáèòåë". Is there a way to transfer/translate the hieroglyphs to the richedit, so they can appear as proper text?
This function I use to check if the file is empty so I can then enter the first rtf tag, or remove the closing tag, so I can add more text in there without breaking the file
function FileIsEmpty(const FileName: String): Boolean;
var
fad: TWin32FileAttributeData;
begin
Result := GetFileAttributesEx(PChar(FileName), GetFileExInfoStandard, #fad) and
(fad.nFileSizeLow = 0) and (fad.nFileSizeHigh = 0);
end;
This is the code I use to format the text and also give it to the file:
procedure FormatLogAndAddToFile(richEditLog : TRichEdit; richEditTextColor : TRichEdit);
var
i : integer;
s, c, finalText : string;
sString : TStringList;
begin
with frmMain do
begin
sString := TStringList.Create;
sString.LoadFromFile('C:\Users\lyuben\Desktop\Lyuben Airport Delphi\Log File\TestFormating.rtf');
if Pos('{\rtf}', sString.Strings[0]) <> 0 then
begin
sString.Delete(0);
end
else
begin
sString.Delete(sString.Count - 1);
end;
sString.SaveToFile('C:\Users\lyuben\Desktop\Lyuben Airport Delphi\Log File\TestFormating.rtf');
sString.free;
AssignFile(logFile, 'C:\Users\lyuben\Desktop\Lyuben Airport Delphi\Log File\TestFormating.rtf');
Append(logFile);
if FileIsEmpty('C:\Users\lyuben\Desktop\Lyuben Airport Delphi\Log File\TestFormating.rtf') = True then
begin
WriteLn(logFile, '{\rtf\ansi\ansicpg1252\deff0\nouicompat{\fonttbl{\f0\fnil\fcharset0 Calibri;}}');
end;
for i := 0 to richEditLog.Lines.Count do
begin
s := richEditLog.Lines[i];
c := richEditTextColor.Lines[i];
if c = 'blue' then
begin
finalText := '{\colortbl ;\red0\green128\blue255;\red255\green0\blue0;}' +
'\viewkind4\uc1 \pard\sa200\sl276\slmult1\cf1\f0\fs32\lang9 ' + s + '\cf2\par';
end
else if c = 'red' then
begin
finalText := '{\colortbl ;\red255\green0\blue0;}' +
'\viewkind4\uc1 \pard\sa200\sl276\slmult1\cf1\f0\fs32\lang9 ' + s + '\par';
end
else if c = 'green' then
begin
finalText := '{\colortbl ;\red0\green128\blue128;\red255\green0\blue0;}' +
'\viewkind4\uc1 \pard\sa200\sl276\slmult1\cf1\f0\fs32\lang9 ' + s + '\cf2\par';
end;
WriteLn(logFile, finalText);
end;
WriteLn(logFile, '}');
CloseFile(logFile);
end;
end;
This is the code I use to add the log lines to the file. I also have little bit of code that checks if the file has lines with a date that is entered on a TDateEdit, so I can only get log from the date I've entered.
procedure OpenLogInRichEdit(dateFilter : Boolean; searchDate : tDate);
var
sTime : string;
dateExists : Boolean;
I : integer;
begin
with frmMain do
begin
dateExists := false;
frmLogSearch.tLogRichEdit.Clear;
frmLogSearch.tLogRichEdit.Lines.LoadFromFile('C:\Users\lyuben\Desktop\Lyuben Airport Delphi\Log File\TestFormating.rtf');
sTime := DateTimeToStr(searchDate);
if dateFilter then
begin
for I := 0 to frmLogSearch.tLogRichEdit.Lines.Count do
begin
if Pos(sTime, frmLogSearch.tLogRichEdit.Lines[i]) <> 0 then
begin
frmLogSearch.tLogRichEdit.Lines.Delete(i);
dateExists := True;
end;
end;
if dateExists = false then
begin
ShowMessage('No log from this day!');
end;
end;
end;
end;
This is how I add the text to the richedits I use later for the procedure FormatLogAndAddToFile.
dateTimeNow := Now;
logText.Lines.Add('<' + DateTimeToStr(dateTimeNow) + '> Изтрита е поръчка');
logTextColor.Lines.Add('red');
And this is how I eventually call the procedures. First the procedure to get the formatted log to the richedits
OpenLogInRichEdit(tcxCheckBoxDate.Checked, tcxDate.Date);
And this is the procedure to format the text and give it to the file
LogFileUse.FormatLogAndAddToFile(logText, logTextColor);
Thanks to the comments I've managed to make it work. I've changed the code above. Instead of having 'fcharset0' as a tag, I now have 'fcharset1' and I also changed 'lang9' to 'lang1026' and now I save it properly to the file and it opens perfectly!
If all this scary code is here only to add colored lines to the file, than you should use TRichEdit.SelAttributes with friends: Colorful text in the same line in TRichEdit This way TRichEdit will be able to correctly handle encoding. And if you need some fancy file header or footer, that you do not want to create from code, than you can create empty rtf-file with required header/footer, and use it as a template.

How to Search text tags and replace with Image in Header/Footer/Table of Openoffice Document using Delphi

I have open office template documents where i need to search for tags like [CHART=100] and replace it with a Image file reside in some folder at PC.
I am using approach mentioned in my previous question.
How to insert image in OpenOffice Document using Delphi.
Procedure ReplaceTextTagsWithImage(sFileTobeReplaced,ImageFile:string);
var
ServiceManager: Variant;
Desktop: Variant;
Document: Variant;
NoParams : Variant;
FileReplace: Variant;
FileSearch : Variant;
Txt : Variant;
TextCursor : Variant;
FileParams: Variant;
Graphic : Variant;
FileProperty,Imageproperty: Variant;
afileurl,gurl : string;
xinterface,xTextRange,curTextView : variant;
ppoint : variant;
SearchDescriptor,found : Variant;
IdNumber : Integer;
sNumber : string;
Bitmaps : Variant;
function CreateProperty(const AName: AnsiString; const AValue: Variant): Variant;
begin
Result := ServiceManager.Bridge_GetStruct('com.sun.star.beans.PropertyValue');
Result.Name := AName;
Result.Value := AValue;
end;
begin
Try
ServiceManager := CreateOleObject('com.sun.star.ServiceManager');
Desktop := ServiceManager.createInstance('com.sun.star.frame.Desktop');
FileParams := VarArrayCreate([0, 0], varVariant);
FileParams[0] := CreateProperty('Hidden',True); {hide Document}
afileurl := 'file:///'+sFileTobeReplaced;
Document := Desktop.loadComponentFromURL(afileurl, '_blank', 0, FileParams);
Txt := Document.getText;
TextCursor := Txt.createTextCursor;
SearchDescriptor := Document.createSearchDescriptor;
SearchDescriptor.setSearchString('[CHART=[0-9].*]');
SearchDescriptor.SearchRegularExpression := True;
Found := Document.findFirst(SearchDescriptor);
Bitmaps := Document.createInstance('com.sun.star.drawing.BitmapTable');
While Not (VarIsNull(Found) or VarIsEmpty(Found) or VarIsType(Found,varUnknown)) do
begin
sNumber := String(Found.getString);
sNumber := copy(String(Found.getString), Length('<CHART=')+1 );
sNumber := copy(Trim(sNumber),1,length(sNumber)-1);
Found.setString('');
Graphic := Document.createInstance('com.sun.star.text.GraphicObject');
gurl := 'file:///'+ImageFile;
if not Bitmaps.hasbyname(sNumber+'_Image') then
Bitmaps.insertByName(sNumber+'_Image', gurl);
Graphic.GraphicURL := Bitmaps.getByName(sNumber+'_Image');
Graphic.AnchorType := 1; {com.sun.star.text.TextContentAnchorType.AS_CHARACTER;}
Graphic.Width := 6000;
Graphic.Height := 8000;
TextCursor.gotoRange(Found, False);
Txt.insertTextContent(TextCursor, Graphic, False);
Found := Document.findNext(Found.getEnd, SearchDescriptor);
end;
FileParams[0] := CreateProperty('Overwrite',True);
Document.storeAsURL(afileurl, FileParams);
Document.Close(True);
Try
Desktop.Terminate;
except
end;
Finally
Document := Unassigned;
Desktop := Unassigned;
ServiceManager := Unassigned;
end;
end;
procedure TForm6.Button3Click(Sender: TObject);
var
sFileToBeReplaced : String;
sImageFile : String;
begin
sFileToBeReplaced := edOOFile.Text;
sImageFile := edImageFile.Text;
Try
ReplaceTextTagsWithImage(sFileToBeReplaced,sImageFile);
ShowMessage('Success');
Except
on E: Exception do
ShowMessage(E.Message);
End;
end;
This code works fine when Tag text is not in header/footer/table, however if i define tag in header/footer/table i get error "com.sun.star.uno.RuntimeException:" at
TextCursor.gotoRange(Found, False);
I am not sure how to refer ranges in search and replace.
Please suggest how to achieve it.
Headers, tables and so on have their own text object, so the text object of the main document will not work. Instead, get the text object and cursor from Found.
Also, remove . from the regular expression to match multiple digits instead of multiple of anything. And the brackets must be literal.
Here is working Basic code.
Sub ReplaceTextTagsWithImage
Document = ThisComponent
Bitmaps = Document.createInstance("com.sun.star.drawing.BitmapTable")
ImageFile = "C:/google_wht.gif"
SearchDescriptor = Document.createSearchDescriptor()
SearchDescriptor.setSearchString("\[CHART=[0-9]*\]")
SearchDescriptor.SearchRegularExpression = True
Found = Document.findFirst(SearchDescriptor)
Do While Not IsNull(Found)
TextCursor = Found.getText().createTextCursor()
TextCursor.gotoRange(Found, False)
Graphic = Document.createInstance("com.sun.star.text.GraphicObject")
gurl = "file:///" & ImageFile
gname = sNumber & "_Image"
if Not Bitmaps.hasbyname(gname) Then
Bitmaps.insertByName(gname, gurl)
End If
Graphic.GraphicURL = Bitmaps.getByName(gname)
Graphic.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER
Graphic.Width = 6000
Graphic.Height = 8000
TextCursor.getText().insertTextContent(TextCursor, Graphic, False)
Found = ThisComponent.findNext( Found.End, SearchDescriptor)
Loop
End Sub

jSon_encode like function for Delphi which accepts TDataSet

I have been tasked with creating a Indy server in Delphi 2007 which communicates with clients and returns json formatted data from Sql based databases. Someone from our office created a prototype using php. And in the prototype they use the jSon_encode function extensively to return the data from tables. I was wondering if there was a similar Delphi function which could accept a TDataSet parameter and return properly formatted json data.
Anyone know of such function?
Update 12/10/2013 - my modification to #user2748835 answer:
function jsonencode(mString: String): String;
begin
result := StringReplace(mString,'''','\''',[rfReplaceAll,rfIgnoreCase]);
result := StringReplace(mString,'\','\\',[rfReplaceAll,rfIgnoreCase]);
result := StringReplace(result,crlf,'\n',[rfReplaceAll,rfIgnoreCase]);
result := StringReplace(result,'"','\"',[rfReplaceAll,rfIgnoreCase]);
result := StringReplace(result,'/','\/',[rfReplaceAll,rfIgnoreCase]);
result := StringReplace(result,'#9','\t',[rfReplaceAll,rfIgnoreCase]);
end;
function jSon_encode(aDataset:TDataset):string;
function fieldToJSON(thisField:TField):string;
begin
try
result := '"'+thisField.fieldName+'":';
case thisField.DataType of
ftInteger,ftSmallint,ftLargeint:
result := result+inttostr(thisField.AsInteger);
ftDateTime:
result := result+'"'+formatdatetime('YYYY-MM-DD HH:NN:SS',thisField.AsDateTime)+'"';
ftCurrency,
ftFloat:
result := result + floattostr(thisField.AsFloat);
ftString :
result := result + '"'+jsonencode(thisField.AsString)+'"';
else
end; // case
result := result + ',';
except
on e: Exception do begin
appendtolog('problem escaping field '+thisfield.fieldname);
end;
end;
end; // of fieldToJSON
function rowToJSON(ds:TDataset):string;
var
fieldIx : integer;
begin
result := '';
for fieldIx := 0 to ds.fieldcount-1 do
result := result + fieldToJSON(ds.Fields[fieldIx]);
// trim comma after last col
result := '{'+copy(result,1,length(result)-1)+'},';
end; // of rowToJSON
begin
result := '';
with aDataset do
begin
if not bof then first;
while not eof do
begin
result := result + rowToJSON(aDataset);
next;
end;
end;
//strip last comma and add
if length(result)>0 then
result := copy(result,1,length(result)-1);
result := '['+result+']';
end; // of DSToJSON
In a TDataset, you can loop through the Fields collection and construct the json output and then in the loop, check the fieldtype and encode the value accordingly.
Something like:
uses db;
function DSToJSON(aDataset:TDataset):string;
function fieldToJSON(thisField:TField):string;
begin
result := '"'+thisField.fieldName+'":';
case thisField.DataType of
ftInteger,
ftSmallint,
ftCurrency,
ftFloat,
ftLargeInt:
result := result+thisField.value+^n^j;
ftString :
result := noSingleQuotes(thisField.value)+^n^j;
else
end; // case
end; // of fieldToJSON
function rowToJSON(ds:TDataset):string;
var
fieldIx : integer;
begin
for fieldIx := 0 to ds.fieldcount-1 do
result := result + fieldToJSON(ds.Fields[fieldIx]);
// trim comma after last col
result := '{'+copy(result,1,length(result)-1)+'},';
end; // of rowToJSON
begin
result := '';
with aDataset do
begin
if not bof then first;
while not eof do
begin
result := result + rowToJSON(aDataset);
next;
end;
end;
//strip last comma and add
if length(result)>0 then
result := copy(result,1,length(result)-1);
result := '['+result+']';
end; // of DSToJSON
We just added a more complete and faster function, in our Open Source repository.
It is part of our mORMot framework, but can be used as a stand-alone unit, not tied to other features.
See in SynVirtualDataSet.pas:
function DataSetToJSON(Data: TDataSet): RawUTF8
See this commit and the associated forum thread.
You can change every row into object and use serializing http://docwiki.embarcadero.com/RADStudio/XE5/en/Serializing_User_Objects

out parameter and "ShowMessage" function

I have a function declare like this :
function execProc(ProcName,InValues:PChar;out OutValues:PChar):integer; //The "OutValues" is a out parameter.
And I call this function like this:
procedure TForm1.Button6Click(Sender: TObject);
var
v:integer;
s:pchar;
begin
Memo1.Clear;
v := execProc(pchar('PROC_TEST'),pchar('aaa'),s);
showmessage(inttostr(v)); //mark line
Memo1.Lines.Add(strpas(s));
end;
when i delete the mark line(showmessage(inttostr(v))),i will have a correct result display in the Memo1,but if i keep use the showmessage(), the memo1 will dispaly an error string : "Messag" ,Why?
Thanks for any help!
function execProc(ProcName,InValues:PChar;out OutValues:PChar):integer;
var
str: TStrings;
InValue,OutValue: string;
i,j,scount: integer;
begin
Result := -100;
i := 0;
j := 0;
str := TStringList.Create;
try
sCount := ExtractStrings(['|'], [], InValues, str);
with kbmMWClientStoredProc1 do
begin
Close;
Params.Clear;
StoredProcName := StrPas(ProcName);
FieldDefs.Updated := False;
FieldDefs.Update;
for i := 0 to Params.Count - 1 do
begin
if (Params[i].ParamType = ptUnknown) or
(Params[i].ParamType = ptInput) or
(Params[i].ParamType = ptInputOutput) then
begin
inc(j);
InValue := str[j-1];
Params[i].Value := InValue;
end;
end;
try
ExecProc;
for i := 0 to Params.Count - 1 do
begin
if (Params[i].ParamType = ptOutput) or
(Params[i].ParamType = ptInputOutput) then
OutValue := OutValue + '|' + Params[i].AsString;
end;
OutValues := PChar(Copy(OutValue,2,Length(OutValue)-1));
Result := 0;
except
on E:Exception do
begin
if E.Message = 'Connection lost.' then Result := -101;//服务器连接失败
if E.Message = 'Authorization failed.' then Result := -102;//身份验证失败
Writelog(E.Message);
end;
end;
end;
finally
str.Free;
end;
end;
The problem is in the design of your interface and the use of PChar.
OutValues := PChar(Copy(OutValue,2,Length(OutValue)-1));
This is implemented by making an implicit, hidden, local string variable which holds the value
Copy(OutValue,2,Length(OutValue)-1)
When the function returns, that string variable is destroyed and so OutValues points at deallocated memory. Sometimes your program appears to work but that's really just down to chance. Any small change can disturb that, as you have observed.
The problem is easy enough to fix. Simply use string parameters rather than PChar. This will make the code easier to read as well as making it work correctly.
function execProc(ProcName, InValues: string; out OutValues: string): integer;

GetFormFieldNames not always working

I am trying to find out which form and element belongs too. The code that I now understand from this website:
http://www.cryer.co.uk/brian/delphi/twebbrowser/read_write_form_elements.htm
containing this code
function GetFormFieldNames(fromForm: IHTMLFormElement): TStringList;
var
index: integer;
field: IHTMLElement;
input: IHTMLInputElement;
select: IHTMLSelectElement;
text: IHTMLTextAreaElement;
begin
result := TStringList.Create;
for index := 0 to fromForm.length do
begin
field := fromForm.Item(index,'') as IHTMLElement;
if Assigned(field) then
begin
if field.tagName = 'INPUT' then
begin
// Input field.
input := field as IHTMLInputElement;
result.Add(input.name);
end
else if field.tagName = 'SELECT' then
begin
// Select field.
select := field as IHTMLSelectElement;
result.Add(select.name);
end
else if field.tagName = 'TEXTAREA' then
begin
// TextArea field.
text := field as IHTMLTextAreaElement;
result.Add(text.name);
end;
end;
end;
end;
seems to be working fine for most sites. However there are a few websites such as this one:
http://service.mail.com/registration.html#.1258-bluestripe-product1-undef
By looking at that code and comparing it with the active id, I can find the form it is in. However it does not work for that website. for some reason I think it has to do with htmldocument3 adn that this code is for htmldocument2. But I am not sure.
so my question is How can I extract a tstringlist from this website with all the elements names in them? hope you can help!
Edited: Added some code
begin
theForm := GetFormByNumber(webbrowser1.document as IHTMLDocument2,
0);
fields := GetFormFieldNames(theForm);
num := fields.IndexOf(theid);
end;
until (num <> -1);
One complication with locating form elements in a web page is that the page may contain frames and there may be forms in any of the frames. Basically, you have to iterate through all the frames and the forms in each frame. Once you get the form as an IHTMLFormElement, use Cryer's function to get the form element names.
The example link you gave does not have any frames and you should have had no problems getting your list of form elements, unless you tried to get the form by name because it had no name assigned. I had no problem getting the form element names and values using the following procedure
procedure GetForms(doc1: IHTMLDocument2; var sl: TStringList);
var
i, j, n: integer;
docForm: IHTMLFormElement;
slt: TStringList;
s: string;
begin
if doc1 = nil then
begin
ShowMessage('doc1 is empty [GetForms]');
Exit;
end;
slt := TStringList.Create;
n := NumberOfForms(doc1);
sl.Add('Forms: ' + IntToStr(n));
for i := 0 to n - 1 do
begin
docForm := GetFormByNumber(doc1, i);
sl.Add('Form Name: ' + docForm.Name);
slt.Clear;
slt := GetFormFieldNames(docForm);
for j := 0 to slt.Count - 1 do
begin
s := GetFieldValue(docForm, slt[j]);
sl.Add('Field Name: ' + slt[j] + ' value: "' + s + '"');
end;
end;
sl.Add('');
slt.Free;
end;
Cryer's example for navigating a frameset will not work for all web sites, see http://support.microsoft.com/support/kb/articles/Q196/3/40.ASP. The following function successfuly extracts a frame as an IHTMLDocument2 on all sites I have tried
function GetFrameByNumber(Doc:IHTMLDocument2; n:integer):IHTMLDocument2;
var
Container: IOleContainer;
Enumerator: ActiveX.IEnumUnknown;
Unknown: IUnknown;
Browser: IWebBrowser2;
Fetched: Longint;
NewDoc: IHTMLDocument2;
i : integer;
begin
// We cannot use the document's frames collection here, because
// it does not work in every case (i.e. Documents from a foreign domain).
// From: http://support.microsoft.com/support/kb/articles/Q196/3/40.ASP
i := 0;
if (Supports(Doc, IOleContainer, Container)) and
(Container.EnumObjects(OLECONTF_EMBEDDINGS, Enumerator) = S_OK) then
begin
while Enumerator.Next(1, Unknown, #Fetched) = S_OK do
begin
if (Supports(Unknown, IWebBrowser2, Browser)) and
(Supports(Browser.Document, IHTMLDocument2, NewDoc)) then
begin
// Here, NewDoc is an IHTMLDocument2 that you can query for
// all the links, text edits, etc.
if i=n then
begin
Result := NewDoc;
Exit;
end;
i := i+1;
end;
end;
end;
end;
Here is an example of how I have used GetForms and GetFrameByNumber
// from the TForm1 declaration
{ Public declarations }
wdoc: IHTMLDocument2;
procedure TForm1.btnAnalyzeClick(Sender: TObject);
begin
wdoc := WebBrowser.Document as IHTMLDocument2;
GetDoc(wdoc);
end;
procedure TForm1.GetDoc(doc1: IHTMLDocument2);
var
i, n: integer;
doc2: IHTMLDocument2;
frame_dispatch: IDispatch;
frame_win: IHTMLWindow2;
ole_index: olevariant;
sl: TStringList;
begin
if doc1 = nil then
begin
ShowMessage('Web doc is empty');
Exit;
end;
Form2.Memo1.Lines.Clear;
sl := TStringList.Create;
n := doc1.frames.length;
sl.Add('Frames: ' + IntToStr(n));
// check each frame for the data
if n = 0 then
GetForms(doc1, sl)
else
for i := 0 to n - 1 do
begin
sl.Add('--Frame: ' + IntToStr(i));
ole_index := i;
frame_dispatch := doc1.Frames.Item(ole_index);
if frame_dispatch <> nil then
begin
frame_win := frame_dispatch as IHTMLWindow2;
doc2 := frame_win.document;
// sl.Add(doc2.body.outerHTML);
GetForms(doc2,sl);
GetDoc(doc2);
end;
end;
// Form2 just contains a TMemo
Form2.Memo1.Lines.AddStrings(sl);
Form2.Show;
sl.Free;
end;
The logic in your example is faulty, 1. when there is only 1 form on the web page the list of form elements is never extracted, 2. the repeat loop will result in a access violation unless the the tag in "theid" is found
Here is your example cut down to successfully extract the form elements.
var
i : integer;
nforms : integer;
document : IHTMLDocument2;
theForm : IHTMLFormElement;
fields : TStringList;
theform1 : integer;
num : integer;
theid : string;
begin
fields := TStringList.Create;
theid := 'xx';
// original code follows
i := -1;
// nforms := NumberOfForms(webbrowser1.document as IHTMLDocument2);
// document := webbrowser1.document as IHTMLDocument2;
// if nforms = 1 then
// begin
// theForm := GetFormByNumber(webbrowser1.document as IHTMLDocument2, 0);
// theform1 := 0;
// end
// else
begin
// repeat
begin
inc(i);
theForm := GetFormByNumber(webbrowser1.document as IHTMLDocument2,
i);
fields := GetFormFieldNames(theForm);
num := fields.IndexOf(theid);
theform1 := i;
end;
// until (num <> -1);
end;
// end of original code
Memo1.Lines.Text := fields.Text;
fields.Free;
end;
Hm, are you sure this link contains any form elements? At least I did not see any visible ones. Perhaps they are hidden - did not check this myself, however.
Michael

Resources