ClientDataSet's Savetostream with dfxml parameter throws access violation - delphi

Opened clientDataSet and getting:
cds.XMLData
or
st_pom := TMemoryStream.Create;
cds.SaveToStream(st_pom, dfXML );
results in AV. Has anyone encountered such behaviour?
I CAN ADD that cds has two fields: numeric and NVarchar(max) ..
It seems as the second field is the problem ...
Here are the last traces after which AV occurs
'{ Original Exception - Access violation at address 4DB10D54. Write of address 05017000 }'
(0002FD54) [4DB10D54]'#$D#$A'(000B2CB3) [004B3CB3] DBClient.TCustomClientDataSet.SaveDataPacket (Line 1500, "DBClient.pas" + 5) + $15'
(000B4385) [004B5385] DBClient.TCustomClientDataSet.WriteDataPacket (Line 2119, "DBClient.pas" + 5) + $6'
(000B457B) [004B557B] DBClient.TCustomClientDataSet.SaveToStream (Line 2186, "DBClient.pas" + 1) + $C'

Related

Delphi + Google Map Api: Using Polyline causes "Script Error"

I've just started programming in Delphi and I have a problem with Google Map Api. I want to have a form with google map and draw lines on it(coordinates from db). Unfortunately when I try to put a 'Polyline' on a map the error occurs an error.
Line: 0
Char: 0
Error: Script error
Code: 0
Url: https://maps.googleapis.com/maps-api-v3/api/js/29/14b/intl/pl_ALL/poly.js
Have no idea how to fix it.
FYI I'm using RAD Studio 10.2 and using TWebBrowser component.
My code:
unit Unit2;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtrls, SHDocVw, MSHTML ;
type
TForm2 = class(TForm)
WebBrowser1: TWebBrowser;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
Doc: Variant;
HTMLWindow2: IHTMLWindow2;
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
var
HTMLStr: AnsiString =
'<!DOCTYPE html>' +
'<html xmlns="http://www.w3.org/1999/xhtml" xmlns:v="urn:schemas-microsoft-com:vml">' +
' <head>' +
' <meta http-equiv="X-UA-Compatible" content="IE=edge" /> ' +
' <style>' +
' #map {' +
' height: 400px;' +
' width: 100%;' +
' }' +
' </style>' +
' </head>' +
' <body>' +
' <h3>My Google Maps Demo</h3>' +
' <div id="map"></div>' +
' <script src="https://maps.googleapis.com/maps/api/js?v=3&key=***&callback=initMap"></script>'+
' <script>'+
' function initMap() {' +
' var map = new google.maps.Map(document.getElementById("map"), {' +
' zoom: 3,' +
' center: {lat: 0, lng: -180},' +
' mapTypeId: "terrain"' +
' });' +
' var flightPlanCoordinates = [' +
' {lat: 37.772, lng: -122.214},' +
' {lat: 21.291, lng: -157.821},' +
' {lat: -18.142, lng: 178.431},' +
' {lat: -27.467, lng: 153.027}' +
' ];' +
' var flightPath = new google.maps.Polyline({' +
' path: flightPlanCoordinates,' +
' geodesic: true,' +
' strokeColor: "#FF0000",' +
' strokeOpacity: 1.0,' +
' strokeWeight: 2' +
' });' +
' flightPath.setMap(map);' +
' }' +
' </script>' +
' </body>' +
'</html>';
procedure TForm2.FormCreate(Sender: TObject);
begin
if NOT Assigned(WebBrowser1.Document) then
WebBrowser1.Navigate('about:blank');
Doc := WebBrowser1.Document;
Doc.Clear;
Doc.Write(HTMLStr);
Doc.Close;
HTMLWindow2 := (WebBrowser1.Document as IHTMLDocument2).parentWindow;
end;
end.
To get your sample to run there are two needed changes:
1) Swap the script tags
Put the line script src="https://maps.googleapis.com/.... after the next script block. Your initMap function needs to be loaded before you load the google maps api. Otherwise it looks for the initMap function and cannot find it.
Once you make that change you will see the map loaded without the line. But then you will see an error on top of the map stating the browser is not supported.
The error message is not clear when run run this in Delphi. But if you save your embed HTML text out to a file and open in Chrome you can see this error message in the javascript console.
2) Enable IE 11 mode for the embedded TWebBrowser.
In my project I was never able to get the doctype or meta tags to get IE to behave properly. However, setting the emulation mode registry flag did work. The flag needs to be set based on your executable file name. I use a value of
"11000": IE11. Webpages containing standards-based !DOCTYPE directives are
displayed in IE11 edge mode. Default value for IE11.
Information on the registry key is in the MDSN help page: Internet Feature Controls (B..C), under the Browser Emulation section.
You can also see some discussion in this StackOverflow post "How to have Delphi TWebbrowser component running in IE9 mode?"
Make sure you pay attention to the registry location. Because this is Local Machine you need to be under the WOW6432Node if your application is 32 bit running on a 64 bit OS.
HKEY_LOCAL_MACHINE\SOFTWARE\WOW6432Node\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION
Add a DWORD value with your exe name (like "project1.exe") and a value of 11000.

