PROCEDURE TForm4.TestShlWAPIParseURL(Sender : TObject);
VAR url : STRING;
VAR wcharurl : WideString;
VAR urlinfo : PARSEDURLA;
VAR wcharurlinfo : PARSEDURLW;
VAR apiretval : HRESULT;
VAR newinfoline : STRING;
BEGIN
url := '';
wcharurl := '';
FillChar(urlinfo, SizeOf(urlinfo), #0);
FillChar(wcharurlinfo, SizeOf(wcharurlinfo), #0);
apiretval := S_OK; //S_OK = 0
newinfoline := '';
url := 'http://stoelzelsoftwaretech.com/en/devlib/functions/ParseURL.htm';
urlinfo.cbSize := SizeOf(urlinfo);
apiretval := ParseURL(PChar(url), urlinfo);
newinfoline := 'ParseURL called with ' + AnsiQuotedStr(url, '"') +
' returned : 0x' + IntToHex(apiretval, 8) + ' (' + IntToStr(apiretval) + ')';
Memo1.Lines.Add(newinfoline);
IF apiretval = S_OK THEN
BEGIN
newinfoline := 'Protocol : ' + urlinfo.pszProtocol + ' (cchProtocol: ' + IntToStr(urlinfo.cchProtocol) + ' characters)';
Memo1.Lines.Add(newinfoline);
newinfoline := 'Suffix : ' + urlinfo.pszSuffix + ' (cchSuffix: ' + IntToStr(urlinfo.cchSuffix) + ' characters)';
Memo1.Lines.Add(newinfoline);
newinfoline := 'Scheme: ' + IntToStr(urlinfo.nScheme);
Memo1.Lines.Add(newinfoline);
END;
Memo1.Lines.Add('-- -- -- -- --');
FillChar(urlinfo, SizeOf(urlinfo), #0);
apiretval := S_OK;
newinfoline := '';
url := 'http://stoelzelsoftwaretech.com/en/devlib/functions/ParseURL.htm';
urlinfo.cbSize := SizeOf(urlinfo);
apiretval := ParseURL(PChar(url), urlinfo);
newinfoline := 'ParseURL called with ' + AnsiQuotedStr(url, '"') +
' returned : 0x' + IntToHex(apiretval, 8) + ' (' + IntToStr(apiretval) + ')';
Memo1.Lines.Add(newinfoline);
IF apiretval = S_OK THEN
BEGIN
newinfoline := Format('Protocol : %.*s', [urlinfo.cchProtocol, urlinfo.pszProtocol]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Protocol string length (cchProtocol) : %d', [urlinfo.cchProtocol]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Suffix : %.*s', [urlinfo.cchSuffix, urlinfo.pszSuffix]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Suffix string length (cchSuffix) : %d', [urlinfo.cchSuffix]);
Memo1.Lines.Add(newinfoline);
newinfoline := 'Scheme: ' + IntToStr(urlinfo.nScheme);
Memo1.Lines.Add(newinfoline);
END;
Memo1.Lines.Add('-- -- -- -- --');
FillChar(urlinfo, SizeOf(urlinfo), #0);
apiretval := S_OK;
newinfoline := '';
url := 'ftp://ftp.tex.ac.uk/tex-archive/systems/unix/unixtex.ftp';
urlinfo.cbSize := SizeOf(urlinfo);
apiretval := ParseURL(PChar(url), urlinfo);
newinfoline := 'ParseURL called with ' + AnsiQuotedStr(url, '"') +
' returned : 0x' + IntToHex(apiretval, 8) + ' (' + IntToStr(apiretval) + ')';
Memo1.Lines.Add(newinfoline);
IF apiretval = S_OK THEN
BEGIN
newinfoline := Format('Protocol : %.*s', [urlinfo.cchProtocol, urlinfo.pszProtocol]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Protocol string length (cchProtocol) : %d', [urlinfo.cchProtocol]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Suffix : %.*s', [urlinfo.cchSuffix, urlinfo.pszSuffix]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Suffix string length (cchSuffix) : %d', [urlinfo.cchSuffix]);
Memo1.Lines.Add(newinfoline);
newinfoline := 'Scheme: ' + IntToStr(urlinfo.nScheme);
Memo1.Lines.Add(newinfoline);
END;
Memo1.Lines.Add('-- -- -- -- --');
FillChar(urlinfo, SizeOf(urlinfo), #0);
apiretval := S_OK;
newinfoline := '';
url := 'mailto:dummy-address@nomail.net';
urlinfo.cbSize := SizeOf(urlinfo);
apiretval := ParseURL(PChar(url), urlinfo);
newinfoline := 'ParseURL called with ' + AnsiQuotedStr(url, '"') +
' returned : 0x' + IntToHex(apiretval, 8) + ' (' + IntToStr(apiretval) + ')';
Memo1.Lines.Add(newinfoline);
IF apiretval = S_OK THEN
BEGIN
newinfoline := Format('Protocol : %.*s', [urlinfo.cchProtocol, urlinfo.pszProtocol]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Protocol string length (cchProtocol) : %d', [urlinfo.cchProtocol]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Suffix : %.*s', [urlinfo.cchSuffix, urlinfo.pszSuffix]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Suffix string length (cchSuffix) : %d', [urlinfo.cchSuffix]);
Memo1.Lines.Add(newinfoline);
newinfoline := 'Scheme: ' + IntToStr(urlinfo.nScheme);
Memo1.Lines.Add(newinfoline);
//newinfoline := Copy(urlinfo.pszSuffix, 1, urlinfo.cchSuffix)
END;
Memo1.Lines.Add('-- -- -- -- --');
FillChar(urlinfo, SizeOf(urlinfo), #0);
apiretval := S_OK;
newinfoline := '';
url := 'file://C:\Users\Administrator\Documents\Example.txt';
urlinfo.cbSize := SizeOf(urlinfo);
apiretval := ParseURL(PChar(url), urlinfo);
newinfoline := 'ParseURL called with ' + AnsiQuotedStr(url, '"') +
' returned : 0x' + IntToHex(apiretval, 8) + ' (' + IntToStr(apiretval) + ')';
Memo1.Lines.Add(newinfoline);
IF apiretval = S_OK THEN
BEGIN
newinfoline := Format('Protocol : %.*s', [urlinfo.cchProtocol, urlinfo.pszProtocol]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Protocol string length (cchProtocol) : %d', [urlinfo.cchProtocol]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Suffix : %.*s', [urlinfo.cchSuffix, urlinfo.pszSuffix]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Suffix string length (cchSuffix) : %d', [urlinfo.cchSuffix]);
Memo1.Lines.Add(newinfoline);
newinfoline := 'Scheme: ' + IntToStr(urlinfo.nScheme);
Memo1.Lines.Add(newinfoline);
END;
Memo1.Lines.Add('-- -- -- -- --');
//Wide character/Unicode version
FillChar(wcharurlinfo, SizeOf(wcharurlinfo), #0);
apiretval := S_OK;
newinfoline := '';
wcharurl := 'https://stoelzelsoftwaretech.com/en/sitemap/TitleIndex.htm';
wcharurlinfo.cbSize := SizeOf(wcharurlinfo);
apiretval := ParseURLW(PWideChar(wcharurl), wcharurlinfo);
newinfoline := 'ParseURL called with the Unicode URL ' + AnsiQuotedStr(wcharurl, '"') +
' returned : 0x' + IntToHex(apiretval, 8) + ' (' + IntToStr(apiretval) + ')';
Memo1.Lines.Add(newinfoline);
IF apiretval = S_OK THEN
BEGIN
newinfoline := Format('Protocol : %.*s', [wcharurlinfo.cchProtocol, wcharurlinfo.pszProtocol]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Protocol string length (cchProtocol) : %d', [wcharurlinfo.cchProtocol]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Suffix : %.*s', [wcharurlinfo.cchSuffix, wcharurlinfo.pszSuffix]);
Memo1.Lines.Add(newinfoline);
newinfoline := Format('Suffix string length (cchSuffix) : %d', [wcharurlinfo.cchSuffix]);
Memo1.Lines.Add(newinfoline);
newinfoline := 'Scheme: ' + IntToStr(wcharurlinfo.nScheme);
Memo1.Lines.Add(newinfoline);
END;
Memo1.Lines.Add('-- -- -- -- --');
//Provoke some errors
FillChar(urlinfo, SizeOf(urlinfo), #0);
apiretval := S_OK;
newinfoline := '';
url := '';
urlinfo.cbSize := SizeOf(urlinfo);
apiretval := ParseURL(NIL, urlinfo); //Invalid pointer !
newinfoline := 'ParseURL called with ' + AnsiQuotedStr(url, '"') +
' returned : 0x' + IntToHex(apiretval, 8) + ' (' + IntToStr(apiretval) + ')';
Memo1.Lines.Add(newinfoline);
IF apiretval = S_OK THEN
BEGIN
newinfoline := 'This implementation of ParseURL is capable of handling an invalid pointer to an ANSI string';
Memo1.Lines.Add(newinfoline);
END;
Memo1.Lines.Add('-- -- -- -- --');
FillChar(urlinfo, SizeOf(urlinfo), #0);
apiretval := S_OK;
newinfoline := '';
url := ''; //Invalid URL string !
urlinfo.cbSize := SizeOf(urlinfo);
apiretval := ParseURL(PChar(url), urlinfo);
newinfoline := 'ParseURL called with ' + AnsiQuotedStr(url, '"') +
' returned : 0x' + IntToHex(apiretval, 8) + ' (' + IntToStr(apiretval) + ')';
Memo1.Lines.Add(newinfoline);
IF apiretval = S_OK THEN
BEGIN
newinfoline := 'This implementation of ParseURL is capable of handling an empty URL string';
Memo1.Lines.Add(newinfoline);
END;
Memo1.Lines.Add('-- -- -- -- --');
FillChar(urlinfo, SizeOf(urlinfo), #0);
apiretval := S_OK;
newinfoline := '';
url := 'gopher:';
//urlinfo.cbSize := SizeOf(urlinfo); //Size of record/struct NOT defined !
apiretval := ParseURL(PChar(url), urlinfo);
newinfoline := 'ParseURL called with ' + AnsiQuotedStr(url, '"') +
' returned : 0x' + IntToHex(apiretval, 8) + ' (' + IntToStr(apiretval) + ')';
Memo1.Lines.Add(newinfoline);
IF apiretval = S_OK THEN
BEGIN
newinfoline := 'This implementation of ParseURL is capable of handling incorrectly initialized PARSEDURLA structs';
Memo1.Lines.Add(newinfoline);
END;
Memo1.Lines.Add('');
END; |