Delphi JCL Debug missing stack frame entries for JDBG

I use following code to dump stack frame at the moment of an exception:
...
var
FTraceList: TStringList;
...
procedure TTraceForm.LogException(ExceptObj: TObject; ExceptAddr: Pointer; IsOS: Boolean);
begin
...
StackList := JclCreateStackList(false, 0, Caller(0, false));
try
FTraceList.Add('');
FTraceList.Add('Stack trace at the moment of the exception:');
StackList.AddToStrings(FTraceList, true, true, true, true);
finally
Stacklist.Free;
end;
end;
But it behaves differently in Debug and Release mode.
For an intended exception (exception for testing purposes) in main form's OnKeyDown when compiling in Debug mode (Delphi debug info) the result is:
Stack trace at the moment of the exception:
(00591276){Main.exe } [00992276] DlgTraceException.TTraceForm.LogException (Line 162, "DlgTraceException.pas" + 55) + $4
(0058B8FF){Main.exe } [0098C8FF] JclDebug.JclCreateStackList + $17
(00591281){Main.exe } [00992281] DlgTraceException.TTraceForm.LogException (Line 162, "DlgTraceException.pas" + 55) + $F
(00582AE3){Main.exe } [00983AE3] JclHookExcept.TNotifierItem.DoNotify + $43
(00582CCB){Main.exe } [00983CCB] JclHookExcept.DoExceptNotify + $CF
(00582DAD){Main.exe } [00983DAD] JclHookExcept.HookedExceptObjProc + $1D
(0000606F){Main.exe } [0040706F] System.#HandleAnyException + $33
(00598DE3){Main.exe } [00999DE3] Main.TMainForm.FormKeyDown (Line 658, "Main.pas" + 2) + $7
And this I get in Release mode (JCL debug info added to binary with JCL Debug Expert):
Stack trace at the moment of the exception:
(0053BA27){Main.exe } [0093CA27] DlgTraceException.TTraceForm.LogException + $377
(00536427){Main.exe } [00937427] JclDebug.JclCreateStackList + $17
(0053BA32){Main.exe } [0093CA32] DlgTraceException.TTraceForm.LogException + $382
(0052D60B){Main.exe } [0092E60B] JclHookExcept.TNotifierItem.DoNotify + $43
(0052D7F3){Main.exe } [0092E7F3] JclHookExcept.DoExceptNotify + $CF
(0052D8D5){Main.exe } [0092E8D5] JclHookExcept.HookedExceptObjProc + $1D
(0000606F){Main.exe } [0040706F] System.#HandleAnyException + $33
In second case FormKeyDown entry is missing. Is there somebody who knows why this is happening? I would like to know the entire stack trace in release mode as well.
After playing a bit with compiler options (toggling them on and off) I could isolate the cause. The stack frame has been optimized out. When I turned Optimization off the FormKeyDown call was recorded even in Release mode. The Stack Frames generation option mentioned in comments above did not influence the results.
Of course I'll keep optimizations on in release mode. It will be harder to find the cause of the exception but there is other info about it JCL debug provides which should be (hopefully) sufficient to find the cause of the exception.

Delphi Set Invalid Typecast

How do I fix this invalid typecast error? The code works when the set has less than 31 items. Below is the code snippet:
type
TOptionsSurveyTypes=(
ostLoadSurvey00,
ostLoadSurvey01,
ostLoadSurvey02,
ostLoadSurvey03,
ostLoadSurvey04,
ostLoadSurvey05,
ostLoadSurvey06,
ostLoadSurvey07,
ostLoadSurvey08,
ostLoadSurvey09,
ostLoadSurvey10,
ostEventLog01,
ostEventLog02,
ostEventLog03,
ostEventLog04,
ostEventLog05,
ostSagSwell,
ostTamper,
ostWaveforms,
ostDeviceList,
ostDeleteData,
ostTOUBillingTotal,
ostTOUPrevious,
ostProfileGenericLoadSurvey01,
ostProfileGenericLoadSurvey02,
ostProfileGenericLoadSurvey03,
ostProfileGenericLoadSurvey04,
ostProfileGenericLoadSurvey05,
ostProfileGenericLoadSurvey06,
ostProfileGenericLoadSurvey07,
ostProfileGenericLoadSurvey08,
ostProfileGenericLoadSurvey09,
ostProfileGenericLoadSurvey10,
ostProfileGenericEventLog01,
ostProfileGenericEventLog02,
ostProfileGenericEventLog03,
ostProfileGenericEventLog04,
ostProfileGenericEventLog05,
ostProfileGenericBillingTotal,
ostProfileGenericPrevious,
ostProfileGeneric
);
TOptionsSurveyTypesSet=set of TOptionsSurveyTypes;
function TUserProcessRollback.SurveyRollBack:boolean;
var
vRollbackDate: TDateTime;
FOptions: LongWord;
begin
...
if ostDeleteData in TOptionsSurveyTypesSet(FOptions) then <-- invalid typecast error here
vRollbackDate := 0.00
else
vRollbackDate := FRollbackDate;
...
end;
When I reduce the set to just less than 32 items and FOptions is declared as DWORD, the code compiles .
Thanks
Your enumerated type has 41 items. Each byte holds 8 bits. To have a set of this enumerated type requires at least 41 bits. The smallest number of bytes necessary to hold 41 bits is 6. So the set type is 6 bytes. To confirm this, you can execute this:
ShowMessage ( inttostr ( sizeof ( TOptionsSurveyTypesSet ) ) );
A DWORD is 4 bytes, so it cannot be typecast into a type that is 6 bytes. If you declare fOptions to be a type with 6 bytes, your code will compile.
FOptions: packed array [ 1 .. 6] of byte;
If you reduce the enumerated type to 32 or fewer items, then the set type will be 4 bytes, and so the typecast from DWORD will work.

How to avoid Restart Bluetooth Printer after print?

I have developed windows mobile 6.1 application which search nearby Bluetooth devices and send files.Also I did print functionality to print document on Bluetooth printer.
First time print functionality is working perfectly fine but when I print the document again, then I need to restart the printer and then after it will print.
Is there any solution to avoid restart printer??
Below is my print code from reference of https://32feet.codeplex.com/discussions/355451
private void btPrint_Click(object sender, EventArgs e)
{
// Activate BT
BluetoothRadio.PrimaryRadio.Mode = RadioMode.Connectable;
System.Threading.Thread.Sleep(1000);
// Connect
BluetoothAddress btAddress;
btAddress = BluetoothAddress.Parse("0022583165F7");
BluetoothClient btClient = new BluetoothClient();
try
{
btClient.Connect(new BluetoothEndPoint(btAddress, BluetoothService.SerialPort));
}
catch (Exception ex)
{
MessageBox.Show(ex.Message);
return;
}
// Send data
string CPCLStr1 =
"! 0 200 200 210 1" + Environment.NewLine +
"ML 25" + Environment.NewLine +
"TEXT 7 0 10 20" + Environment.NewLine +
"Just" + Environment.NewLine +
"Testing" + Environment.NewLine +
"ENDML" + Environment.NewLine +
"FORM" + Environment.NewLine +
"PRINT" + Environment.NewLine;
// Convert CPCL String to byte array
byte[] CPCLbytes1 = ASCIIEncoding.ASCII.GetBytes(CPCLStr1);
NetworkStream ns = btClient.GetStream();
ns.Write(CPCLbytes1, 0, CPCLbytes1.Length);
btClient.Close();
}
Although you close the client stream, the printer seems to wait some time before it resets it's session.
Try to send a <EOF> or <EOT> byte at the end.
Acording to CPCL reference guide there is no simple reset command as with ESC/p for example ({esc}#).
Doing a device reset after every print seems an overkill.
EDIT: SDK sample for sendFile:
Byte[] cpclLabel = Encoding.Default.GetBytes("! 0 200 200 406 1\r\n" + "ON-FEED IGNORE\r\n"
+ "BOX 20 20 380 380 8\r\n"
+ "T 0 6 137 177 TEST\r\n"
+ "PRINT\r\n");
The above runs fine on my RW420 without the need to reset between prints.

how to change desktop wallpaper?

How do I change desktop wallpaper?
I tried this
procedure TForm1.Button1Click(Sender: TObject);
var
PicPath: String;
begin
PicPath := 'C:\test.bmp';
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, pChar(PicPath), SPIF_SENDCHANGE)
end;
But it didn't work.
I just tried it with D2007 on XP (and also D2009 on Vista), and this code works.
But to catch If and why it is not working, you should test the result code and get the error from Windows:
if not SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, pChar(PicPath), SPIF_SENDCHANGE)then
RaiseLastOSError;
In most cases, it will be because the bmp file is not found:
System Error. Code: 2.
The system cannot find the file specified.
You can check out this python script:
http://gaze.svn.sourceforge.net/viewvc/gaze/trunk/implementation/src/gazelib/os_interface.py?view=markup
This is the python method that does all the magic. It changes a few registry keys and then calls a system method to update the wallpaper.
103 def set_wallpaper(self, file_path) :
104 self.__lock.acquire()
105 # this module is part of python 2.5 by default
106 import ctypes
107 import _winreg
108 reg = _winreg.OpenKey(_winreg.HKEY_CURRENT_USER, self.__REGISTRY_PATH, 0, _winreg.KEY_SET_VALUE)
109 # First center the image and turn off tiling
110 _winreg.SetValueEx(reg, "TileWallpaper", 0, _winreg.REG_SZ, "0")
111 _winreg.SetValueEx(reg, "WallpaperStyle", 0, _winreg.REG_SZ, "0")
112 # Set the image
113 _winreg.SetValueEx(reg, "ConvertedWallpaper", 0, _winreg.REG_SZ, os.path.realpath(file_path))
114 _winreg.SetValueEx(reg, "Wallpaper", 0, _winreg.REG_SZ, self.convert_to_bmp(file_path))
115 _winreg.CloseKey(reg)
116 # Notify the changes to the system
117 func_ret_val = ctypes.windll.user32.SystemParametersInfoA(\
118 self.__SPI_SETDESKWALLPAPER,\
119 0,\
120 None,\
121 self.__SPIF_UPDATEINIFILE | self.__SPIF_SENDWININICHANGE)
122 assert func_ret_val == 1
123 self.__lock.release()
Check a VB code here, it can give you a clue.
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, imageLocation, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
This should work
Procedure TForm1.Button1Click(Sender: TObject);
var
PicPath : string;
begin
PicPath := 'C:\test.bmp';
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Pointer(PicPath), SPIF_SENDWININICHANGE);
end;

Resources